Annotation of loncom/interface/loncommon.pm, revision 1.1420

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1420  ! raeburn     4: # $Id: loncommon.pm,v 1.1419 2023/11/18 21:12:45 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.1383    raeburn    64: use Apache::lonnavmaps();
1.139     matthew    65: use HTML::Entities;
1.334     albertel   66: use Apache::lonhtmlcommon();
                     67: use Apache::loncoursedata();
1.344     albertel   68: use Apache::lontexconvert();
1.444     albertel   69: use Apache::lonclonecourse();
1.1108    raeburn    70: use Apache::lonuserutils();
1.1110    raeburn    71: use Apache::lonuserstate();
1.1182    raeburn    72: use Apache::courseclassifier();
1.479     albertel   73: use LONCAPA qw(:DEFAULT :match);
1.1409    raeburn    74: use LONCAPA::ltiutils;
1.1280    raeburn    75: use LONCAPA::LWPReq;
1.1395    raeburn    76: use LONCAPA::map();
1.1328    raeburn    77: use HTTP::Request;
1.657     raeburn    78: use DateTime::TimeZone;
1.1241    raeburn    79: use DateTime::Locale;
1.1220    raeburn    80: use Encode();
1.1091    foxr       81: use Text::Aspell;
1.1094    raeburn    82: use Authen::Captcha;
                     83: use Captcha::reCAPTCHA;
1.1234    raeburn    84: use JSON::DWIW;
1.1174    raeburn    85: use Crypt::DES;
                     86: use DynaLoader; # for Crypt::DES version
1.1223    musolffc   87: use MIME::Lite;
                     88: use MIME::Types;
1.1292    raeburn    89: use File::Copy();
1.1300    raeburn    90: use File::Path();
1.1309    raeburn    91: use String::CRC32();
                     92: use Short::URL();
1.117     www        93: 
1.517     raeburn    94: # ---------------------------------------------- Designs
                     95: use vars qw(%defaultdesign);
                     96: 
1.22      www        97: my $readit;
                     98: 
1.517     raeburn    99: 
1.157     matthew   100: ##
                    101: ## Global Variables
                    102: ##
1.46      matthew   103: 
1.643     foxr      104: 
                    105: # ----------------------------------------------- SSI with retries:
                    106: #
                    107: 
                    108: =pod
                    109: 
1.648     raeburn   110: =head1 Server Side include with retries:
1.643     foxr      111: 
                    112: =over 4
                    113: 
1.648     raeburn   114: =item * &ssi_with_retries(resource,retries form)
1.643     foxr      115: 
                    116: Performs an ssi with some number of retries.  Retries continue either
                    117: until the result is ok or until the retry count supplied by the
                    118: caller is exhausted.  
                    119: 
                    120: Inputs:
1.648     raeburn   121: 
                    122: =over 4
                    123: 
1.643     foxr      124: resource   - Identifies the resource to insert.
1.648     raeburn   125: 
1.643     foxr      126: retries    - Count of the number of retries allowed.
1.648     raeburn   127: 
1.643     foxr      128: form       - Hash that identifies the rendering options.
                    129: 
1.648     raeburn   130: =back
                    131: 
                    132: Returns:
                    133: 
                    134: =over 4
                    135: 
1.643     foxr      136: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   137: 
1.643     foxr      138: response   - The response from the last attempt (which may or may not have been successful.
                    139: 
1.648     raeburn   140: =back
                    141: 
                    142: =back
                    143: 
1.643     foxr      144: =cut
                    145: 
                    146: sub ssi_with_retries {
                    147:     my ($resource, $retries, %form) = @_;
                    148: 
                    149: 
                    150:     my $ok = 0;			# True if we got a good response.
                    151:     my $content;
                    152:     my $response;
                    153: 
                    154:     # Try to get the ssi done. within the retries count:
                    155: 
                    156:     do {
                    157: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    158: 	$ok      = $response->is_success;
1.650     www       159:         if (!$ok) {
                    160:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    161:         }
1.643     foxr      162: 	$retries--;
                    163:     } while (!$ok && ($retries > 0));
                    164: 
                    165:     if (!$ok) {
                    166: 	$content = '';		# On error return an empty content.
                    167:     }
                    168:     return ($content, $response);
                    169: 
                    170: }
                    171: 
                    172: 
                    173: 
1.20      www       174: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  175: my %language;
1.124     www       176: my %supported_language;
1.1088    foxr      177: my %supported_codes;
1.1048    foxr      178: my %latex_language;		# For choosing hyphenation in <transl..>
                    179: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  180: my %cprtag;
1.192     taceyjo1  181: my %scprtag;
1.351     www       182: my %fe; my %fd; my %fm;
1.41      ng        183: my %category_extensions;
1.12      harris41  184: 
1.46      matthew   185: # ---------------------------------------------- Thesaurus variables
1.144     matthew   186: #
                    187: # %Keywords:
                    188: #      A hash used by &keyword to determine if a word is considered a keyword.
                    189: # $thesaurus_db_file 
                    190: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   191: 
                    192: my %Keywords;
                    193: my $thesaurus_db_file;
                    194: 
1.144     matthew   195: #
                    196: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    197: # thesaurus.tab, and filecategories.tab.
                    198: #
1.18      www       199: BEGIN {
1.46      matthew   200:     # Variable initialization
                    201:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    202:     #
1.22      www       203:     unless ($readit) {
1.12      harris41  204: # ------------------------------------------------------------------- languages
                    205:     {
1.158     raeburn   206:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    207:                                    '/language.tab';
1.1317    raeburn   208:         if ( open(my $fh,'<',$langtabfile) ) {
1.356     albertel  209:             while (my $line = <$fh>) {
                    210:                 next if ($line=~/^\#/);
                    211:                 chomp($line);
1.1088    foxr      212:                 my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   213:                 $language{$key}=$val.' - '.$enc;
                    214:                 if ($sup) {
                    215:                     $supported_language{$key}=$sup;
1.1088    foxr      216: 		    $supported_codes{$key}   = $code;
1.158     raeburn   217:                 }
1.1048    foxr      218: 		if ($latex) {
                    219: 		    $latex_language_bykey{$key} = $latex;
1.1088    foxr      220: 		    $latex_language{$code} = $latex;
1.1048    foxr      221: 		}
1.158     raeburn   222:             }
                    223:             close($fh);
                    224:         }
1.12      harris41  225:     }
                    226: # ------------------------------------------------------------------ copyrights
                    227:     {
1.158     raeburn   228:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    229:                                   '/copyright.tab';
1.1317    raeburn   230:         if ( open (my $fh,'<',$copyrightfile) ) {
1.356     albertel  231:             while (my $line = <$fh>) {
                    232:                 next if ($line=~/^\#/);
                    233:                 chomp($line);
                    234:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   235:                 $cprtag{$key}=$val;
                    236:             }
                    237:             close($fh);
                    238:         }
1.12      harris41  239:     }
1.351     www       240: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  241:     {
                    242:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    243:                                   '/source_copyright.tab';
1.1317    raeburn   244:         if ( open (my $fh,'<',$sourcecopyrightfile) ) {
1.356     albertel  245:             while (my $line = <$fh>) {
                    246:                 next if ($line =~ /^\#/);
                    247:                 chomp($line);
                    248:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  249:                 $scprtag{$key}=$val;
                    250:             }
                    251:             close($fh);
                    252:         }
                    253:     }
1.63      www       254: 
1.517     raeburn   255: # -------------------------------------------------------------- default domain designs
1.63      www       256:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   257:     my $designfile = $designdir.'/default.tab';
1.1317    raeburn   258:     if ( open (my $fh,'<',$designfile) ) {
1.517     raeburn   259:         while (my $line = <$fh>) {
                    260:             next if ($line =~ /^\#/);
                    261:             chomp($line);
                    262:             my ($key,$val)=(split(/\=/,$line));
                    263:             if ($val) { $defaultdesign{$key}=$val; }
                    264:         }
                    265:         close($fh);
1.63      www       266:     }
                    267: 
1.15      harris41  268: # ------------------------------------------------------------- file categories
                    269:     {
1.158     raeburn   270:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    271:                                   '/filecategories.tab';
1.1317    raeburn   272:         if ( open (my $fh,'<',$categoryfile) ) {
1.356     albertel  273: 	    while (my $line = <$fh>) {
                    274: 		next if ($line =~ /^\#/);
                    275: 		chomp($line);
                    276:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.1263    raeburn   277:                 push(@{$category_extensions{lc($category)}},$extension);
1.158     raeburn   278:             }
                    279:             close($fh);
                    280:         }
                    281: 
1.15      harris41  282:     }
1.12      harris41  283: # ------------------------------------------------------------------ file types
                    284:     {
1.158     raeburn   285:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    286:                '/filetypes.tab';
1.1317    raeburn   287:         if ( open (my $fh,'<',$typesfile) ) {
1.356     albertel  288:             while (my $line = <$fh>) {
                    289: 		next if ($line =~ /^\#/);
                    290: 		chomp($line);
                    291:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   292:                 if ($descr ne '') {
                    293:                     $fe{$ending}=lc($emb);
                    294:                     $fd{$ending}=$descr;
1.351     www       295:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   296:                 }
                    297:             }
                    298:             close($fh);
                    299:         }
1.12      harris41  300:     }
1.22      www       301:     &Apache::lonnet::logthis(
1.705     tempelho  302:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       303:     $readit=1;
1.46      matthew   304:     }  # end of unless($readit) 
1.32      matthew   305:     
                    306: }
1.112     bowersj2  307: 
1.42      matthew   308: ###############################################################
                    309: ##           HTML and Javascript Helper Functions            ##
                    310: ###############################################################
                    311: 
                    312: =pod 
                    313: 
1.112     bowersj2  314: =head1 HTML and Javascript Functions
1.42      matthew   315: 
1.112     bowersj2  316: =over 4
                    317: 
1.648     raeburn   318: =item * &browser_and_searcher_javascript()
1.112     bowersj2  319: 
                    320: X<browsing, javascript>X<searching, javascript>Returns a string
                    321: containing javascript with two functions, C<openbrowser> and
                    322: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    323: tags.
1.42      matthew   324: 
1.648     raeburn   325: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   326: 
                    327: inputs: formname, elementname, only, omit
                    328: 
                    329: formname and elementname indicate the name of the html form and name of
                    330: the element that the results of the browsing selection are to be placed in. 
                    331: 
                    332: Specifying 'only' will restrict the browser to displaying only files
1.185     www       333: with the given extension.  Can be a comma separated list.
1.42      matthew   334: 
                    335: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       336: with the given extension.  Can be a comma separated list.
1.42      matthew   337: 
1.648     raeburn   338: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   339: 
                    340: Inputs: formname, elementname
                    341: 
                    342: formname and elementname specify the name of the html form and the name
                    343: of the element the selection from the search results will be placed in.
1.542     raeburn   344: 
1.42      matthew   345: =cut
                    346: 
                    347: sub browser_and_searcher_javascript {
1.199     albertel  348:     my ($mode)=@_;
                    349:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  350:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   351:     return <<END;
1.219     albertel  352: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   353:     var editbrowser = null;
1.135     albertel  354:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       355:         var url = '$resurl/?';
1.42      matthew   356:         if (editbrowser == null) {
                    357:             url += 'launch=1&';
                    358:         }
                    359:         url += 'catalogmode=interactive&';
1.199     albertel  360:         url += 'mode=$mode&';
1.611     albertel  361:         url += 'inhibitmenu=yes&';
1.42      matthew   362:         url += 'form=' + formname + '&';
                    363:         if (only != null) {
                    364:             url += 'only=' + only + '&';
1.217     albertel  365:         } else {
                    366:             url += 'only=&';
                    367: 	}
1.42      matthew   368:         if (omit != null) {
                    369:             url += 'omit=' + omit + '&';
1.217     albertel  370:         } else {
                    371:             url += 'omit=&';
                    372: 	}
1.135     albertel  373:         if (titleelement != null) {
                    374:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  375:         } else {
                    376: 	    url += 'titleelement=&';
                    377: 	}
1.42      matthew   378:         url += 'element=' + elementname + '';
                    379:         var title = 'Browser';
1.435     albertel  380:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   381:         options += ',width=700,height=600';
                    382:         editbrowser = open(url,title,options,'1');
                    383:         editbrowser.focus();
                    384:     }
                    385:     var editsearcher;
1.135     albertel  386:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   387:         var url = '/adm/searchcat?';
                    388:         if (editsearcher == null) {
                    389:             url += 'launch=1&';
                    390:         }
                    391:         url += 'catalogmode=interactive&';
1.199     albertel  392:         url += 'mode=$mode&';
1.42      matthew   393:         url += 'form=' + formname + '&';
1.135     albertel  394:         if (titleelement != null) {
                    395:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  396:         } else {
                    397: 	    url += 'titleelement=&';
                    398: 	}
1.42      matthew   399:         url += 'element=' + elementname + '';
                    400:         var title = 'Search';
1.435     albertel  401:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   402:         options += ',width=700,height=600';
                    403:         editsearcher = open(url,title,options,'1');
                    404:         editsearcher.focus();
                    405:     }
1.219     albertel  406: // END LON-CAPA Internal -->
1.42      matthew   407: END
1.170     www       408: }
                    409: 
                    410: sub lastresurl {
1.258     albertel  411:     if ($env{'environment.lastresurl'}) {
                    412: 	return $env{'environment.lastresurl'}
1.170     www       413:     } else {
                    414: 	return '/res';
                    415:     }
                    416: }
                    417: 
                    418: sub storeresurl {
                    419:     my $resurl=&Apache::lonnet::clutter(shift);
                    420:     unless ($resurl=~/^\/res/) { return 0; }
                    421:     $resurl=~s/\/$//;
                    422:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   423:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       424:     return 1;
1.42      matthew   425: }
                    426: 
1.74      www       427: sub studentbrowser_javascript {
1.111     www       428:    unless (
1.258     albertel  429:             (($env{'request.course.id'}) && 
1.302     albertel  430:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    431: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    432: 					  '/'.$env{'request.course.sec'})
                    433: 	      ))
1.258     albertel  434:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       435:           ) { return ''; }  
1.74      www       436:    return (<<'ENDSTDBRW');
1.776     bisitz    437: <script type="text/javascript" language="Javascript">
1.824     bisitz    438: // <![CDATA[
1.74      www       439:     var stdeditbrowser;
1.1413    raeburn   440:     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv,uident) {
1.74      www       441:         var url = '/adm/pickstudent?';
                    442:         var filter;
1.558     albertel  443: 	if (!ignorefilter) {
                    444: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    445: 	}
1.74      www       446:         if (filter != null) {
                    447:            if (filter != '') {
                    448:                url += 'filter='+filter+'&';
                    449: 	   }
                    450:         }
                    451:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       452:                                     '&udomelement='+udom+
                    453:                                     '&clicker='+clicker;
1.111     www       454: 	if (roleflag) { url+="&roles=1"; }
1.1337    raeburn   455:         if (courseadv == 'condition') {
                    456:             if (document.getElementById('courseadv')) {
                    457:                 courseadv = document.getElementById('courseadv').value;
                    458:             }
                    459:         }
                    460:         if ((courseadv == 'only') || (courseadv == 'none')) { url+="&courseadv="+courseadv; }
1.1413    raeburn   461:         if (uident !== '') { url+="&identelement="+uident; } 
1.102     www       462:         var title = 'Student_Browser';
1.74      www       463:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    464:         options += ',width=700,height=600';
                    465:         stdeditbrowser = open(url,title,options,'1');
                    466:         stdeditbrowser.focus();
                    467:     }
1.824     bisitz    468: // ]]>
1.74      www       469: </script>
                    470: ENDSTDBRW
                    471: }
1.42      matthew   472: 
1.1003    www       473: sub resourcebrowser_javascript {
                    474:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       475:    return (<<'ENDRESBRW');
1.1003    www       476: <script type="text/javascript" language="Javascript">
                    477: // <![CDATA[
                    478:     var reseditbrowser;
1.1004    www       479:     function openresbrowser(formname,reslink) {
1.1005    www       480:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       481:         var title = 'Resource_Browser';
                    482:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       483:         options += ',width=700,height=500';
1.1004    www       484:         reseditbrowser = open(url,title,options,'1');
                    485:         reseditbrowser.focus();
1.1003    www       486:     }
                    487: // ]]>
                    488: </script>
1.1004    www       489: ENDRESBRW
1.1003    www       490: }
                    491: 
1.74      www       492: sub selectstudent_link {
1.1413    raeburn   493:    my ($form,$unameele,$udomele,$courseadv,$clickerid,$identelem)=@_;
1.999     www       494:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    495:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    496:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  497:    if ($env{'request.course.id'}) {  
1.302     albertel  498:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    499: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    500: 					'/'.$env{'request.course.sec'})) {
1.111     www       501: 	   return '';
                    502:        }
1.999     www       503:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.1337    raeburn   504:        if ($courseadv eq 'only') {
                    505:            $callargs .= ",'',1,'$courseadv'";
                    506:        } elsif ($courseadv eq 'none') {
                    507:            $callargs .= ",'','','$courseadv'";
                    508:        } elsif ($courseadv eq 'condition') {
                    509:            $callargs .= ",'','','$courseadv'";
1.1413    raeburn   510:        } elsif ($identelem ne '') {
                    511:            $callargs .= ",'','',''";
                    512:        }
                    513:        if ($identelem ne '') {
                    514:            $callargs .= ",'".&Apache::lonhtmlcommon::entity_encode($identelem)."'";
1.793     raeburn   515:        }
                    516:        return '<span class="LC_nobreak">'.
                    517:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    518:               &mt('Select User').'</a></span>';
1.74      www       519:    }
1.258     albertel  520:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       521:        $callargs .= ",'',1"; 
1.793     raeburn   522:        return '<span class="LC_nobreak">'.
                    523:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    524:               &mt('Select User').'</a></span>';
1.111     www       525:    }
                    526:    return '';
1.91      www       527: }
                    528: 
1.1004    www       529: sub selectresource_link {
                    530:    my ($form,$reslink,$arg)=@_;
                    531:    
                    532:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    533:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    534:    unless ($env{'request.course.id'}) { return $arg; }
                    535:    return '<span class="LC_nobreak">'.
                    536:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    537:               $arg.'</a></span>';
                    538: }
                    539: 
                    540: 
                    541: 
1.653     raeburn   542: sub authorbrowser_javascript {
                    543:     return <<"ENDAUTHORBRW";
1.776     bisitz    544: <script type="text/javascript" language="JavaScript">
1.824     bisitz    545: // <![CDATA[
1.653     raeburn   546: var stdeditbrowser;
                    547: 
                    548: function openauthorbrowser(formname,udom) {
                    549:     var url = '/adm/pickauthor?';
                    550:     url += 'form='+formname+'&roledom='+udom;
                    551:     var title = 'Author_Browser';
                    552:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    553:     options += ',width=700,height=600';
                    554:     stdeditbrowser = open(url,title,options,'1');
                    555:     stdeditbrowser.focus();
                    556: }
                    557: 
1.824     bisitz    558: // ]]>
1.653     raeburn   559: </script>
                    560: ENDAUTHORBRW
                    561: }
                    562: 
1.91      www       563: sub coursebrowser_javascript {
1.1116    raeburn   564:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1221    raeburn   565:         $credits_element,$instcode) = @_;
1.932     raeburn   566:     my $wintitle = 'Course_Browser';
1.931     raeburn   567:     if ($crstype eq 'Community') {
1.932     raeburn   568:         $wintitle = 'Community_Browser';
1.909     raeburn   569:     }
1.876     raeburn   570:     my $id_functions = &javascript_index_functions();
                    571:     my $output = '
1.776     bisitz    572: <script type="text/javascript" language="JavaScript">
1.824     bisitz    573: // <![CDATA[
1.468     raeburn   574:     var stdeditbrowser;'."\n";
1.876     raeburn   575: 
                    576:     $output .= <<"ENDSTDBRW";
1.909     raeburn   577:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       578:         var url = '/adm/pickcourse?';
1.895     raeburn   579:         var formid = getFormIdByName(formname);
1.876     raeburn   580:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  581:         if (domainfilter != null) {
                    582:            if (domainfilter != '') {
                    583:                url += 'domainfilter='+domainfilter+'&';
                    584: 	   }
                    585:         }
1.91      www       586:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  587: 	                            '&cdomelement='+udom+
                    588:                                     '&cnameelement='+desc;
1.468     raeburn   589:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   590:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   591:                 url += '&roleelement='+extra_element;
                    592:                 if (domainfilter == null || domainfilter == '') {
                    593:                     url += '&domainfilter='+extra_element;
                    594:                 }
1.234     raeburn   595:             }
1.468     raeburn   596:             else {
                    597:                 if (formname == 'portform') {
                    598:                     url += '&setroles='+extra_element;
1.800     raeburn   599:                 } else {
                    600:                     if (formname == 'rules') {
                    601:                         url += '&fixeddom='+extra_element; 
                    602:                     }
1.468     raeburn   603:                 }
                    604:             }     
1.230     raeburn   605:         }
1.909     raeburn   606:         if (type != null && type != '') {
                    607:             url += '&type='+type;
                    608:         }
                    609:         if (type_elem != null && type_elem != '') {
                    610:             url += '&typeelement='+type_elem;
                    611:         }
1.872     raeburn   612:         if (formname == 'ccrs') {
                    613:             var ownername = document.forms[formid].ccuname.value;
                    614:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1238    raeburn   615:             url += '&cloner='+ownername+':'+ownerdom;
                    616:             if (type == 'Course') {
                    617:                 url += '&crscode='+document.forms[formid].crscode.value;
                    618:             }
1.1221    raeburn   619:         }
                    620:         if (formname == 'requestcrs') {
                    621:             url += '&crsdom=$domainfilter&crscode=$instcode';
1.872     raeburn   622:         }
1.293     raeburn   623:         if (multflag !=null && multflag != '') {
                    624:             url += '&multiple='+multflag;
                    625:         }
1.909     raeburn   626:         var title = '$wintitle';
1.91      www       627:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    628:         options += ',width=700,height=600';
                    629:         stdeditbrowser = open(url,title,options,'1');
                    630:         stdeditbrowser.focus();
                    631:     }
1.876     raeburn   632: $id_functions
                    633: ENDSTDBRW
1.1116    raeburn   634:     if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
                    635:         $output .= &setsec_javascript($sec_element,$formname,$role_element,
                    636:                                       $credits_element);
1.876     raeburn   637:     }
                    638:     $output .= '
                    639: // ]]>
                    640: </script>';
                    641:     return $output;
                    642: }
                    643: 
                    644: sub javascript_index_functions {
                    645:     return <<"ENDJS";
                    646: 
                    647: function getFormIdByName(formname) {
                    648:     for (var i=0;i<document.forms.length;i++) {
                    649:         if (document.forms[i].name == formname) {
                    650:             return i;
                    651:         }
                    652:     }
                    653:     return -1;
                    654: }
                    655: 
                    656: function getIndexByName(formid,item) {
                    657:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    658:         if (document.forms[formid].elements[i].name == item) {
                    659:             return i;
                    660:         }
                    661:     }
                    662:     return -1;
                    663: }
1.468     raeburn   664: 
1.876     raeburn   665: function getDomainFromSelectbox(formname,udom) {
                    666:     var userdom;
                    667:     var formid = getFormIdByName(formname);
                    668:     if (formid > -1) {
                    669:         var domid = getIndexByName(formid,udom);
                    670:         if (domid > -1) {
                    671:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    672:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    673:             }
                    674:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    675:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   676:             }
                    677:         }
                    678:     }
1.876     raeburn   679:     return userdom;
                    680: }
                    681: 
                    682: ENDJS
1.468     raeburn   683: 
1.876     raeburn   684: }
                    685: 
1.1017    raeburn   686: sub javascript_array_indexof {
1.1018    raeburn   687:     return <<ENDJS;
1.1017    raeburn   688: <script type="text/javascript" language="JavaScript">
                    689: // <![CDATA[
                    690: 
                    691: if (!Array.prototype.indexOf) {
                    692:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    693:         "use strict";
                    694:         if (this === void 0 || this === null) {
                    695:             throw new TypeError();
                    696:         }
                    697:         var t = Object(this);
                    698:         var len = t.length >>> 0;
                    699:         if (len === 0) {
                    700:             return -1;
                    701:         }
                    702:         var n = 0;
                    703:         if (arguments.length > 0) {
                    704:             n = Number(arguments[1]);
1.1088    foxr      705:             if (n !== n) { // shortcut for verifying if it is NaN
1.1017    raeburn   706:                 n = 0;
                    707:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    708:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    709:             }
                    710:         }
                    711:         if (n >= len) {
                    712:             return -1;
                    713:         }
                    714:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    715:         for (; k < len; k++) {
                    716:             if (k in t && t[k] === searchElement) {
                    717:                 return k;
                    718:             }
                    719:         }
                    720:         return -1;
                    721:     }
                    722: }
                    723: 
                    724: // ]]>
                    725: </script>
                    726: 
                    727: ENDJS
                    728: 
                    729: }
                    730: 
1.876     raeburn   731: sub userbrowser_javascript {
                    732:     my $id_functions = &javascript_index_functions();
                    733:     return <<"ENDUSERBRW";
                    734: 
1.888     raeburn   735: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   736:     var url = '/adm/pickuser?';
                    737:     var userdom = getDomainFromSelectbox(formname,udom);
                    738:     if (userdom != null) {
                    739:        if (userdom != '') {
                    740:            url += 'srchdom='+userdom+'&';
                    741:        }
                    742:     }
                    743:     url += 'form=' + formname + '&unameelement='+uname+
                    744:                                 '&udomelement='+udom+
                    745:                                 '&ulastelement='+ulast+
                    746:                                 '&ufirstelement='+ufirst+
                    747:                                 '&uemailelement='+uemail+
1.881     raeburn   748:                                 '&hideudomelement='+hideudom+
                    749:                                 '&coursedom='+crsdom;
1.888     raeburn   750:     if ((caller != null) && (caller != undefined)) {
                    751:         url += '&caller='+caller;
                    752:     }
1.876     raeburn   753:     var title = 'User_Browser';
                    754:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    755:     options += ',width=700,height=600';
                    756:     var stdeditbrowser = open(url,title,options,'1');
                    757:     stdeditbrowser.focus();
                    758: }
                    759: 
1.888     raeburn   760: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   761:     var formid = getFormIdByName(formname);
                    762:     if (formid > -1) {
1.888     raeburn   763:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   764:         var domid = getIndexByName(formid,udom);
                    765:         var hidedomid = getIndexByName(formid,origdom);
                    766:         if (hidedomid > -1) {
                    767:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   768:             var unameval = document.forms[formid].elements[unameid].value;
                    769:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    770:                 if (domid > -1) {
                    771:                     var slct = document.forms[formid].elements[domid];
                    772:                     if (slct.type == 'select-one') {
                    773:                         var i;
                    774:                         for (i=0;i<slct.length;i++) {
                    775:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    776:                         }
                    777:                     }
                    778:                     if (slct.type == 'hidden') {
                    779:                         slct.value = fixeddom;
1.876     raeburn   780:                     }
                    781:                 }
1.468     raeburn   782:             }
                    783:         }
                    784:     }
1.876     raeburn   785:     return;
                    786: }
                    787: 
                    788: $id_functions
                    789: ENDUSERBRW
1.468     raeburn   790: }
                    791: 
                    792: sub setsec_javascript {
1.1116    raeburn   793:     my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905     raeburn   794:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    795:         $communityrolestr);
                    796:     if ($role_element ne '') {
                    797:         my @allroles = ('st','ta','ep','in','ad');
                    798:         foreach my $crstype ('Course','Community') {
                    799:             if ($crstype eq 'Community') {
                    800:                 foreach my $role (@allroles) {
                    801:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    802:                 }
                    803:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    804:             } else {
                    805:                 foreach my $role (@allroles) {
                    806:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    807:                 }
                    808:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    809:             }
                    810:         }
                    811:         $rolestr = '"'.join('","',@allroles).'"';
                    812:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    813:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    814:     }
1.468     raeburn   815:     my $setsections = qq|
                    816: function setSect(sectionlist) {
1.629     raeburn   817:     var sectionsArray = new Array();
                    818:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    819:         sectionsArray = sectionlist.split(",");
                    820:     }
1.468     raeburn   821:     var numSections = sectionsArray.length;
                    822:     document.$formname.$sec_element.length = 0;
                    823:     if (numSections == 0) {
                    824:         document.$formname.$sec_element.multiple=false;
                    825:         document.$formname.$sec_element.size=1;
                    826:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    827:     } else {
                    828:         if (numSections == 1) {
                    829:             document.$formname.$sec_element.multiple=false;
                    830:             document.$formname.$sec_element.size=1;
                    831:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    832:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    833:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    834:         } else {
                    835:             for (var i=0; i<numSections; i++) {
                    836:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    837:             }
                    838:             document.$formname.$sec_element.multiple=true
                    839:             if (numSections < 3) {
                    840:                 document.$formname.$sec_element.size=numSections;
                    841:             } else {
                    842:                 document.$formname.$sec_element.size=3;
                    843:             }
                    844:             document.$formname.$sec_element.options[0].selected = false
                    845:         }
                    846:     }
1.91      www       847: }
1.905     raeburn   848: 
                    849: function setRole(crstype) {
1.468     raeburn   850: |;
1.905     raeburn   851:     if ($role_element eq '') {
                    852:         $setsections .= '    return;
                    853: }
                    854: ';
                    855:     } else {
                    856:         $setsections .= qq|
                    857:     var elementLength = document.$formname.$role_element.length;
                    858:     var allroles = Array($rolestr);
                    859:     var courserolenames = Array($courserolestr);
                    860:     var communityrolenames = Array($communityrolestr);
                    861:     if (elementLength != undefined) {
                    862:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    863:             if (crstype == 'Course') {
                    864:                 return;
                    865:             } else {
                    866:                 allroles[5] = 'co';
                    867:                 for (var i=0; i<6; i++) {
                    868:                     document.$formname.$role_element.options[i].value = allroles[i];
                    869:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    870:                 }
                    871:             }
                    872:         } else {
                    873:             if (crstype == 'Community') {
                    874:                 return;
                    875:             } else {
                    876:                 allroles[5] = 'cc';
                    877:                 for (var i=0; i<6; i++) {
                    878:                     document.$formname.$role_element.options[i].value = allroles[i];
                    879:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    880:                 }
                    881:             }
                    882:         }
                    883:     }
                    884:     return;
                    885: }
                    886: |;
                    887:     }
1.1116    raeburn   888:     if ($credits_element) {
                    889:         $setsections .= qq|
                    890: function setCredits(defaultcredits) {
                    891:     document.$formname.$credits_element.value = defaultcredits;
                    892:     return;
                    893: }
                    894: |;
                    895:     }
1.468     raeburn   896:     return $setsections;
                    897: }
                    898: 
1.91      www       899: sub selectcourse_link {
1.909     raeburn   900:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    901:        $typeelement) = @_;
                    902:    my $type = $selecttype;
1.871     raeburn   903:    my $linktext = &mt('Select Course');
                    904:    if ($selecttype eq 'Community') {
1.909     raeburn   905:        $linktext = &mt('Select Community');
1.1239    raeburn   906:    } elsif ($selecttype eq 'Placement') {
                    907:        $linktext = &mt('Select Placement Test'); 
1.906     raeburn   908:    } elsif ($selecttype eq 'Course/Community') {
                    909:        $linktext = &mt('Select Course/Community');
1.909     raeburn   910:        $type = '';
1.1019    raeburn   911:    } elsif ($selecttype eq 'Select') {
                    912:        $linktext = &mt('Select');
                    913:        $type = '';
1.871     raeburn   914:    }
1.787     bisitz    915:    return '<span class="LC_nobreak">'
                    916:          ."<a href='"
                    917:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    918:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   919:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   920:          ."'>".$linktext.'</a>'
1.787     bisitz    921:          .'</span>';
1.74      www       922: }
1.42      matthew   923: 
1.653     raeburn   924: sub selectauthor_link {
                    925:    my ($form,$udom)=@_;
                    926:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    927:           &mt('Select Author').'</a>';
                    928: }
                    929: 
1.876     raeburn   930: sub selectuser_link {
1.881     raeburn   931:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   932:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   933:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   934:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   935:            ');">'.$linktext.'</a>';
1.876     raeburn   936: }
                    937: 
1.273     raeburn   938: sub check_uncheck_jscript {
                    939:     my $jscript = <<"ENDSCRT";
                    940: function checkAll(field) {
                    941:     if (field.length > 0) {
                    942:         for (i = 0; i < field.length; i++) {
1.1093    raeburn   943:             if (!field[i].disabled) { 
                    944:                 field[i].checked = true;
                    945:             }
1.273     raeburn   946:         }
                    947:     } else {
1.1093    raeburn   948:         if (!field.disabled) { 
                    949:             field.checked = true;
                    950:         }
1.273     raeburn   951:     }
                    952: }
                    953:  
                    954: function uncheckAll(field) {
                    955:     if (field.length > 0) {
                    956:         for (i = 0; i < field.length; i++) {
                    957:             field[i].checked = false ;
1.543     albertel  958:         }
                    959:     } else {
1.273     raeburn   960:         field.checked = false ;
                    961:     }
                    962: }
                    963: ENDSCRT
                    964:     return $jscript;
                    965: }
                    966: 
1.656     www       967: sub select_timezone {
1.1387    raeburn   968:    my ($name,$selected,$onchange,$includeempty,$id,$disabled)=@_;
                    969:    my $output='<select name="'.$name.'" '.$id.$onchange.$disabled.'>'."\n";
1.659     raeburn   970:    if ($includeempty) {
                    971:        $output .= '<option value=""';
                    972:        if (($selected eq '') || ($selected eq 'local')) {
                    973:            $output .= ' selected="selected" ';
                    974:        }
                    975:        $output .= '> </option>';
                    976:    }
1.657     raeburn   977:    my @timezones = DateTime::TimeZone->all_names;
                    978:    foreach my $tzone (@timezones) {
                    979:        $output.= '<option value="'.$tzone.'"';
                    980:        if ($tzone eq $selected) {
                    981:            $output.=' selected="selected"';
                    982:        }
                    983:        $output.=">$tzone</option>\n";
1.656     www       984:    }
                    985:    $output.="</select>";
                    986:    return $output;
                    987: }
1.273     raeburn   988: 
1.687     raeburn   989: sub select_datelocale {
1.1256    raeburn   990:     my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
                    991:     my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.687     raeburn   992:     if ($includeempty) {
                    993:         $output .= '<option value=""';
                    994:         if ($selected eq '') {
                    995:             $output .= ' selected="selected" ';
                    996:         }
                    997:         $output .= '> </option>';
                    998:     }
1.1241    raeburn   999:     my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn  1000:     my (@possibles,%locale_names);
1.1241    raeburn  1001:     my @locales = DateTime::Locale->ids();
                   1002:     foreach my $id (@locales) {
                   1003:         if ($id ne '') {
                   1004:             my ($en_terr,$native_terr);
                   1005:             my $loc = DateTime::Locale->load($id);
                   1006:             if (ref($loc)) {
                   1007:                 $en_terr = $loc->name();
                   1008:                 $native_terr = $loc->native_name();
1.687     raeburn  1009:                 if (grep(/^en$/,@languages) || !@languages) {
                   1010:                     if ($en_terr ne '') {
                   1011:                         $locale_names{$id} = '('.$en_terr.')';
                   1012:                     } elsif ($native_terr ne '') {
                   1013:                         $locale_names{$id} = $native_terr;
                   1014:                     }
                   1015:                 } else {
                   1016:                     if ($native_terr ne '') {
                   1017:                         $locale_names{$id} = $native_terr.' ';
                   1018:                     } elsif ($en_terr ne '') {
                   1019:                         $locale_names{$id} = '('.$en_terr.')';
                   1020:                     }
                   1021:                 }
1.1220    raeburn  1022:                 $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1241    raeburn  1023:                 push(@possibles,$id);
                   1024:             } 
1.687     raeburn  1025:         }
                   1026:     }
                   1027:     foreach my $item (sort(@possibles)) {
                   1028:         $output.= '<option value="'.$item.'"';
                   1029:         if ($item eq $selected) {
                   1030:             $output.=' selected="selected"';
                   1031:         }
                   1032:         $output.=">$item";
                   1033:         if ($locale_names{$item} ne '') {
1.1220    raeburn  1034:             $output.='  '.$locale_names{$item};
1.687     raeburn  1035:         }
                   1036:         $output.="</option>\n";
                   1037:     }
                   1038:     $output.="</select>";
                   1039:     return $output;
                   1040: }
                   1041: 
1.792     raeburn  1042: sub select_language {
1.1256    raeburn  1043:     my ($name,$selected,$includeempty,$noedit) = @_;
1.792     raeburn  1044:     my %langchoices;
                   1045:     if ($includeempty) {
1.1117    raeburn  1046:         %langchoices = ('' => 'No language preference');
1.792     raeburn  1047:     }
                   1048:     foreach my $id (&languageids()) {
                   1049:         my $code = &supportedlanguagecode($id);
                   1050:         if ($code) {
                   1051:             $langchoices{$code} = &plainlanguagedescription($id);
                   1052:         }
                   1053:     }
1.1117    raeburn  1054:     %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.1256    raeburn  1055:     return &select_form($selected,$name,\%langchoices,undef,$noedit);
1.792     raeburn  1056: }
                   1057: 
1.42      matthew  1058: =pod
1.36      matthew  1059: 
1.1088    foxr     1060: 
                   1061: =item * &list_languages()
                   1062: 
                   1063: Returns an array reference that is suitable for use in language prompters.
                   1064: Each array element is itself a two element array.  The first element
                   1065: is the language code.  The second element a descsriptiuon of the 
                   1066: language itself.  This is suitable for use in e.g.
                   1067: &Apache::edit::select_arg (once dereferenced that is).
                   1068: 
                   1069: =cut 
                   1070: 
                   1071: sub list_languages {
                   1072:     my @lang_choices;
                   1073: 
                   1074:     foreach my $id (&languageids()) {
                   1075: 	my $code = &supportedlanguagecode($id);
                   1076: 	if ($code) {
                   1077: 	    my $selector    = $supported_codes{$id};
                   1078: 	    my $description = &plainlanguagedescription($id);
1.1263    raeburn  1079: 	    push(@lang_choices, [$selector, $description]);
1.1088    foxr     1080: 	}
                   1081:     }
                   1082:     return \@lang_choices;
                   1083: }
                   1084: 
                   1085: =pod
                   1086: 
1.648     raeburn  1087: =item * &linked_select_forms(...)
1.36      matthew  1088: 
                   1089: linked_select_forms returns a string containing a <script></script> block
                   1090: and html for two <select> menus.  The select menus will be linked in that
                   1091: changing the value of the first menu will result in new values being placed
                   1092: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1093: order unless a defined order is provided.
1.36      matthew  1094: 
                   1095: linked_select_forms takes the following ordered inputs:
                   1096: 
                   1097: =over 4
                   1098: 
1.112     bowersj2 1099: =item * $formname, the name of the <form> tag
1.36      matthew  1100: 
1.112     bowersj2 1101: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1102: 
1.112     bowersj2 1103: =item * $firstdefault, the default value for the first menu
1.36      matthew  1104: 
1.112     bowersj2 1105: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1106: 
1.112     bowersj2 1107: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1108: 
1.112     bowersj2 1109: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1110: 
1.609     raeburn  1111: =item * $menuorder, the order of values in the first menu
                   1112: 
1.1115    raeburn  1113: =item * $onchangefirst, additional javascript call to execute for an onchange
                   1114:         event for the first <select> tag
                   1115: 
                   1116: =item * $onchangesecond, additional javascript call to execute for an onchange
                   1117:         event for the second <select> tag
                   1118: 
1.1245    raeburn  1119: =item * $suffix, to differentiate separate uses of select2data javascript
                   1120:         objects in a page.
                   1121: 
1.41      ng       1122: =back 
                   1123: 
1.36      matthew  1124: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1125: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1126: values for the first select menu.  The text that coincides with the 
1.41      ng       1127: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1128: and text for the second menu are given in the hash pointed to by 
                   1129: $menu{$choice1}->{'select2'}.  
                   1130: 
1.112     bowersj2 1131:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1132:                        default => "B3",
                   1133:                        select2 => { 
                   1134:                            B1 => "Choice B1",
                   1135:                            B2 => "Choice B2",
                   1136:                            B3 => "Choice B3",
                   1137:                            B4 => "Choice B4"
1.609     raeburn  1138:                            },
                   1139:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1140:                    },
                   1141:                A2 => { text =>"Choice A2" ,
                   1142:                        default => "C2",
                   1143:                        select2 => { 
                   1144:                            C1 => "Choice C1",
                   1145:                            C2 => "Choice C2",
                   1146:                            C3 => "Choice C3"
1.609     raeburn  1147:                            },
                   1148:                        order => ['C2','C1','C3'],
1.112     bowersj2 1149:                    },
                   1150:                A3 => { text =>"Choice A3" ,
                   1151:                        default => "D6",
                   1152:                        select2 => { 
                   1153:                            D1 => "Choice D1",
                   1154:                            D2 => "Choice D2",
                   1155:                            D3 => "Choice D3",
                   1156:                            D4 => "Choice D4",
                   1157:                            D5 => "Choice D5",
                   1158:                            D6 => "Choice D6",
                   1159:                            D7 => "Choice D7"
1.609     raeburn  1160:                            },
                   1161:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1162:                    }
                   1163:                );
1.36      matthew  1164: 
                   1165: =cut
                   1166: 
                   1167: sub linked_select_forms {
                   1168:     my ($formname,
                   1169:         $middletext,
                   1170:         $firstdefault,
                   1171:         $firstselectname,
                   1172:         $secondselectname, 
1.609     raeburn  1173:         $hashref,
                   1174:         $menuorder,
1.1115    raeburn  1175:         $onchangefirst,
1.1245    raeburn  1176:         $onchangesecond,
                   1177:         $suffix
1.36      matthew  1178:         ) = @_;
                   1179:     my $second = "document.$formname.$secondselectname";
                   1180:     my $first = "document.$formname.$firstselectname";
                   1181:     # output the javascript to do the changing
                   1182:     my $result = '';
1.776     bisitz   1183:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1184:     $result.="// <![CDATA[\n";
1.1245    raeburn  1185:     $result.="var select2data${suffix} = new Object();\n";
1.36      matthew  1186:     $" = '","';
                   1187:     my $debug = '';
                   1188:     foreach my $s1 (sort(keys(%$hashref))) {
1.1245    raeburn  1189:         $result.="select2data${suffix}['d_$s1'] = new Object();\n";        
                   1190:         $result.="select2data${suffix}['d_$s1'].def = new String('".
1.36      matthew  1191:             $hashref->{$s1}->{'default'}."');\n";
1.1245    raeburn  1192:         $result.="select2data${suffix}['d_$s1'].values = new Array(";
1.36      matthew  1193:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1194:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1195:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1196:         }
1.36      matthew  1197:         $result.="\"@s2values\");\n";
1.1245    raeburn  1198:         $result.="select2data${suffix}['d_$s1'].texts = new Array(";        
1.36      matthew  1199:         my @s2texts;
                   1200:         foreach my $value (@s2values) {
1.1263    raeburn  1201:             push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
1.36      matthew  1202:         }
                   1203:         $result.="\"@s2texts\");\n";
                   1204:     }
                   1205:     $"=' ';
                   1206:     $result.= <<"END";
                   1207: 
1.1245    raeburn  1208: function select1${suffix}_changed() {
1.36      matthew  1209:     // Determine new choice
1.1245    raeburn  1210:     var newvalue = "d_" + $first.options[$first.selectedIndex].value;
1.36      matthew  1211:     // update select2
1.1245    raeburn  1212:     var values     = select2data${suffix}[newvalue].values;
                   1213:     var texts      = select2data${suffix}[newvalue].texts;
                   1214:     var select2def = select2data${suffix}[newvalue].def;
1.36      matthew  1215:     var i;
                   1216:     // out with the old
1.1245    raeburn  1217:     $second.options.length = 0;
                   1218:     // in with the new
1.36      matthew  1219:     for (i=0;i<values.length; i++) {
                   1220:         $second.options[i] = new Option(values[i]);
1.143     matthew  1221:         $second.options[i].value = values[i];
1.36      matthew  1222:         $second.options[i].text = texts[i];
                   1223:         if (values[i] == select2def) {
                   1224:             $second.options[i].selected = true;
                   1225:         }
                   1226:     }
                   1227: }
1.824     bisitz   1228: // ]]>
1.36      matthew  1229: </script>
                   1230: END
                   1231:     # output the initial values for the selection lists
1.1245    raeburn  1232:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1${suffix}_changed();$onchangefirst\">\n";
1.609     raeburn  1233:     my @order = sort(keys(%{$hashref}));
                   1234:     if (ref($menuorder) eq 'ARRAY') {
                   1235:         @order = @{$menuorder};
                   1236:     }
                   1237:     foreach my $value (@order) {
1.36      matthew  1238:         $result.="    <option value=\"$value\" ";
1.253     albertel 1239:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1240:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1241:     }
                   1242:     $result .= "</select>\n";
1.1400    raeburn  1243:     my %select2;
                   1244:     if (ref($hashref->{$firstdefault}) eq 'HASH') {
                   1245:         if (ref($hashref->{$firstdefault}->{'select2'}) eq 'HASH') {
                   1246:             %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1247:         }
                   1248:     }
1.36      matthew  1249:     $result .= $middletext;
1.1115    raeburn  1250:     $result .= "<select size=\"1\" name=\"$secondselectname\"";
                   1251:     if ($onchangesecond) {
                   1252:         $result .= ' onchange="'.$onchangesecond.'"';
                   1253:     }
                   1254:     $result .= ">\n";
1.36      matthew  1255:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1256:     
                   1257:     my @secondorder = sort(keys(%select2));
                   1258:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1259:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1260:     }
                   1261:     foreach my $value (@secondorder) {
1.36      matthew  1262:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1263:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1264:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1265:     }
                   1266:     $result .= "</select>\n";
                   1267:     #    return $debug;
                   1268:     return $result;
                   1269: }   #  end of sub linked_select_forms {
                   1270: 
1.45      matthew  1271: =pod
1.44      bowersj2 1272: 
1.1381    raeburn  1273: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid,$links_target)
1.44      bowersj2 1274: 
1.112     bowersj2 1275: Returns a string corresponding to an HTML link to the given help
                   1276: $topic, where $topic corresponds to the name of a .tex file in
                   1277: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1278: spaces. 
                   1279: 
                   1280: $text will optionally be linked to the same topic, allowing you to
                   1281: link text in addition to the graphic. If you do not want to link
                   1282: text, but wish to specify one of the later parameters, pass an
                   1283: empty string. 
                   1284: 
                   1285: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1286: the link will not open a new window. If false, the link will open
                   1287: a new window using Javascript. (Default is false.) 
                   1288: 
                   1289: $width and $height are optional numerical parameters that will
                   1290: override the width and height of the popped up window, which may
1.973     raeburn  1291: be useful for certain help topics with big pictures included.
                   1292: 
                   1293: $imgid is the id of the img tag used for the help icon. This may be
                   1294: used in a javascript call to switch the image src.  See 
                   1295: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1296: 
1.1381    raeburn  1297: $links_target will optionally be set to a target (_top, _parent or _self).
                   1298: 
1.44      bowersj2 1299: =cut
                   1300: 
                   1301: sub help_open_topic {
1.1381    raeburn  1302:     my ($topic, $text, $stayOnPage, $width, $height, $imgid, $links_target) = @_;
1.48      bowersj2 1303:     $text = "" if (not defined $text);
1.44      bowersj2 1304:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1305:     $width = 500 if (not defined $width);
1.44      bowersj2 1306:     $height = 400 if (not defined $height);
                   1307:     my $filename = $topic;
                   1308:     $filename =~ s/ /_/g;
                   1309: 
1.48      bowersj2 1310:     my $template = "";
                   1311:     my $link;
1.572     banghart 1312:     
1.159     www      1313:     $topic=~s/\W/\_/g;
1.44      bowersj2 1314: 
1.572     banghart 1315:     if (!$stayOnPage) {
1.1033    www      1316: 	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037    www      1317:     } elsif ($stayOnPage eq 'popup') {
                   1318:         $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 1319:     } else {
1.48      bowersj2 1320: 	$link = "/adm/help/${filename}.hlp";
                   1321:     }
                   1322: 
                   1323:     # Add the text
1.1314    raeburn  1324:     my $target = ' target="_top"';
1.1381    raeburn  1325:     if ($links_target) {
                   1326:         $target = ' target="'.$links_target.'"';
                   1327:     } elsif ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
                   1328:              (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
                   1329:         $target = '';
1.1378    raeburn  1330:     }
1.1380    raeburn  1331:     if ($text ne "") {
1.763     bisitz   1332: 	$template.='<span class="LC_help_open_topic">'
1.1314    raeburn  1333:                   .'<a'.$target.' href="'.$link.'">'
1.763     bisitz   1334:                   .$text.'</a>';
1.48      bowersj2 1335:     }
                   1336: 
1.763     bisitz   1337:     # (Always) Add the graphic
1.179     matthew  1338:     my $title = &mt('Online Help');
1.667     raeburn  1339:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1340:     if ($imgid ne '') {
                   1341:         $imgid = ' id="'.$imgid.'"';
                   1342:     }
1.1314    raeburn  1343:     $template.=' <a'.$target.' href="'.$link.'" title="'.$title.'">'
1.763     bisitz   1344:               .'<img src="'.$helpicon.'" border="0"'
                   1345:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1346:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1347:               .' /></a>';
                   1348:     if ($text ne "") {	
                   1349:         $template.='</span>';
                   1350:     }
1.44      bowersj2 1351:     return $template;
                   1352: 
1.106     bowersj2 1353: }
                   1354: 
                   1355: # This is a quicky function for Latex cheatsheet editing, since it 
                   1356: # appears in at least four places
                   1357: sub helpLatexCheatsheet {
1.1037    www      1358:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1359:     my $out;
1.106     bowersj2 1360:     my $addOther = '';
1.732     raeburn  1361:     if ($topic) {
1.1037    www      1362: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1363:     }
                   1364:     $out = '<span>' # Start cheatsheet
                   1365: 	  .$addOther
                   1366:           .'<span>'
1.1037    www      1367: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1368: 	  .'</span> <span>'
1.1037    www      1369: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1370: 	  .'</span>';
1.732     raeburn  1371:     unless ($not_author) {
1.1186    kruse    1372:         $out .= '<span>'
                   1373:                .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
                   1374:                .'</span> <span>'
                   1375:                .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763     bisitz   1376: 	       .'</span>';
1.732     raeburn  1377:     }
1.763     bisitz   1378:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1379:     return $out;
1.172     www      1380: }
                   1381: 
1.430     albertel 1382: sub general_help {
                   1383:     my $helptopic='Student_Intro';
                   1384:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1385: 	$helptopic='Authoring_Intro';
1.907     raeburn  1386:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1387: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1388:     } elsif ($env{'request.role'}=~/^dc/) {
                   1389:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1390:     }
                   1391:     return $helptopic;
                   1392: }
                   1393: 
                   1394: sub update_help_link {
                   1395:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1396:     my $origurl = $ENV{'REQUEST_URI'};
                   1397:     $origurl=~s|^/~|/priv/|;
                   1398:     my $timestamp = time;
                   1399:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1400:         $$datum = &escape($$datum);
                   1401:     }
                   1402: 
                   1403:     my $banner_link = "/adm/helpmenu?page=banner&amp;topic=$topic&amp;component_help=$component_help&amp;faq=$faq&amp;bug=$bug&amp;origurl=$origurl&amp;stamp=$timestamp&amp;stayonpage=$stayOnPage";
                   1404:     my $output .= <<"ENDOUTPUT";
                   1405: <script type="text/javascript">
1.824     bisitz   1406: // <![CDATA[
1.430     albertel 1407: banner_link = '$banner_link';
1.824     bisitz   1408: // ]]>
1.430     albertel 1409: </script>
                   1410: ENDOUTPUT
                   1411:     return $output;
                   1412: }
                   1413: 
                   1414: # now just updates the help link and generates a blue icon
1.193     raeburn  1415: sub help_open_menu {
1.1381    raeburn  1416:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text,$links_target) 
1.552     banghart 1417: 	= @_;    
1.949     droeschl 1418:     $stayOnPage = 1;
1.430     albertel 1419:     my $output;
                   1420:     if ($component_help) {
                   1421: 	if (!$text) {
                   1422: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
1.1381    raeburn  1423: 				       $width,$height,'',$links_target);
1.430     albertel 1424: 	} else {
                   1425: 	    my $help_text;
                   1426: 	    $help_text=&unescape($topic);
                   1427: 	    $output='<table><tr><td>'.
                   1428: 		&help_open_topic($component_help,$help_text,$stayOnPage,
1.1381    raeburn  1429: 				 $width,$height,'',$links_target).'</td></tr></table>';
1.430     albertel 1430: 	}
                   1431:     }
                   1432:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1433:     return $output.$banner_link;
                   1434: }
                   1435: 
                   1436: sub top_nav_help {
1.1369    raeburn  1437:     my ($text,$linkattr) = @_;
1.436     albertel 1438:     $text = &mt($text);
1.949     droeschl 1439:     my $stay_on_page = 1;
                   1440: 
1.1168    raeburn  1441:     my ($link,$banner_link);
                   1442:     unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
                   1443:         $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                   1444: 	                         : "javascript:helpMenu('open')";
                   1445:         $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
                   1446:     }
1.201     raeburn  1447:     my $title = &mt('Get help');
1.1168    raeburn  1448:     if ($link) {
                   1449:         return <<"END";
1.436     albertel 1450: $banner_link
1.1369    raeburn  1451: <a href="$link" title="$title" $linkattr>$text</a>
1.436     albertel 1452: END
1.1168    raeburn  1453:     } else {
                   1454:         return '&nbsp;'.$text.'&nbsp;';
                   1455:     }
1.436     albertel 1456: }
                   1457: 
                   1458: sub help_menu_js {
1.1154    raeburn  1459:     my ($httphost) = @_;
1.949     droeschl 1460:     my $stayOnPage = 1;
1.436     albertel 1461:     my $width = 620;
                   1462:     my $height = 600;
1.430     albertel 1463:     my $helptopic=&general_help();
1.1154    raeburn  1464:     my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1465:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1466:     my $start_page =
                   1467:         &Apache::loncommon::start_page('Help Menu', undef,
                   1468: 				       {'frameset'    => 1,
                   1469: 					'js_ready'    => 1,
1.1154    raeburn  1470:                                         'use_absolute' => $httphost,
1.331     albertel 1471: 					'add_entries' => {
1.1168    raeburn  1472: 					    'border' => '0', 
1.579     raeburn  1473: 					    'rows'   => "110,*",},});
1.331     albertel 1474:     my $end_page =
                   1475:         &Apache::loncommon::end_page({'frameset' => 1,
                   1476: 				      'js_ready' => 1,});
                   1477: 
1.436     albertel 1478:     my $template .= <<"ENDTEMPLATE";
                   1479: <script type="text/javascript">
1.877     bisitz   1480: // <![CDATA[
1.253     albertel 1481: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1482: var banner_link = '';
1.243     raeburn  1483: function helpMenu(target) {
                   1484:     var caller = this;
                   1485:     if (target == 'open') {
                   1486:         var newWindow = null;
                   1487:         try {
1.262     albertel 1488:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1489:         }
                   1490:         catch(error) {
                   1491:             writeHelp(caller);
                   1492:             return;
                   1493:         }
                   1494:         if (newWindow) {
                   1495:             caller = newWindow;
                   1496:         }
1.193     raeburn  1497:     }
1.243     raeburn  1498:     writeHelp(caller);
                   1499:     return;
                   1500: }
                   1501: function writeHelp(caller) {
1.1168    raeburn  1502:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
                   1503:     caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
                   1504:     caller.document.close();
                   1505:     caller.focus();
1.193     raeburn  1506: }
1.877     bisitz   1507: // END LON-CAPA Internal -->
1.253     albertel 1508: // ]]>
1.436     albertel 1509: </script>
1.193     raeburn  1510: ENDTEMPLATE
                   1511:     return $template;
                   1512: }
                   1513: 
1.172     www      1514: sub help_open_bug {
                   1515:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1516:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1517:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1518:     $text = "" if (not defined $text);
                   1519: 	$stayOnPage=1;
1.184     albertel 1520:     $width = 600 if (not defined $width);
                   1521:     $height = 600 if (not defined $height);
1.172     www      1522: 
                   1523:     $topic=~s/\W+/\+/g;
                   1524:     my $link='';
                   1525:     my $template='';
1.379     albertel 1526:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1527: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1528:     if (!$stayOnPage)
                   1529:     {
                   1530: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1531:     }
                   1532:     else
                   1533:     {
                   1534: 	$link = $url;
                   1535:     }
1.1314    raeburn  1536: 
1.1382    raeburn  1537:     my $target = '_top';
                   1538:     if ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
                   1539:         (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
                   1540:         $target = '_blank';
1.1378    raeburn  1541:     }
1.1382    raeburn  1542: 
1.172     www      1543:     # Add the text
                   1544:     if ($text ne "")
                   1545:     {
                   1546: 	$template .= 
                   1547:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.1382    raeburn  1548:   "<td bgcolor='#FF5555'><a target=\"$target\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1549:     }
                   1550: 
                   1551:     # Add the graphic
1.179     matthew  1552:     my $title = &mt('Report a Bug');
1.215     albertel 1553:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1554:     $template .= <<"ENDTEMPLATE";
1.1382    raeburn  1555:  <a target="$target" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1556: ENDTEMPLATE
                   1557:     if ($text ne '') { $template.='</td></tr></table>' };
                   1558:     return $template;
                   1559: 
                   1560: }
                   1561: 
                   1562: sub help_open_faq {
                   1563:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1564:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1565:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1566:     $text = "" if (not defined $text);
                   1567: 	$stayOnPage=1;
                   1568:     $width = 350 if (not defined $width);
                   1569:     $height = 400 if (not defined $height);
                   1570: 
                   1571:     $topic=~s/\W+/\+/g;
                   1572:     my $link='';
                   1573:     my $template='';
                   1574:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1575:     if (!$stayOnPage)
                   1576:     {
                   1577: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1578:     }
                   1579:     else
                   1580:     {
                   1581: 	$link = $url;
                   1582:     }
                   1583: 
                   1584:     # Add the text
                   1585:     if ($text ne "")
                   1586:     {
                   1587: 	$template .= 
1.173     www      1588:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1589:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1590:     }
                   1591: 
                   1592:     # Add the graphic
1.179     matthew  1593:     my $title = &mt('View the FAQ');
1.215     albertel 1594:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1595:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1596:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1597: ENDTEMPLATE
                   1598:     if ($text ne '') { $template.='</td></tr></table>' };
                   1599:     return $template;
                   1600: 
1.44      bowersj2 1601: }
1.37      matthew  1602: 
1.180     matthew  1603: ###############################################################
                   1604: ###############################################################
                   1605: 
1.45      matthew  1606: =pod
                   1607: 
1.648     raeburn  1608: =item * &change_content_javascript():
1.256     matthew  1609: 
                   1610: This and the next function allow you to create small sections of an
                   1611: otherwise static HTML page that you can update on the fly with
                   1612: Javascript, even in Netscape 4.
                   1613: 
                   1614: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1615: must be written to the HTML page once. It will prove the Javascript
                   1616: function "change(name, content)". Calling the change function with the
                   1617: name of the section 
                   1618: you want to update, matching the name passed to C<changable_area>, and
                   1619: the new content you want to put in there, will put the content into
                   1620: that area.
                   1621: 
                   1622: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1623: to contain room for the original contents. You need to "make space"
                   1624: for whatever changes you wish to make, and be B<sure> to check your
                   1625: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1626: it's adequate for updating a one-line status display, but little more.
                   1627: This script will set the space to 100% width, so you only need to
                   1628: worry about height in Netscape 4.
                   1629: 
                   1630: Modern browsers are much less limiting, and if you can commit to the
                   1631: user not using Netscape 4, this feature may be used freely with
                   1632: pretty much any HTML.
                   1633: 
                   1634: =cut
                   1635: 
                   1636: sub change_content_javascript {
                   1637:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1638:     if ($env{'browser.type'} eq 'netscape' &&
                   1639: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1640: 	return (<<NETSCAPE4);
                   1641: 	function change(name, content) {
                   1642: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1643: 	    doc.open();
                   1644: 	    doc.write(content);
                   1645: 	    doc.close();
                   1646: 	}
                   1647: NETSCAPE4
                   1648:     } else {
                   1649: 	# Otherwise, we need to use semi-standards-compliant code
                   1650: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1651: 	# is really scary, and every useful browser supports it
                   1652: 	return (<<DOMBASED);
                   1653: 	function change(name, content) {
                   1654: 	    element = document.getElementById(name);
                   1655: 	    element.innerHTML = content;
                   1656: 	}
                   1657: DOMBASED
                   1658:     }
                   1659: }
                   1660: 
                   1661: =pod
                   1662: 
1.648     raeburn  1663: =item * &changable_area($name,$origContent):
1.256     matthew  1664: 
                   1665: This provides a "changable area" that can be modified on the fly via
                   1666: the Javascript code provided in C<change_content_javascript>. $name is
                   1667: the name you will use to reference the area later; do not repeat the
                   1668: same name on a given HTML page more then once. $origContent is what
                   1669: the area will originally contain, which can be left blank.
                   1670: 
                   1671: =cut
                   1672: 
                   1673: sub changable_area {
                   1674:     my ($name, $origContent) = @_;
                   1675: 
1.258     albertel 1676:     if ($env{'browser.type'} eq 'netscape' &&
                   1677: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1678: 	# If this is netscape 4, we need to use the Layer tag
                   1679: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1680:     } else {
                   1681: 	return "<span id='$name'>$origContent</span>";
                   1682:     }
                   1683: }
                   1684: 
                   1685: =pod
                   1686: 
1.648     raeburn  1687: =item * &viewport_geometry_js 
1.590     raeburn  1688: 
                   1689: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1690: 
                   1691: =cut
                   1692: 
                   1693: 
                   1694: sub viewport_geometry_js { 
                   1695:     return <<"GEOMETRY";
                   1696: var Geometry = {};
                   1697: function init_geometry() {
                   1698:     if (Geometry.init) { return };
                   1699:     Geometry.init=1;
                   1700:     if (window.innerHeight) {
                   1701:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1702:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1703:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1704:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1705:     }
                   1706:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1707:         Geometry.getViewportHeight =
                   1708:             function() { return document.documentElement.clientHeight; };
                   1709:         Geometry.getViewportWidth =
                   1710:             function() { return document.documentElement.clientWidth; };
                   1711: 
                   1712:         Geometry.getHorizontalScroll =
                   1713:             function() { return document.documentElement.scrollLeft; };
                   1714:         Geometry.getVerticalScroll =
                   1715:             function() { return document.documentElement.scrollTop; };
                   1716:     }
                   1717:     else if (document.body.clientHeight) {
                   1718:         Geometry.getViewportHeight =
                   1719:             function() { return document.body.clientHeight; };
                   1720:         Geometry.getViewportWidth =
                   1721:             function() { return document.body.clientWidth; };
                   1722:         Geometry.getHorizontalScroll =
                   1723:             function() { return document.body.scrollLeft; };
                   1724:         Geometry.getVerticalScroll =
                   1725:             function() { return document.body.scrollTop; };
                   1726:     }
                   1727: }
                   1728: 
                   1729: GEOMETRY
                   1730: }
                   1731: 
                   1732: =pod
                   1733: 
1.648     raeburn  1734: =item * &viewport_size_js()
1.590     raeburn  1735: 
                   1736: 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. 
                   1737: 
                   1738: =cut
                   1739: 
                   1740: sub viewport_size_js {
                   1741:     my $geometry = &viewport_geometry_js();
                   1742:     return <<"DIMS";
                   1743: 
                   1744: $geometry
                   1745: 
                   1746: function getViewportDims(width,height) {
                   1747:     init_geometry();
                   1748:     width.value = Geometry.getViewportWidth();
                   1749:     height.value = Geometry.getViewportHeight();
                   1750:     return;
                   1751: }
                   1752: 
                   1753: DIMS
                   1754: }
                   1755: 
                   1756: =pod
                   1757: 
1.648     raeburn  1758: =item * &resize_textarea_js()
1.565     albertel 1759: 
                   1760: emits the needed javascript to resize a textarea to be as big as possible
                   1761: 
                   1762: creates a function resize_textrea that takes two IDs first should be
                   1763: the id of the element to resize, second should be the id of a div that
                   1764: surrounds everything that comes after the textarea, this routine needs
                   1765: to be attached to the <body> for the onload and onresize events.
                   1766: 
1.648     raeburn  1767: =back
1.565     albertel 1768: 
                   1769: =cut
                   1770: 
                   1771: sub resize_textarea_js {
1.590     raeburn  1772:     my $geometry = &viewport_geometry_js();
1.565     albertel 1773:     return <<"RESIZE";
                   1774:     <script type="text/javascript">
1.824     bisitz   1775: // <![CDATA[
1.590     raeburn  1776: $geometry
1.565     albertel 1777: 
1.588     albertel 1778: function getX(element) {
                   1779:     var x = 0;
                   1780:     while (element) {
                   1781: 	x += element.offsetLeft;
                   1782: 	element = element.offsetParent;
                   1783:     }
                   1784:     return x;
                   1785: }
                   1786: function getY(element) {
                   1787:     var y = 0;
                   1788:     while (element) {
                   1789: 	y += element.offsetTop;
                   1790: 	element = element.offsetParent;
                   1791:     }
                   1792:     return y;
                   1793: }
                   1794: 
                   1795: 
1.565     albertel 1796: function resize_textarea(textarea_id,bottom_id) {
                   1797:     init_geometry();
                   1798:     var textarea        = document.getElementById(textarea_id);
                   1799:     //alert(textarea);
                   1800: 
1.588     albertel 1801:     var textarea_top    = getY(textarea);
1.565     albertel 1802:     var textarea_height = textarea.offsetHeight;
                   1803:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1804:     var bottom_top      = getY(bottom);
1.565     albertel 1805:     var bottom_height   = bottom.offsetHeight;
                   1806:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1807:     var fudge           = 23;
1.565     albertel 1808:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1809:     if (new_height < 300) {
                   1810: 	new_height = 300;
                   1811:     }
                   1812:     textarea.style.height=new_height+'px';
                   1813: }
1.824     bisitz   1814: // ]]>
1.565     albertel 1815: </script>
                   1816: RESIZE
                   1817: 
                   1818: }
                   1819: 
1.1205    golterma 1820: sub colorfuleditor_js {
1.1248    raeburn  1821:     my $browse_or_search;
                   1822:     my $respath;
                   1823:     my ($cnum,$cdom) = &crsauthor_url();
                   1824:     if ($cnum) {
                   1825:         $respath = "/res/$cdom/$cnum/";
                   1826:         my %js_lt = &Apache::lonlocal::texthash(
                   1827:             sunm => 'Sub-directory name',
                   1828:             save => 'Save page to make this permanent',
                   1829:         );
                   1830:         &js_escape(\%js_lt);
1.1400    raeburn  1831:         my $showfile_js = &show_crsfiles_js();
1.1248    raeburn  1832:         $browse_or_search = <<"END";
                   1833: 
1.1400    raeburn  1834:     $showfile_js
                   1835: 
1.1248    raeburn  1836:     function toggleChooser(form,element,titleid,only,search) {
                   1837:         var disp = 'none';
                   1838:         if (document.getElementById('chooser_'+element)) {
                   1839:             var curr = document.getElementById('chooser_'+element).style.display;
                   1840:             if (curr == 'none') {
                   1841:                 disp='inline';
                   1842:                 if (form.elements['chooser_'+element].length) {
                   1843:                     for (var i=0; i<form.elements['chooser_'+element].length; i++) {
                   1844:                         form.elements['chooser_'+element][i].checked = false;
                   1845:                     }
                   1846:                 }
                   1847:                 toggleResImport(form,element);
                   1848:             }
                   1849:             document.getElementById('chooser_'+element).style.display = disp;
1.1400    raeburn  1850:             var dirsel = '';
                   1851:             var filesel = '';
                   1852:             if (document.getElementById('chooser_'+element+'_crsres')) {
                   1853:                 var currcrsres = document.getElementById('chooser_'+element+'_crsres').style.display;
                   1854:                 if (currcrsres == 'none') {
                   1855:                     dirsel = 'coursepath_'+element;
                   1856:                     var filesel = 'coursefile_'+element;
                   1857:                     var include;
                   1858:                     if (document.getElementById('crsres_include_'+element)) {
                   1859:                         include = document.getElementById('crsres_include_'+element).value;
                   1860:                     }
1.1402    raeburn  1861:                     populateCrsSelects(form,dirsel,filesel,1,include,1,0,1,1,0);
1.1400    raeburn  1862:                 }
                   1863:             }
                   1864:             if (document.getElementById('chooser_'+element+'_upload')) {
                   1865:                 var currcrsupload = document.getElementById('chooser_'+element+'_upload').style.display;
                   1866:                 if (currcrsupload == 'none') {
                   1867:                     dirsel = 'crsauthorpath_'+element;
                   1868:                     filesel = '';
1.1402    raeburn  1869:                     populateCrsSelects(form,dirsel,filesel,0,'',1,0,1,0,1);
1.1400    raeburn  1870:                 }
                   1871:             }
1.1248    raeburn  1872:         }
                   1873:     }
                   1874: 
1.1400    raeburn  1875:     function toggleCrsFile(form,element) {
1.1248    raeburn  1876:         if (document.getElementById('chooser_'+element+'_crsres')) {
                   1877:             var curr = document.getElementById('chooser_'+element+'_crsres').style.display;
                   1878:             if (curr == 'none') {
1.1400    raeburn  1879:                 if (document.getElementById('coursepath_'+element)) {
                   1880:                     var numdirs;
                   1881:                     if (document.getElementById('coursepath_'+element).length) {
                   1882:                         numdirs = document.getElementById('coursepath_'+element).length;
                   1883:                     }
1.1402    raeburn  1884:                     if ((document.getElementById('hascrsres_'+element)) &&
                   1885:                         (document.getElementById('nocrsres_'+element))) {
                   1886:                         if (numdirs) {
                   1887:                             document.getElementById('hascrsres_'+element).style.display='inline-block';
                   1888:                             document.getElementById('nocrsres_'+element).style.display='none';
                   1889:                         } else {
                   1890:                             document.getElementById('hascrsres_'+element).style.display='none';
                   1891:                             document.getElementById('nocrsres_'+element).style.display='inline-block';
                   1892:                         }
                   1893:                     }
1.1248    raeburn  1894:                     form.elements['coursepath_'+element].selectedIndex = 0;
                   1895:                     if (numdirs > 1) {
1.1400    raeburn  1896:                         var selelem = form.elements['coursefile_'+element];
                   1897:                         var i, len = selelem.options.length -1;
                   1898:                         if (len >=0) {
                   1899:                             for (i = len; i >= 0; i--) {
                   1900:                                 selelem.remove(i);
                   1901:                             }
                   1902:                             selelem.options[0] = new Option('','');
                   1903:                         }
1.1248    raeburn  1904:                     }
                   1905:                 }
1.1400    raeburn  1906:             }
1.1248    raeburn  1907:             document.getElementById('chooser_'+element+'_crsres').style.display = 'block';
                   1908:         }
                   1909:         if (document.getElementById('chooser_'+element+'_upload')) {
                   1910:             document.getElementById('chooser_'+element+'_upload').style.display = 'none';
                   1911:             if (document.getElementById('uploadcrsres_'+element)) {
                   1912:                 document.getElementById('uploadcrsres_'+element).value = '';
                   1913:             }
                   1914:         }
                   1915:         return;
                   1916:     }
                   1917: 
1.1400    raeburn  1918:     function toggleCrsUpload(form,element) {
1.1248    raeburn  1919:         if (document.getElementById('chooser_'+element+'_crsres')) {
                   1920:             document.getElementById('chooser_'+element+'_crsres').style.display = 'none';
                   1921:         }
                   1922:         if (document.getElementById('chooser_'+element+'_upload')) {
                   1923:             var curr = document.getElementById('chooser_'+element+'_upload').style.display;
                   1924:             if (curr == 'none') {
1.1400    raeburn  1925:                 form.elements['newsubdir_'+element][0].checked = true;
                   1926:                 toggleNewsubdir(form,element);
                   1927:                 document.getElementById('chooser_'+element+'_upload').style.display = 'block';
                   1928:                 if (document.getElementById('uploadcrsres_'+element)) {
                   1929:                     document.getElementById('uploadcrsres_'+element).value = '';
1.1248    raeburn  1930:                 }
                   1931:             }
                   1932:         }
                   1933:         return;
                   1934:     }
                   1935: 
                   1936:     function toggleResImport(form,element) {
                   1937:         var choices = new Array('crsres','upload');
                   1938:         for (var i=0; i<choices.length; i++) {
                   1939:             if (document.getElementById('chooser_'+element+'_'+choices[i])) {
                   1940:                 document.getElementById('chooser_'+element+'_'+choices[i]).style.display = 'none';
                   1941:             }
                   1942:         }
                   1943:     }
                   1944: 
                   1945:     function toggleNewsubdir(form,element) {
                   1946:         var newsub = form.elements['newsubdir_'+element];
                   1947:         if (newsub) {
                   1948:             if (newsub.length) {
                   1949:                 for (var j=0; j<newsub.length; j++) {
                   1950:                     if (newsub[j].checked) {
                   1951:                         if (document.getElementById('newsubdirname_'+element)) {
                   1952:                             if (newsub[j].value == '1') {
                   1953:                                 document.getElementById('newsubdirname_'+element).type = "text";
                   1954:                                 if (document.getElementById('newsubdir_'+element)) {
                   1955:                                     document.getElementById('newsubdir_'+element).innerHTML = '<br />$js_lt{sunm}';
                   1956:                                 }
                   1957:                             } else {
                   1958:                                 document.getElementById('newsubdirname_'+element).type = "hidden";
                   1959:                                 document.getElementById('newsubdirname_'+element).value = "";
                   1960:                                 document.getElementById('newsubdir_'+element).innerHTML = "";
                   1961:                             }
                   1962:                         }
                   1963:                         break; 
                   1964:                     }
                   1965:                 }
                   1966:             }
                   1967:         }
                   1968:     }
                   1969: 
                   1970:     function updateCrsFile(form,element) {
                   1971:         var directory = form.elements['coursepath_'+element];
                   1972:         var filename = form.elements['coursefile_'+element];
                   1973:         var path = directory.options[directory.selectedIndex].value;
                   1974:         var file = filename.options[filename.selectedIndex].value;
1.1400    raeburn  1975:         if (file != '') {
                   1976:             form.elements[element].value = '$respath';
                   1977:             if (path == '/') {
                   1978:                 form.elements[element].value += file;
                   1979:             } else {
                   1980:                 form.elements[element].value += path+'/'+file;
                   1981:             }
                   1982:             unClean();
                   1983:             if (document.getElementById('previewimg_'+element)) {
                   1984:                 document.getElementById('previewimg_'+element).src = form.elements[element].value;
                   1985:                 var newsrc = document.getElementById('previewimg_'+element).src; 
                   1986:             }
                   1987:             if (document.getElementById('showimg_'+element)) {
                   1988:                 document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';
                   1989:             }
1.1248    raeburn  1990:         }
                   1991:         toggleChooser(form,element);
                   1992:         return;
                   1993:     }
                   1994: 
                   1995:     function uploadDone(suffix,name) {
                   1996:         if (name) {
                   1997: 	    document.forms["lonhomework"].elements[suffix].value = name;
                   1998:             unClean();
                   1999:             toggleChooser(document.forms["lonhomework"],suffix);
                   2000:         }
                   2001:     }
                   2002: 
                   2003: \$(document).ready(function(){
                   2004: 
                   2005:     \$(document).delegate('form :submit', 'click', function( event ) {
                   2006:         if ( \$( this ).hasClass( "LC_uploadcrsres" ) ) {
                   2007:             var buttonId = this.id;
                   2008:             var suffix = buttonId.toString();
                   2009:             suffix = suffix.replace(/^crsupload_/,'');
                   2010:             event.preventDefault();
                   2011:             document.lonhomework.target = 'crsupload_target_'+suffix;
                   2012:             document.lonhomework.action = '/adm/coursepub?LC_uploadcrsres='+suffix;
                   2013:             \$(this.form).submit();
                   2014:             document.lonhomework.target = '';
                   2015:             if (document.getElementById('crsuploadto_'+suffix)) {
                   2016:                 document.lonhomework.action = document.getElementById('crsuploadto_'+suffix).value;
                   2017:             }
                   2018:             return false;
                   2019:         }
                   2020:     });
                   2021: });
                   2022: END
                   2023:     }
1.1205    golterma 2024:     return <<"COLORFULEDIT"
                   2025: <script type="text/javascript">
                   2026: // <![CDATA[>
                   2027:     function fold_box(curDepth, lastresource){
                   2028: 
                   2029:     // we need a list because there can be several blocks you need to fold in one tag
                   2030:         var block = document.getElementsByName('foldblock_'+curDepth);
                   2031:     // but there is only one folding button per tag
                   2032:         var foldbutton = document.getElementById('folding_btn_'+curDepth);
                   2033: 
                   2034:         if(block.item(0).style.display == 'none'){
                   2035: 
                   2036:             foldbutton.value = '@{[&mt("Hide")]}';
                   2037:             for (i = 0; i < block.length; i++){
                   2038:                 block.item(i).style.display = '';
                   2039:             }
                   2040:         }else{
                   2041: 
                   2042:             foldbutton.value = '@{[&mt("Show")]}';
                   2043:             for (i = 0; i < block.length; i++){
                   2044:                 // block.item(i).style.visibility = 'collapse';
                   2045:                 block.item(i).style.display = 'none';
                   2046:             }
                   2047:         };
                   2048:         saveState(lastresource);
                   2049:     }
                   2050: 
                   2051:     function saveState (lastresource) {
                   2052: 
                   2053:         var tag_list = getTagList();
                   2054:         if(tag_list != null){
                   2055:             var timestamp = new Date().getTime();
                   2056:             var key = lastresource;
                   2057: 
                   2058:             // the value pattern is: 'time;key1,value1;key2,value2; ... '
                   2059:             // starting with timestamp
                   2060:             var value = timestamp+';';
                   2061: 
                   2062:             // building the list of key-value pairs
                   2063:             for(var i = 0; i < tag_list.length; i++){
                   2064:                 value += tag_list[i]+',';
                   2065:                 value += document.getElementsByName(tag_list[i])[0].style.display+';';
                   2066:             }
                   2067: 
                   2068:             // only iterate whole storage if nothing to override
                   2069:             if(localStorage.getItem(key) == null){        
                   2070: 
                   2071:                 // prevent storage from growing large
                   2072:                 if(localStorage.length > 50){
                   2073:                     var regex_getTimestamp = /^(?:\d)+;/;
                   2074:                     var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
                   2075:                     var oldest_key;
                   2076:                     
                   2077:                     for(var i = 1; i < localStorage.length; i++){
                   2078:                         if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
                   2079:                             oldest_key = localStorage.key(i);
                   2080:                             oldest_timestamp = regex_getTimestamp.exec(oldest_key);
                   2081:                         }
                   2082:                     }
                   2083:                     localStorage.removeItem(oldest_key);
                   2084:                 }
                   2085:             }
                   2086:             localStorage.setItem(key,value);
                   2087:         }
                   2088:     }
                   2089: 
                   2090:     // restore folding status of blocks (on page load)
                   2091:     function restoreState (lastresource) {
                   2092:         if(localStorage.getItem(lastresource) != null){
                   2093:             var key = lastresource;
                   2094:             var value = localStorage.getItem(key);
                   2095:             var regex_delTimestamp = /^\d+;/;
                   2096: 
                   2097:             value.replace(regex_delTimestamp, '');
                   2098: 
                   2099:             var valueArr = value.split(';');
                   2100:             var pairs;
                   2101:             var elements;
                   2102:             for (var i = 0; i < valueArr.length; i++){
                   2103:                 pairs = valueArr[i].split(',');
                   2104:                 elements = document.getElementsByName(pairs[0]);
                   2105: 
                   2106:                 for (var j = 0; j < elements.length; j++){  
                   2107:                     elements[j].style.display = pairs[1];
                   2108:                     if (pairs[1] == "none"){
                   2109:                         var regex_id = /([_\\d]+)\$/;
                   2110:                         regex_id.exec(pairs[0]);
                   2111:                         document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
                   2112:                     }
                   2113:                 }
                   2114:             }
                   2115:         }
                   2116:     }
                   2117: 
                   2118:     function getTagList () {
                   2119:         
                   2120:         var stringToSearch = document.lonhomework.innerHTML;
                   2121: 
                   2122:         var ret = new Array();
                   2123:         var regex_findBlock = /(foldblock_.*?)"/g;
                   2124:         var tag_list = stringToSearch.match(regex_findBlock);
                   2125: 
                   2126:         if(tag_list != null){
                   2127:             for(var i = 0; i < tag_list.length; i++){            
                   2128:                 ret.push(tag_list[i].replace(/"/, ''));
                   2129:             }
                   2130:         }
                   2131:         return ret;
                   2132:     }
                   2133: 
                   2134:     function saveScrollPosition (resource) {
                   2135:         var tag_list = getTagList();
                   2136: 
                   2137:         // we dont always want to jump to the first block
                   2138:         // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
                   2139:         if(\$(window).scrollTop() > 170){
                   2140:             if(tag_list != null){
                   2141:                 var result;
                   2142:                 for(var i = 0; i < tag_list.length; i++){
                   2143:                     if(isElementInViewport(tag_list[i])){
                   2144:                         result += tag_list[i]+';';
                   2145:                     }
                   2146:                 }
                   2147:                 sessionStorage.setItem('anchor_'+resource, result);
                   2148:             }
                   2149:         } else {
                   2150:             // we dont need to save zero, just delete the item to leave everything tidy
                   2151:             sessionStorage.removeItem('anchor_'+resource);
                   2152:         }
                   2153:     }
                   2154: 
                   2155:     function restoreScrollPosition(resource){
                   2156: 
                   2157:         var elem = sessionStorage.getItem('anchor_'+resource);
                   2158:         if(elem != null){
                   2159:             var tag_list = elem.split(';');
                   2160:             var elem_list;
                   2161: 
                   2162:             for(var i = 0; i < tag_list.length; i++){
                   2163:                 elem_list = document.getElementsByName(tag_list[i]);
                   2164:                 
                   2165:                 if(elem_list.length > 0){
                   2166:                     elem = elem_list[0];
                   2167:                     break;
                   2168:                 }
                   2169:             }
                   2170:             elem.scrollIntoView();
                   2171:         }
                   2172:     }
                   2173: 
                   2174:     function isElementInViewport(el) {
                   2175: 
                   2176:         // change to last element instead of first
                   2177:         var elem = document.getElementsByName(el);
                   2178:         var rect = elem[0].getBoundingClientRect();
                   2179: 
                   2180:         return (
                   2181:             rect.top >= 0 &&
                   2182:             rect.left >= 0 &&
                   2183:             rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
                   2184:             rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
                   2185:         );
                   2186:     }
                   2187:     
                   2188:     function autosize(depth){
                   2189:         var cmInst = window['cm'+depth];
                   2190:         var fitsizeButton = document.getElementById('fitsize'+depth);
                   2191: 
                   2192:         // is fixed size, switching to dynamic
                   2193:         if (sessionStorage.getItem("autosized_"+depth) == null) {
                   2194:             cmInst.setSize("","auto");
                   2195:             fitsizeButton.value = "@{[&mt('Fixed size')]}";
                   2196:             sessionStorage.setItem("autosized_"+depth, "yes");
                   2197: 
                   2198:         // is dynamic size, switching to fixed
                   2199:         } else {
                   2200:             cmInst.setSize("","300px");
                   2201:             fitsizeButton.value = "@{[&mt('Dynamic size')]}";
                   2202:             sessionStorage.removeItem("autosized_"+depth);
                   2203:         }
                   2204:     }
                   2205: 
1.1248    raeburn  2206: $browse_or_search
1.1205    golterma 2207: 
                   2208: // ]]>
                   2209: </script>
                   2210: COLORFULEDIT
                   2211: }
                   2212: 
                   2213: sub xmleditor_js {
                   2214:     return <<XMLEDIT
                   2215: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
                   2216: <script type="text/javascript">
                   2217: // <![CDATA[>
                   2218: 
                   2219:     function saveScrollPosition (resource) {
                   2220: 
                   2221:         var scrollPos = \$(window).scrollTop();
                   2222:         sessionStorage.setItem(resource,scrollPos);
                   2223:     }
                   2224: 
                   2225:     function restoreScrollPosition(resource){
                   2226: 
                   2227:         var scrollPos = sessionStorage.getItem(resource);
                   2228:         \$(window).scrollTop(scrollPos);
                   2229:     }
                   2230: 
                   2231:     // unless internet explorer
                   2232:     if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
                   2233: 
                   2234:         \$(document).ready(function() {
                   2235:              \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
                   2236:         });
                   2237:     }
                   2238: 
                   2239:     // inserts text at cursor position into codemirror (xml editor only)
                   2240:     function insertText(text){
                   2241:         cm.focus();
                   2242:         var curPos = cm.getCursor();
                   2243:         cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
                   2244:     }
                   2245: // ]]>
                   2246: </script>
                   2247: XMLEDIT
                   2248: }
                   2249: 
                   2250: sub insert_folding_button {
                   2251:     my $curDepth = $Apache::lonxml::curdepth;
                   2252:     my $lastresource = $env{'request.ambiguous'};
                   2253: 
                   2254:     return "<input type=\"button\" id=\"folding_btn_$curDepth\" 
                   2255:             value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
                   2256: }
                   2257: 
1.1248    raeburn  2258: sub crsauthor_url {
                   2259:     my ($url) = @_;
                   2260:     if ($url eq '') {
                   2261:         $url = $ENV{'REQUEST_URI'};
                   2262:     }
                   2263:     my ($cnum,$cdom);
                   2264:     if ($env{'request.course.id'}) {
                   2265:         my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/});
                   2266:         if ($audom ne '' && $auname ne '') {
                   2267:             if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) &&
                   2268:                 ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) {
                   2269:                 $cnum = $auname;
                   2270:                 $cdom = $audom;
                   2271:             }
                   2272:         }
                   2273:     }
                   2274:     return ($cnum,$cdom);
                   2275: }
                   2276: 
                   2277: sub import_crsauthor_form {
1.1400    raeburn  2278:     my ($firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_;
1.1248    raeburn  2279:     return (0) unless ($env{'request.course.id'});
                   2280:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2281:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2282:     my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   2283:     return (0) unless (($cnum ne '') && ($cdom ne ''));
                   2284:     my @ids=&Apache::lonnet::current_machine_ids();
1.1400    raeburn  2285:     my ($output,$is_home,$toppath,%subdirs,%files,%selimport_menus,$include,$exclude);
1.1402    raeburn  2286: 
1.1248    raeburn  2287:     if (grep(/^\Q$crshome\E$/,@ids)) {
                   2288:         $is_home = 1;
                   2289:     }
1.1400    raeburn  2290:     $toppath = "/priv/$cdom/$cnum";
                   2291:     my $nonemptydir = 1;
                   2292:     my $js_only;
                   2293:     if ($only) {
                   2294:         map { $include->{$_} = 1; } split(/\s*,\s*/,$only);
                   2295:         $js_only = join(',',map { &js_escape($_); } sort(keys(%{$include})));
                   2296:     }
                   2297:     $exclude = &Apache::lonnet::priv_exclude();
1.1402    raeburn  2298:     &Apache::lonnet::recursedirs($is_home,1,$include,$exclude,1,0,$toppath,'',\%subdirs,\%files);
1.1400    raeburn  2299:     my $numdirs = scalar(keys(%files));
1.1248    raeburn  2300:     my %lt = &Apache::lonlocal::texthash (
                   2301:         fnam => 'Filename',
                   2302:         dire => 'Directory',
1.1400    raeburn  2303:         se   => 'Select',
1.1248    raeburn  2304:     );
1.1402    raeburn  2305:     $output = $lt{'dire'}.':&nbsp;'.
1.1400    raeburn  2306:               '<select id="'.$firstselectname.'" name="'.$firstselectname.'" '.
1.1402    raeburn  2307:               'onchange="populateCrsSelects(this.form,'."'$firstselectname','$secondselectname',1,'$js_only',0,1,0,0,0".');">'.
1.1400    raeburn  2308:               '<option value="" selected="selected">'.$lt{'se'}.'</option>';
1.1402    raeburn  2309:     if ($files{'/'}) {
                   2310:         $output .= '<option value="/">/</option>'."\n";
                   2311:     }
1.1400    raeburn  2312:     foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {
1.1402    raeburn  2313:         next if ($key eq '/');
1.1400    raeburn  2314:         $output .= '<option value="'.$key.'">'.$key.'</option>'."\n";
                   2315:     }
                   2316:     $output .= '</select><br />'."\n".
1.1402    raeburn  2317:                $lt{'fnam'}.':&nbsp;<select id="'.$secondselectname.'" name="'.$secondselectname.'">'."\n".
1.1400    raeburn  2318:                '<option value="" selected="selected"></option>'."\n".
1.1402    raeburn  2319:                '</select>'."\n".
                   2320:                '<input type="hidden" id="crsres_include_'.$suffix.'" value="'.$only.'" />';
1.1400    raeburn  2321:     return ($numdirs,$output);
                   2322: }
                   2323: 
                   2324: sub show_crsfiles_js {
                   2325:     my $excluderef = &Apache::lonnet::priv_exclude();
                   2326:     my $se = &js_escape(&mt('Select'));
                   2327:     my $exclude;
                   2328:     if (ref($excluderef) eq 'HASH') {
                   2329:         $exclude = join(',', map { &js_escape($_); } sort(keys(%{$excluderef})));
                   2330:     }
                   2331:     my $js = <<"END";
                   2332: 
                   2333: 
1.1402    raeburn  2334:     function populateCrsSelects (form,dirsel,filesel,exc,include,setdir,setfile,recurse,nonemptydir,addtopdir) {
1.1400    raeburn  2335:         var relpath = '';
                   2336:         if ((setfile) && (dirsel != null) && (dirsel != 'undefined') && (dirsel != '')) {
                   2337:             var currdir = form.elements[dirsel].options[form.elements[dirsel].selectedIndex].value;
                   2338:             if (currdir == '') {
                   2339:                 if ((filesel != null) && (filesel != 'undefined') && (filesel != '')) {
                   2340:                     selelem = form.elements[filesel];
                   2341:                     var j, numfiles = selelem.options.length -1;
                   2342:                     if (numfiles >=0) {
                   2343:                         for (j = numfiles; j >= 0; j--) {
                   2344:                             selelem.remove(j);
                   2345:                         }
                   2346:                     }
                   2347:                     if (selelem.options.length == 0) {
                   2348:                         selelem.options[selelem.options.length] = new Option('','');
                   2349:                         selelem.selectedIndex = 0;
1.1248    raeburn  2350:                     }
                   2351:                 }
1.1400    raeburn  2352:                 return;
                   2353:             } else {
                   2354:                 relpath = encodeURIComponent(form.elements[dirsel].options[form.elements[dirsel].selectedIndex].value);
1.1248    raeburn  2355:             }
                   2356:         }
1.1400    raeburn  2357:         var http = new XMLHttpRequest();
                   2358:         var url = "/adm/courseauthor";
                   2359:         var crsrole = "$env{'request.role'}";
                   2360:         var exclude = '';
                   2361:         if (exc) {
                   2362:             exclude = '$exclude';
                   2363:         }
1.1402    raeburn  2364:         var params = "role=course&files=1&rec="+recurse+"&nonempty="+nonemptydir+"&exc="+exclude+"&inc="+include+"&addtop="+addtopdir+"&path="+relpath;
1.1400    raeburn  2365:         http.open("POST", url, true);
                   2366:         http.setRequestHeader("Content-type", "application/x-www-form-urlencoded");
                   2367:         http.onreadystatechange = function() {
                   2368:             if (http.readyState == 4 && http.status == 200) {
                   2369:                 var data = JSON.parse(http.responseText);
                   2370:                 var selelem;
                   2371:                 if ((setdir) && (dirsel != null) && (dirsel != 'undefined') && (dirsel != '')) {
                   2372:                     if (Array.isArray(data.dirs)) {
                   2373:                         selelem = form.elements[dirsel];
                   2374:                         var i, numdirs = selelem.options.length -1;
                   2375:                         if (numdirs >=0) {
                   2376:                             for (i = numdirs; i >= 0; i--) {
                   2377:                                 selelem.remove(i);
                   2378:                             }
                   2379:                         }
                   2380:                         var len = data.dirs.length;
                   2381:                         if (len) {
1.1402    raeburn  2382:                             selelem.options[selelem.options.length] = new Option('$se','');
1.1400    raeburn  2383:                             var j;
                   2384:                             for (j = 0; j < len; j++) {
                   2385:                                 selelem.options[selelem.options.length] = new Option(data.dirs[j],data.dirs[j]);
                   2386:                             }
                   2387:                             selelem.selectedIndex = 0;
                   2388:                         }
                   2389:                         if (!setfile) {
                   2390:                             if ((filesel != null) && (filesel != 'undefined') && (filesel != '')) {
                   2391:                                 selelem = form.elements[filesel];
                   2392:                                 var j, numfiles = selelem.options.length -1;
                   2393:                                 if (numfiles >=0) {
                   2394:                                     for (j = numfiles; j >= 0; j--) {
                   2395:                                         selelem.remove(j);
                   2396:                                     }
                   2397:                                 }
                   2398:                                 if (selelem.options.length == 0) {
                   2399:                                     selelem.options[selelem.options.length] = new Option('','');
                   2400:                                     selelem.selectedIndex = 0;
                   2401:                                 }
                   2402:                             }
                   2403:                         }
                   2404:                     }
                   2405:                 }
                   2406:                 if ((setfile) && (filesel != null) && (filesel != 'undefined') && (filesel != '')) {
                   2407:                     selelem = form.elements[filesel];
                   2408:                     var i, numfiles = selelem.options.length -1;
                   2409:                     if (numfiles >=0) {
                   2410:                         for (i = numfiles; i >= 0; i--) {
                   2411:                             selelem.remove(i);
                   2412:                         }
                   2413:                     }
                   2414:                     var x;
                   2415:                     for (x in data.files) {
                   2416:                         if (Array.isArray(data.files[x])) {
                   2417:                             if (data.files[x].length > 1) {
                   2418:                                 selelem.options[selelem.options.length] = new Option('$se','');
                   2419:                             }
                   2420:                             var len = data.files[x].length;
                   2421:                             if (len) {
                   2422:                                 var k;
                   2423:                                 for (k = 0; k < len; k++) {
                   2424:                                     selelem.options[selelem.options.length] = new Option(data.files[x][k],data.files[x][k]);
                   2425:                                 }
                   2426:                                 selelem.selectedIndex = 0;
                   2427:                             }
                   2428:                         }
                   2429:                     }
                   2430:                     if (selelem.options.length == 0) {
                   2431:                         selelem.options[selelem.options.length] = new Option('','');
                   2432:                         selelem.selectedIndex = 0;
                   2433:                     }
1.1248    raeburn  2434:                 }
                   2435:             }
                   2436:         }
1.1400    raeburn  2437:         http.send(params);
1.1248    raeburn  2438:     }
1.1400    raeburn  2439: END
1.1248    raeburn  2440: }
                   2441: 
1.565     albertel 2442: =pod
                   2443: 
1.1420  ! raeburn  2444: =item * &iframe_wrapper_headjs()
        !          2445: 
        !          2446: #
        !          2447: # Where iframe is in use, if window.onload() executes before the custom resize function
        !          2448: # has been defined (jQuery), two global javascript vars (LCnotready and LCresizedef)
        !          2449: # are used to ensure document.ready() triggers a call to resize, so the iframe contents
        !          2450: # do not obscure the Functions menu.
        !          2451: #
        !          2452: 
        !          2453: =back
        !          2454: 
        !          2455: =cut
        !          2456: 
        !          2457: 
        !          2458: sub iframe_wrapper_headjs {
        !          2459:     return <<"ENDJS";
        !          2460: <script type="text/javascript">
        !          2461: // <![CDATA[
        !          2462: var LCnotready = 0;
        !          2463: var LCresizedef = 0;
        !          2464: // ]]>
        !          2465: </script>
        !          2466: 
        !          2467: ENDJS
        !          2468: 
        !          2469: }
        !          2470: 
        !          2471: =pod
        !          2472: 
        !          2473: =item * &iframe_wrapper_resizejs()
        !          2474: 
        !          2475: #
        !          2476: # jQuery to use when iframe is in use and a page resize occurs.
        !          2477: # This script will ensure that the iframe does not obscure any
        !          2478: # standard LON-CAPA inline menus (primary, secondary, and/or
        !          2479: # breadcrumbs and Functions menus. Expects javascript from
        !          2480: # &iframe_wrapper_headjs() to be in head portion of the web page,
        !          2481: # e.g., by inclusion in second arg passed to &start_page().
        !          2482: #
        !          2483: 
        !          2484: =back
        !          2485: 
        !          2486: =cut
        !          2487: 
        !          2488: sub iframe_wrapper_resizejs {
        !          2489:     my $offset = 5;
        !          2490:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['inhibitmenu']);
        !          2491:     if (($env{'form.inhibitmenu'} eq 'yes') || ($env{'form.only_body'})) {
        !          2492:         $offset = 0;
        !          2493:     }
        !          2494:     return &Apache::lonhtmlcommon::scripttag(<<SCRIPT);
        !          2495:     \$(document).ready( function() {
        !          2496:         \$(window).unbind('resize').resize(function(){
        !          2497:             var header = null;
        !          2498:             var offset = $offset;
        !          2499:             var height = 0;
        !          2500:             var hdrtop = 0;
        !          2501:             if (\$('div.LC_head_subbox:first').length) {
        !          2502:                 header = \$('div.LC_head_subbox:first');
        !          2503:                 offset = 9;
        !          2504:             } else {
        !          2505:                 if (\$('#LC_breadcrumbs').length) {
        !          2506:                     header = \$('#LC_breadcrumbs');
        !          2507:                 }
        !          2508:             }
        !          2509:             if (header != null && header.length) {
        !          2510:                 height = header.height();
        !          2511:                 hdrtop = header.position().top;
        !          2512:             }
        !          2513:             var pos = height + hdrtop + offset;
        !          2514:             \$('.LC_iframecontainer').css('top', pos);
        !          2515:         });
        !          2516:         LCresizedef = 1;
        !          2517:         if (LCnotready == 1) {
        !          2518:             LCnotready = 0;
        !          2519:             \$(window).trigger('resize');
        !          2520:         }
        !          2521:     });
        !          2522:     window.onload = function(){
        !          2523:          if (LCresizedef) {
        !          2524:              LCnotready = 0;
        !          2525:              \$(window).trigger('resize');
        !          2526:          } else {
        !          2527:              LCnotready = 1;
        !          2528:          }
        !          2529:     };
        !          2530: SCRIPT
        !          2531: 
        !          2532: }
        !          2533: 
        !          2534: =pod
        !          2535: 
1.256     matthew  2536: =head1 Excel and CSV file utility routines
                   2537: 
                   2538: =cut
                   2539: 
                   2540: ###############################################################
                   2541: ###############################################################
                   2542: 
                   2543: =pod
                   2544: 
1.1162    raeburn  2545: =over 4
                   2546: 
1.648     raeburn  2547: =item * &csv_translate($text) 
1.37      matthew  2548: 
1.185     www      2549: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  2550: format.
                   2551: 
                   2552: =cut
                   2553: 
1.180     matthew  2554: ###############################################################
                   2555: ###############################################################
1.37      matthew  2556: sub csv_translate {
                   2557:     my $text = shift;
                   2558:     $text =~ s/\"/\"\"/g;
1.209     albertel 2559:     $text =~ s/\n/ /g;
1.37      matthew  2560:     return $text;
                   2561: }
1.180     matthew  2562: 
                   2563: ###############################################################
                   2564: ###############################################################
                   2565: 
                   2566: =pod
                   2567: 
1.648     raeburn  2568: =item * &define_excel_formats()
1.180     matthew  2569: 
                   2570: Define some commonly used Excel cell formats.
                   2571: 
                   2572: Currently supported formats:
                   2573: 
                   2574: =over 4
                   2575: 
                   2576: =item header
                   2577: 
                   2578: =item bold
                   2579: 
                   2580: =item h1
                   2581: 
                   2582: =item h2
                   2583: 
                   2584: =item h3
                   2585: 
1.256     matthew  2586: =item h4
                   2587: 
                   2588: =item i
                   2589: 
1.180     matthew  2590: =item date
                   2591: 
                   2592: =back
                   2593: 
                   2594: Inputs: $workbook
                   2595: 
                   2596: Returns: $format, a hash reference.
                   2597: 
1.1057    foxr     2598: 
1.180     matthew  2599: =cut
                   2600: 
                   2601: ###############################################################
                   2602: ###############################################################
                   2603: sub define_excel_formats {
                   2604:     my ($workbook) = @_;
                   2605:     my $format;
                   2606:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   2607:                                                 bottom    => 1,
                   2608:                                                 align     => 'center');
                   2609:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   2610:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   2611:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   2612:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  2613:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  2614:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  2615:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  2616:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  2617:     return $format;
                   2618: }
                   2619: 
                   2620: ###############################################################
                   2621: ###############################################################
1.113     bowersj2 2622: 
                   2623: =pod
                   2624: 
1.648     raeburn  2625: =item * &create_workbook()
1.255     matthew  2626: 
                   2627: Create an Excel worksheet.  If it fails, output message on the
                   2628: request object and return undefs.
                   2629: 
                   2630: Inputs: Apache request object
                   2631: 
                   2632: Returns (undef) on failure, 
                   2633:     Excel worksheet object, scalar with filename, and formats 
                   2634:     from &Apache::loncommon::define_excel_formats on success
                   2635: 
                   2636: =cut
                   2637: 
                   2638: ###############################################################
                   2639: ###############################################################
                   2640: sub create_workbook {
                   2641:     my ($r) = @_;
                   2642:         #
                   2643:     # Create the excel spreadsheet
                   2644:     my $filename = '/prtspool/'.
1.258     albertel 2645:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  2646:         time.'_'.rand(1000000000).'.xls';
                   2647:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   2648:     if (! defined($workbook)) {
                   2649:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   2650:         $r->print(
                   2651:             '<p class="LC_error">'
                   2652:            .&mt('Problems occurred in creating the new Excel file.')
                   2653:            .' '.&mt('This error has been logged.')
                   2654:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2655:            .'</p>'
                   2656:         );
1.255     matthew  2657:         return (undef);
                   2658:     }
                   2659:     #
1.1014    foxr     2660:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  2661:     #
                   2662:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   2663:     return ($workbook,$filename,$format);
                   2664: }
                   2665: 
                   2666: ###############################################################
                   2667: ###############################################################
                   2668: 
                   2669: =pod
                   2670: 
1.648     raeburn  2671: =item * &create_text_file()
1.113     bowersj2 2672: 
1.542     raeburn  2673: Create a file to write to and eventually make available to the user.
1.256     matthew  2674: If file creation fails, outputs an error message on the request object and 
                   2675: return undefs.
1.113     bowersj2 2676: 
1.256     matthew  2677: Inputs: Apache request object, and file suffix
1.113     bowersj2 2678: 
1.256     matthew  2679: Returns (undef) on failure, 
                   2680:     Filehandle and filename on success.
1.113     bowersj2 2681: 
                   2682: =cut
                   2683: 
1.256     matthew  2684: ###############################################################
                   2685: ###############################################################
                   2686: sub create_text_file {
                   2687:     my ($r,$suffix) = @_;
                   2688:     if (! defined($suffix)) { $suffix = 'txt'; };
                   2689:     my $fh;
                   2690:     my $filename = '/prtspool/'.
1.258     albertel 2691:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  2692:         time.'_'.rand(1000000000).'.'.$suffix;
                   2693:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   2694:     if (! defined($fh)) {
                   2695:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   2696:         $r->print(
                   2697:             '<p class="LC_error">'
                   2698:            .&mt('Problems occurred in creating the output file.')
                   2699:            .' '.&mt('This error has been logged.')
                   2700:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2701:            .'</p>'
                   2702:         );
1.113     bowersj2 2703:     }
1.256     matthew  2704:     return ($fh,$filename)
1.113     bowersj2 2705: }
                   2706: 
                   2707: 
1.256     matthew  2708: =pod 
1.113     bowersj2 2709: 
                   2710: =back
                   2711: 
                   2712: =cut
1.37      matthew  2713: 
                   2714: ###############################################################
1.33      matthew  2715: ##        Home server <option> list generating code          ##
                   2716: ###############################################################
1.35      matthew  2717: 
1.169     www      2718: # ------------------------------------------
                   2719: 
                   2720: sub domain_select {
1.1289    raeburn  2721:     my ($name,$value,$multiple,$incdoms,$excdoms)=@_;
                   2722:     my @possdoms;
                   2723:     if (ref($incdoms) eq 'ARRAY') {
                   2724:         @possdoms = @{$incdoms};
                   2725:     } else {
                   2726:         @possdoms = &Apache::lonnet::all_domains();
                   2727:     }
                   2728: 
1.169     www      2729:     my %domains=map { 
1.514     albertel 2730: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.1289    raeburn  2731:     } @possdoms;
                   2732: 
                   2733:     if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) {
                   2734:         foreach my $dom (@{$excdoms}) {
                   2735:             delete($domains{$dom});
                   2736:         }
                   2737:     }
                   2738: 
1.169     www      2739:     if ($multiple) {
                   2740: 	$domains{''}=&mt('Any domain');
1.550     albertel 2741: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 2742: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      2743:     } else {
1.550     albertel 2744: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  2745: 	return &select_form($name,$value,\%domains);
1.169     www      2746:     }
                   2747: }
                   2748: 
1.282     albertel 2749: #-------------------------------------------
                   2750: 
                   2751: =pod
                   2752: 
1.519     raeburn  2753: =head1 Routines for form select boxes
                   2754: 
                   2755: =over 4
                   2756: 
1.648     raeburn  2757: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 2758: 
                   2759: Returns a string containing a <select> element int multiple mode
                   2760: 
                   2761: 
                   2762: Args:
                   2763:   $name - name of the <select> element
1.506     raeburn  2764:   $value - scalar or array ref of values that should already be selected
1.282     albertel 2765:   $size - number of rows long the select element is
1.283     albertel 2766:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 2767:           (shown text should already have been &mt())
1.506     raeburn  2768:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 2769: 
1.282     albertel 2770: =cut
                   2771: 
                   2772: #-------------------------------------------
1.169     www      2773: sub multiple_select_form {
1.284     albertel 2774:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      2775:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   2776:     my $output='';
1.191     matthew  2777:     if (! defined($size)) {
                   2778:         $size = 4;
1.283     albertel 2779:         if (scalar(keys(%$hash))<4) {
                   2780:             $size = scalar(keys(%$hash));
1.191     matthew  2781:         }
                   2782:     }
1.734     bisitz   2783:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 2784:     my @order;
1.506     raeburn  2785:     if (ref($order) eq 'ARRAY')  {
                   2786:         @order = @{$order};
                   2787:     } else {
                   2788:         @order = sort(keys(%$hash));
1.501     banghart 2789:     }
                   2790:     if (exists($$hash{'select_form_order'})) {
                   2791:         @order = @{$$hash{'select_form_order'}};
                   2792:     }
                   2793:         
1.284     albertel 2794:     foreach my $key (@order) {
1.356     albertel 2795:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 2796:         $output.='selected="selected" ' if ($selected{$key});
                   2797:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      2798:     }
                   2799:     $output.="</select>\n";
                   2800:     return $output;
                   2801: }
                   2802: 
1.88      www      2803: #-------------------------------------------
                   2804: 
                   2805: =pod
                   2806: 
1.1254    raeburn  2807: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88      www      2808: 
                   2809: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  2810: allow a user to select options from a ref to a hash containing:
                   2811: option_name => displayed text. An optional $onchange can include
1.1254    raeburn  2812: a javascript onchange item, e.g., onchange="this.form.submit();".
                   2813: An optional arg -- $readonly -- if true will cause the select form
                   2814: to be disabled, e.g., for the case where an instructor has a section-
                   2815: specific role, and is viewing/modifying parameters. 
1.970     raeburn  2816: 
1.88      www      2817: See lonrights.pm for an example invocation and use.
                   2818: 
                   2819: =cut
                   2820: 
                   2821: #-------------------------------------------
                   2822: sub select_form {
1.1228    raeburn  2823:     my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970     raeburn  2824:     return unless (ref($hashref) eq 'HASH');
                   2825:     if ($onchange) {
                   2826:         $onchange = ' onchange="'.$onchange.'"';
                   2827:     }
1.1228    raeburn  2828:     my $disabled;
                   2829:     if ($readonly) {
                   2830:         $disabled = ' disabled="disabled"';
                   2831:     }
                   2832:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128     albertel 2833:     my @keys;
1.970     raeburn  2834:     if (exists($hashref->{'select_form_order'})) {
                   2835: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2836:     } else {
1.970     raeburn  2837: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2838:     }
1.356     albertel 2839:     foreach my $key (@keys) {
                   2840:         $selectform.=
                   2841: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2842:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2843:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2844:     }
                   2845:     $selectform.="</select>";
                   2846:     return $selectform;
                   2847: }
                   2848: 
1.475     www      2849: # For display filters
                   2850: 
                   2851: sub display_filter {
1.1074    raeburn  2852:     my ($context) = @_;
1.475     www      2853:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2854:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2855:     my $phraseinput = 'hidden';
                   2856:     my $includeinput = 'hidden';
                   2857:     my ($checked,$includetypestext);
                   2858:     if ($env{'form.displayfilter'} eq 'containing') {
                   2859:         $phraseinput = 'text'; 
                   2860:         if ($context eq 'parmslog') {
                   2861:             $includeinput = 'checkbox';
                   2862:             if ($env{'form.includetypes'}) {
                   2863:                 $checked = ' checked="checked"';
                   2864:             }
                   2865:             $includetypestext = &mt('Include parameter types');
                   2866:         }
                   2867:     } else {
                   2868:         $includetypestext = '&nbsp;';
                   2869:     }
                   2870:     my ($additional,$secondid,$thirdid);
                   2871:     if ($context eq 'parmslog') {
                   2872:         $additional = 
                   2873:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2874:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2875:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2876:             '</label>';
                   2877:         $secondid = 'includetypes';
                   2878:         $thirdid = 'includetypestext';
                   2879:     }
                   2880:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2881:                                                     '$secondid','$thirdid')";
                   2882:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.1403    raeburn  2883: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},'',undef,
1.475     www      2884: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2885: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2886:            &mt('Filter: [_1]',
1.477     www      2887: 	   &select_form($env{'form.displayfilter'},
                   2888: 			'displayfilter',
1.970     raeburn  2889: 			{'currentfolder' => 'Current folder/page',
1.477     www      2890: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2891: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2892: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2893:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2894:                          '" />'.$additional;
                   2895: }
                   2896: 
                   2897: sub display_filter_js {
                   2898:     my $includetext = &mt('Include parameter types');
                   2899:     return <<"ENDJS";
                   2900:   
                   2901: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2902:     var firstType = 'hidden';
                   2903:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2904:         firstType = 'text';
                   2905:     }
                   2906:     firstObject = document.getElementById(firstid);
                   2907:     if (typeof(firstObject) == 'object') {
                   2908:         if (firstObject.type != firstType) {
                   2909:             changeInputType(firstObject,firstType);
                   2910:         }
                   2911:     }
                   2912:     if (context == 'parmslog') {
                   2913:         var secondType = 'hidden';
                   2914:         if (firstType == 'text') {
                   2915:             secondType = 'checkbox';
                   2916:         }
                   2917:         secondObject = document.getElementById(secondid);  
                   2918:         if (typeof(secondObject) == 'object') {
                   2919:             if (secondObject.type != secondType) {
                   2920:                 changeInputType(secondObject,secondType);
                   2921:             }
                   2922:         }
                   2923:         var textItem = document.getElementById(thirdid);
                   2924:         var currtext = textItem.innerHTML;
                   2925:         var newtext;
                   2926:         if (firstType == 'text') {
                   2927:             newtext = '$includetext';
                   2928:         } else {
                   2929:             newtext = '&nbsp;';
                   2930:         }
                   2931:         if (currtext != newtext) {
                   2932:             textItem.innerHTML = newtext;
                   2933:         }
                   2934:     }
                   2935:     return;
                   2936: }
                   2937: 
                   2938: function changeInputType(oldObject,newType) {
                   2939:     var newObject = document.createElement('input');
                   2940:     newObject.type = newType;
                   2941:     if (oldObject.size) {
                   2942:         newObject.size = oldObject.size;
                   2943:     }
                   2944:     if (oldObject.value) {
                   2945:         newObject.value = oldObject.value;
                   2946:     }
                   2947:     if (oldObject.name) {
                   2948:         newObject.name = oldObject.name;
                   2949:     }
                   2950:     if (oldObject.id) {
                   2951:         newObject.id = oldObject.id;
                   2952:     }
                   2953:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2954:     return;
                   2955: }
                   2956: 
                   2957: ENDJS
1.475     www      2958: }
                   2959: 
1.167     www      2960: sub gradeleveldescription {
                   2961:     my $gradelevel=shift;
                   2962:     my %gradelevels=(0 => 'Not specified',
                   2963: 		     1 => 'Grade 1',
                   2964: 		     2 => 'Grade 2',
                   2965: 		     3 => 'Grade 3',
                   2966: 		     4 => 'Grade 4',
                   2967: 		     5 => 'Grade 5',
                   2968: 		     6 => 'Grade 6',
                   2969: 		     7 => 'Grade 7',
                   2970: 		     8 => 'Grade 8',
                   2971: 		     9 => 'Grade 9',
                   2972: 		     10 => 'Grade 10',
                   2973: 		     11 => 'Grade 11',
                   2974: 		     12 => 'Grade 12',
                   2975: 		     13 => 'Grade 13',
                   2976: 		     14 => '100 Level',
                   2977: 		     15 => '200 Level',
                   2978: 		     16 => '300 Level',
                   2979: 		     17 => '400 Level',
                   2980: 		     18 => 'Graduate Level');
                   2981:     return &mt($gradelevels{$gradelevel});
                   2982: }
                   2983: 
1.163     www      2984: sub select_level_form {
                   2985:     my ($deflevel,$name)=@_;
                   2986:     unless ($deflevel) { $deflevel=0; }
1.167     www      2987:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2988:     for (my $i=0; $i<=18; $i++) {
                   2989:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2990:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2991:                 ">".&gradeleveldescription($i)."</option>\n";
                   2992:     }
                   2993:     $selectform.="</select>";
                   2994:     return $selectform;
1.163     www      2995: }
1.167     www      2996: 
1.35      matthew  2997: #-------------------------------------------
                   2998: 
1.45      matthew  2999: =pod
                   3000: 
1.1256    raeburn  3001: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35      matthew  3002: 
                   3003: Returns a string containing a <select name='$name' size='1'> form to 
                   3004: allow a user to select the domain to preform an operation in.  
                   3005: See loncreateuser.pm for an example invocation and use.
                   3006: 
1.90      www      3007: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   3008: selected");
                   3009: 
1.743     raeburn  3010: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   3011: 
1.910     raeburn  3012: 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.
                   3013: 
1.1121    raeburn  3014: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   3015: 
                   3016: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563     raeburn  3017: 
1.1256    raeburn  3018: The optional $disabled argument, if true, adds the disabled attribute to the select tag.
                   3019: 
1.35      matthew  3020: =cut
                   3021: 
                   3022: #-------------------------------------------
1.34      matthew  3023: sub select_dom_form {
1.1256    raeburn  3024:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872     raeburn  3025:     if ($onchange) {
1.874     raeburn  3026:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  3027:     }
1.1256    raeburn  3028:     if ($disabled) {
                   3029:         $disabled = ' disabled="disabled"';
                   3030:     }
1.1121    raeburn  3031:     my (@domains,%exclude);
1.910     raeburn  3032:     if (ref($incdoms) eq 'ARRAY') {
                   3033:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   3034:     } else {
                   3035:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   3036:     }
1.90      www      3037:     if ($includeempty) { @domains=('',@domains); }
1.1121    raeburn  3038:     if (ref($excdoms) eq 'ARRAY') {
                   3039:         map { $exclude{$_} = 1; } @{$excdoms}; 
                   3040:     }
1.1256    raeburn  3041:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356     albertel 3042:     foreach my $dom (@domains) {
1.1121    raeburn  3043:         next if ($exclude{$dom});
1.356     albertel 3044:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  3045:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   3046:         if ($showdomdesc) {
                   3047:             if ($dom ne '') {
                   3048:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   3049:                 if ($domdesc ne '') {
                   3050:                     $selectdomain .= ' ('.$domdesc.')';
                   3051:                 }
                   3052:             } 
                   3053:         }
                   3054:         $selectdomain .= "</option>\n";
1.34      matthew  3055:     }
                   3056:     $selectdomain.="</select>";
                   3057:     return $selectdomain;
                   3058: }
                   3059: 
1.35      matthew  3060: #-------------------------------------------
                   3061: 
1.45      matthew  3062: =pod
                   3063: 
1.648     raeburn  3064: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  3065: 
1.586     raeburn  3066: input: 4 arguments (two required, two optional) - 
                   3067:     $domain - domain of new user
                   3068:     $name - name of form element
                   3069:     $default - Value of 'default' causes a default item to be first 
                   3070:                             option, and selected by default. 
                   3071:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   3072:                             if 1 server found, or default, if 0 found.
1.594     raeburn  3073: output: returns 2 items: 
1.586     raeburn  3074: (a) form element which contains either:
                   3075:    (i) <select name="$name">
                   3076:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   3077:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   3078:        </select>
                   3079:        form item if there are multiple library servers in $domain, or
                   3080:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   3081:        if there is only one library server in $domain.
                   3082: 
                   3083: (b) number of library servers found.
                   3084: 
                   3085: See loncreateuser.pm for example of use.
1.35      matthew  3086: 
                   3087: =cut
                   3088: 
                   3089: #-------------------------------------------
1.586     raeburn  3090: sub home_server_form_item {
                   3091:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 3092:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  3093:     my $result;
                   3094:     my $numlib = keys(%servers);
                   3095:     if ($numlib > 1) {
                   3096:         $result .= '<select name="'.$name.'" />'."\n";
                   3097:         if ($default) {
1.804     bisitz   3098:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  3099:                        '</option>'."\n";
                   3100:         }
                   3101:         foreach my $hostid (sort(keys(%servers))) {
                   3102:             $result.= '<option value="'.$hostid.'">'.
                   3103: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   3104:         }
                   3105:         $result .= '</select>'."\n";
                   3106:     } elsif ($numlib == 1) {
                   3107:         my $hostid;
                   3108:         foreach my $item (keys(%servers)) {
                   3109:             $hostid = $item;
                   3110:         }
                   3111:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   3112:                    $hostid.'" />';
                   3113:                    if (!$hide) {
                   3114:                        $result .= $hostid.' '.$servers{$hostid};
                   3115:                    }
                   3116:                    $result .= "\n";
                   3117:     } elsif ($default) {
                   3118:         $result .= '<input type="hidden" name="'.$name.
                   3119:                    '" value="default" />';
                   3120:                    if (!$hide) {
                   3121:                        $result .= &mt('default');
                   3122:                    }
                   3123:                    $result .= "\n";
1.33      matthew  3124:     }
1.586     raeburn  3125:     return ($result,$numlib);
1.33      matthew  3126: }
1.112     bowersj2 3127: 
                   3128: =pod
                   3129: 
1.534     albertel 3130: =back 
                   3131: 
1.112     bowersj2 3132: =cut
1.87      matthew  3133: 
                   3134: ###############################################################
1.112     bowersj2 3135: ##                  Decoding User Agent                      ##
1.87      matthew  3136: ###############################################################
                   3137: 
                   3138: =pod
                   3139: 
1.112     bowersj2 3140: =head1 Decoding the User Agent
                   3141: 
                   3142: =over 4
                   3143: 
                   3144: =item * &decode_user_agent()
1.87      matthew  3145: 
                   3146: Inputs: $r
                   3147: 
                   3148: Outputs:
                   3149: 
                   3150: =over 4
                   3151: 
1.112     bowersj2 3152: =item * $httpbrowser
1.87      matthew  3153: 
1.112     bowersj2 3154: =item * $clientbrowser
1.87      matthew  3155: 
1.112     bowersj2 3156: =item * $clientversion
1.87      matthew  3157: 
1.112     bowersj2 3158: =item * $clientmathml
1.87      matthew  3159: 
1.112     bowersj2 3160: =item * $clientunicode
1.87      matthew  3161: 
1.112     bowersj2 3162: =item * $clientos
1.87      matthew  3163: 
1.1137    raeburn  3164: =item * $clientmobile
                   3165: 
1.1141    raeburn  3166: =item * $clientinfo
                   3167: 
1.1194    raeburn  3168: =item * $clientosversion
                   3169: 
1.87      matthew  3170: =back
                   3171: 
1.157     matthew  3172: =back 
                   3173: 
1.87      matthew  3174: =cut
                   3175: 
                   3176: ###############################################################
                   3177: ###############################################################
                   3178: sub decode_user_agent {
1.247     albertel 3179:     my ($r)=@_;
1.87      matthew  3180:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   3181:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   3182:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 3183:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  3184:     my $clientbrowser='unknown';
                   3185:     my $clientversion='0';
                   3186:     my $clientmathml='';
                   3187:     my $clientunicode='0';
1.1137    raeburn  3188:     my $clientmobile=0;
1.1194    raeburn  3189:     my $clientosversion='';
1.87      matthew  3190:     for (my $i=0;$i<=$#browsertype;$i++) {
1.1193    raeburn  3191:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87      matthew  3192: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   3193: 	    $clientbrowser=$bname;
                   3194:             $httpbrowser=~/$vreg/i;
                   3195: 	    $clientversion=$1;
                   3196:             $clientmathml=($clientversion>=$minv);
                   3197:             $clientunicode=($clientversion>=$univ);
                   3198: 	}
                   3199:     }
                   3200:     my $clientos='unknown';
1.1141    raeburn  3201:     my $clientinfo;
1.87      matthew  3202:     if (($httpbrowser=~/linux/i) ||
                   3203:         ($httpbrowser=~/unix/i) ||
                   3204:         ($httpbrowser=~/ux/i) ||
                   3205:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   3206:     if (($httpbrowser=~/vax/i) ||
                   3207:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   3208:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   3209:     if (($httpbrowser=~/mac/i) ||
                   3210:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194    raeburn  3211:     if ($httpbrowser=~/win/i) {
                   3212:         $clientos='win';
                   3213:         if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
                   3214:             $clientosversion = $1;
                   3215:         }
                   3216:     }
1.87      matthew  3217:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137    raeburn  3218:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   3219:         $clientmobile=lc($1);
                   3220:     }
1.1141    raeburn  3221:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   3222:         $clientinfo = 'firefox-'.$1;
                   3223:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   3224:         $clientinfo = 'chromeframe-'.$1;
                   3225:     }
1.87      matthew  3226:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194    raeburn  3227:             $clientunicode,$clientos,$clientmobile,$clientinfo,
                   3228:             $clientosversion);
1.87      matthew  3229: }
                   3230: 
1.32      matthew  3231: ###############################################################
                   3232: ##    Authentication changing form generation subroutines    ##
                   3233: ###############################################################
                   3234: ##
                   3235: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   3236: ## hash, and have reasonable default values.
                   3237: ##
                   3238: ##    formname = the name given in the <form> tag.
1.35      matthew  3239: #-------------------------------------------
                   3240: 
1.45      matthew  3241: =pod
                   3242: 
1.112     bowersj2 3243: =head1 Authentication Routines
                   3244: 
                   3245: =over 4
                   3246: 
1.648     raeburn  3247: =item * &authform_xxxxxx()
1.35      matthew  3248: 
                   3249: The authform_xxxxxx subroutines provide javascript and html forms which 
                   3250: handle some of the conveniences required for authentication forms.  
                   3251: This is not an optimal method, but it works.  
                   3252: 
                   3253: =over 4
                   3254: 
1.112     bowersj2 3255: =item * authform_header
1.35      matthew  3256: 
1.112     bowersj2 3257: =item * authform_authorwarning
1.35      matthew  3258: 
1.112     bowersj2 3259: =item * authform_nochange
1.35      matthew  3260: 
1.112     bowersj2 3261: =item * authform_kerberos
1.35      matthew  3262: 
1.112     bowersj2 3263: =item * authform_internal
1.35      matthew  3264: 
1.112     bowersj2 3265: =item * authform_filesystem
1.35      matthew  3266: 
1.1310    raeburn  3267: =item * authform_lti
                   3268: 
1.35      matthew  3269: =back
                   3270: 
1.648     raeburn  3271: See loncreateuser.pm for invocation and use examples.
1.157     matthew  3272: 
1.35      matthew  3273: =cut
                   3274: 
                   3275: #-------------------------------------------
1.32      matthew  3276: sub authform_header{  
                   3277:     my %in = (
                   3278:         formname => 'cu',
1.80      albertel 3279:         kerb_def_dom => '',
1.32      matthew  3280:         @_,
                   3281:     );
                   3282:     $in{'formname'} = 'document.' . $in{'formname'};
                   3283:     my $result='';
1.80      albertel 3284: 
                   3285: #---------------------------------------------- Code for upper case translation
                   3286:     my $Javascript_toUpperCase;
                   3287:     unless ($in{kerb_def_dom}) {
                   3288:         $Javascript_toUpperCase =<<"END";
                   3289:         switch (choice) {
                   3290:            case 'krb': currentform.elements[choicearg].value =
                   3291:                currentform.elements[choicearg].value.toUpperCase();
                   3292:                break;
                   3293:            default:
                   3294:         }
                   3295: END
                   3296:     } else {
                   3297:         $Javascript_toUpperCase = "";
                   3298:     }
                   3299: 
1.165     raeburn  3300:     my $radioval = "'nochange'";
1.591     raeburn  3301:     if (defined($in{'curr_authtype'})) {
                   3302:         if ($in{'curr_authtype'} ne '') {
                   3303:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   3304:         }
1.174     matthew  3305:     }
1.165     raeburn  3306:     my $argfield = 'null';
1.591     raeburn  3307:     if (defined($in{'mode'})) {
1.165     raeburn  3308:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  3309:             if (defined($in{'curr_autharg'})) {
                   3310:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  3311:                     $argfield = "'$in{'curr_autharg'}'";
                   3312:                 }
                   3313:             }
                   3314:         }
                   3315:     }
                   3316: 
1.32      matthew  3317:     $result.=<<"END";
                   3318: var current = new Object();
1.165     raeburn  3319: current.radiovalue = $radioval;
                   3320: current.argfield = $argfield;
1.32      matthew  3321: 
                   3322: function changed_radio(choice,currentform) {
                   3323:     var choicearg = choice + 'arg';
                   3324:     // If a radio button in changed, we need to change the argfield
                   3325:     if (current.radiovalue != choice) {
                   3326:         current.radiovalue = choice;
                   3327:         if (current.argfield != null) {
                   3328:             currentform.elements[current.argfield].value = '';
                   3329:         }
                   3330:         if (choice == 'nochange') {
                   3331:             current.argfield = null;
                   3332:         } else {
                   3333:             current.argfield = choicearg;
                   3334:             switch(choice) {
                   3335:                 case 'krb': 
                   3336:                     currentform.elements[current.argfield].value = 
                   3337:                         "$in{'kerb_def_dom'}";
                   3338:                 break;
                   3339:               default:
                   3340:                 break;
                   3341:             }
                   3342:         }
                   3343:     }
                   3344:     return;
                   3345: }
1.22      www      3346: 
1.32      matthew  3347: function changed_text(choice,currentform) {
                   3348:     var choicearg = choice + 'arg';
                   3349:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 3350:         $Javascript_toUpperCase
1.32      matthew  3351:         // clear old field
                   3352:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   3353:             currentform.elements[current.argfield].value = '';
                   3354:         }
                   3355:         current.argfield = choicearg;
                   3356:     }
                   3357:     set_auth_radio_buttons(choice,currentform);
                   3358:     return;
1.20      www      3359: }
1.32      matthew  3360: 
                   3361: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  3362:     var numauthchoices = currentform.login.length;
                   3363:     if (typeof numauthchoices  == "undefined") {
                   3364:         return;
                   3365:     } 
1.32      matthew  3366:     var i=0;
1.986     raeburn  3367:     while (i < numauthchoices) {
1.32      matthew  3368:         if (currentform.login[i].value == newvalue) { break; }
                   3369:         i++;
                   3370:     }
1.986     raeburn  3371:     if (i == numauthchoices) {
1.32      matthew  3372:         return;
                   3373:     }
                   3374:     current.radiovalue = newvalue;
                   3375:     currentform.login[i].checked = true;
                   3376:     return;
                   3377: }
                   3378: END
                   3379:     return $result;
                   3380: }
                   3381: 
1.1106    raeburn  3382: sub authform_authorwarning {
1.32      matthew  3383:     my $result='';
1.144     matthew  3384:     $result='<i>'.
                   3385:         &mt('As a general rule, only authors or co-authors should be '.
                   3386:             'filesystem authenticated '.
                   3387:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  3388:     return $result;
                   3389: }
                   3390: 
1.1106    raeburn  3391: sub authform_nochange {
1.32      matthew  3392:     my %in = (
                   3393:               formname => 'document.cu',
                   3394:               kerb_def_dom => 'MSU.EDU',
                   3395:               @_,
                   3396:           );
1.1106    raeburn  3397:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586     raeburn  3398:     my $result;
1.1104    raeburn  3399:     if (!$authnum) {
1.1105    raeburn  3400:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  3401:     } else {
                   3402:         $result = '<label>'.&mt('[_1] Do not change login data',
                   3403:                   '<input type="radio" name="login" value="nochange" '.
                   3404:                   'checked="checked" onclick="'.
1.281     albertel 3405:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   3406: 	    '</label>';
1.586     raeburn  3407:     }
1.32      matthew  3408:     return $result;
                   3409: }
                   3410: 
1.591     raeburn  3411: sub authform_kerberos {
1.32      matthew  3412:     my %in = (
                   3413:               formname => 'document.cu',
                   3414:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 3415:               kerb_def_auth => 'krb4',
1.32      matthew  3416:               @_,
                   3417:               );
1.586     raeburn  3418:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1259    raeburn  3419:         $autharg,$jscall,$disabled);
1.1106    raeburn  3420:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 3421:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   3422:        $check5 = ' checked="checked"';
1.80      albertel 3423:     } else {
1.772     bisitz   3424:        $check4 = ' checked="checked"';
1.80      albertel 3425:     }
1.1259    raeburn  3426:     if ($in{'readonly'}) {
                   3427:         $disabled = ' disabled="disabled"';
                   3428:     }
1.165     raeburn  3429:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  3430:     if (defined($in{'curr_authtype'})) {
                   3431:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   3432:             $krbcheck = ' checked="checked"';
1.623     raeburn  3433:             if (defined($in{'mode'})) {
                   3434:                 if ($in{'mode'} eq 'modifyuser') {
                   3435:                     $krbcheck = '';
                   3436:                 }
                   3437:             }
1.591     raeburn  3438:             if (defined($in{'curr_kerb_ver'})) {
                   3439:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   3440:                     $check5 = ' checked="checked"';
1.591     raeburn  3441:                     $check4 = '';
                   3442:                 } else {
1.772     bisitz   3443:                     $check4 = ' checked="checked"';
1.591     raeburn  3444:                     $check5 = '';
                   3445:                 }
1.586     raeburn  3446:             }
1.591     raeburn  3447:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  3448:                 $krbarg = $in{'curr_autharg'};
                   3449:             }
1.586     raeburn  3450:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  3451:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3452:                     $result = 
                   3453:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   3454:         $in{'curr_autharg'},$krbver);
                   3455:                 } else {
                   3456:                     $result =
                   3457:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   3458:                 }
                   3459:                 return $result; 
                   3460:             }
                   3461:         }
                   3462:     } else {
                   3463:         if ($authnum == 1) {
1.784     bisitz   3464:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  3465:         }
                   3466:     }
1.586     raeburn  3467:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   3468:         return;
1.587     raeburn  3469:     } elsif ($authtype eq '') {
1.591     raeburn  3470:         if (defined($in{'mode'})) {
1.587     raeburn  3471:             if ($in{'mode'} eq 'modifycourse') {
                   3472:                 if ($authnum == 1) {
1.1259    raeburn  3473:                     $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587     raeburn  3474:                 }
                   3475:             }
                   3476:         }
1.586     raeburn  3477:     }
                   3478:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   3479:     if ($authtype eq '') {
                   3480:         $authtype = '<input type="radio" name="login" value="krb" '.
                   3481:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1259    raeburn  3482:                     $krbcheck.$disabled.' />';
1.586     raeburn  3483:     }
                   3484:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106    raeburn  3485:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  3486:          $in{'curr_authtype'} eq 'krb5') ||
1.1106    raeburn  3487:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  3488:          $in{'curr_authtype'} eq 'krb4')) {
                   3489:         $result .= &mt
1.144     matthew  3490:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 3491:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  3492:          '<label>'.$authtype,
1.281     albertel 3493:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  3494:              'value="'.$krbarg.'" '.
1.1259    raeburn  3495:              'onchange="'.$jscall.'"'.$disabled.' />',
                   3496:          '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
                   3497:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281     albertel 3498: 	 '</label>');
1.586     raeburn  3499:     } elsif ($can_assign{'krb4'}) {
                   3500:         $result .= &mt
                   3501:         ('[_1] Kerberos authenticated with domain [_2] '.
                   3502:          '[_3] Version 4 [_4]',
                   3503:          '<label>'.$authtype,
                   3504:          '</label><input type="text" size="10" name="krbarg" '.
                   3505:              'value="'.$krbarg.'" '.
1.1259    raeburn  3506:              'onchange="'.$jscall.'"'.$disabled.' />',
1.586     raeburn  3507:          '<label><input type="hidden" name="krbver" value="4" />',
                   3508:          '</label>');
                   3509:     } elsif ($can_assign{'krb5'}) {
                   3510:         $result .= &mt
                   3511:         ('[_1] Kerberos authenticated with domain [_2] '.
                   3512:          '[_3] Version 5 [_4]',
                   3513:          '<label>'.$authtype,
                   3514:          '</label><input type="text" size="10" name="krbarg" '.
                   3515:              'value="'.$krbarg.'" '.
1.1259    raeburn  3516:              'onchange="'.$jscall.'"'.$disabled.' />',
1.586     raeburn  3517:          '<label><input type="hidden" name="krbver" value="5" />',
                   3518:          '</label>');
                   3519:     }
1.32      matthew  3520:     return $result;
                   3521: }
                   3522: 
1.1106    raeburn  3523: sub authform_internal {
1.586     raeburn  3524:     my %in = (
1.32      matthew  3525:                 formname => 'document.cu',
                   3526:                 kerb_def_dom => 'MSU.EDU',
                   3527:                 @_,
                   3528:                 );
1.1259    raeburn  3529:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106    raeburn  3530:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259    raeburn  3531:     if ($in{'readonly'}) {
                   3532:         $disabled = ' disabled="disabled"';
                   3533:     }
1.591     raeburn  3534:     if (defined($in{'curr_authtype'})) {
                   3535:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  3536:             if ($can_assign{'int'}) {
1.772     bisitz   3537:                 $intcheck = 'checked="checked" ';
1.623     raeburn  3538:                 if (defined($in{'mode'})) {
                   3539:                     if ($in{'mode'} eq 'modifyuser') {
                   3540:                         $intcheck = '';
                   3541:                     }
                   3542:                 }
1.591     raeburn  3543:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3544:                     $intarg = $in{'curr_autharg'};
                   3545:                 }
                   3546:             } else {
                   3547:                 $result = &mt('Currently internally authenticated.');
                   3548:                 return $result;
1.165     raeburn  3549:             }
                   3550:         }
1.586     raeburn  3551:     } else {
                   3552:         if ($authnum == 1) {
1.784     bisitz   3553:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  3554:         }
                   3555:     }
                   3556:     if (!$can_assign{'int'}) {
                   3557:         return;
1.587     raeburn  3558:     } elsif ($authtype eq '') {
1.591     raeburn  3559:         if (defined($in{'mode'})) {
1.587     raeburn  3560:             if ($in{'mode'} eq 'modifycourse') {
                   3561:                 if ($authnum == 1) {
1.1259    raeburn  3562:                     $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587     raeburn  3563:                 }
                   3564:             }
                   3565:         }
1.165     raeburn  3566:     }
1.586     raeburn  3567:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   3568:     if ($authtype eq '') {
                   3569:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1259    raeburn  3570:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3571:     }
1.605     bisitz   3572:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1259    raeburn  3573:                $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3574:     $result = &mt
1.144     matthew  3575:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  3576:          '<label>'.$authtype,'</label>'.$autharg);
1.1259    raeburn  3577:     $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  3578:     return $result;
                   3579: }
                   3580: 
1.1104    raeburn  3581: sub authform_local {
1.32      matthew  3582:     my %in = (
                   3583:               formname => 'document.cu',
                   3584:               kerb_def_dom => 'MSU.EDU',
                   3585:               @_,
                   3586:               );
1.1259    raeburn  3587:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106    raeburn  3588:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259    raeburn  3589:     if ($in{'readonly'}) {
                   3590:         $disabled = ' disabled="disabled"';
                   3591:     } 
1.591     raeburn  3592:     if (defined($in{'curr_authtype'})) {
                   3593:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  3594:             if ($can_assign{'loc'}) {
1.772     bisitz   3595:                 $loccheck = 'checked="checked" ';
1.623     raeburn  3596:                 if (defined($in{'mode'})) {
                   3597:                     if ($in{'mode'} eq 'modifyuser') {
                   3598:                         $loccheck = '';
                   3599:                     }
                   3600:                 }
1.591     raeburn  3601:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3602:                     $locarg = $in{'curr_autharg'};
                   3603:                 }
                   3604:             } else {
                   3605:                 $result = &mt('Currently using local (institutional) authentication.');
                   3606:                 return $result;
1.165     raeburn  3607:             }
                   3608:         }
1.586     raeburn  3609:     } else {
                   3610:         if ($authnum == 1) {
1.784     bisitz   3611:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  3612:         }
                   3613:     }
                   3614:     if (!$can_assign{'loc'}) {
                   3615:         return;
1.587     raeburn  3616:     } elsif ($authtype eq '') {
1.591     raeburn  3617:         if (defined($in{'mode'})) {
1.587     raeburn  3618:             if ($in{'mode'} eq 'modifycourse') {
                   3619:                 if ($authnum == 1) {
1.1259    raeburn  3620:                     $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587     raeburn  3621:                 }
                   3622:             }
                   3623:         }
1.165     raeburn  3624:     }
1.586     raeburn  3625:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   3626:     if ($authtype eq '') {
                   3627:         $authtype = '<input type="radio" name="login" value="loc" '.
                   3628:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1259    raeburn  3629:                     $jscall.'"'.$disabled.' />';
1.586     raeburn  3630:     }
                   3631:     $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1259    raeburn  3632:                $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3633:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   3634:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  3635:     return $result;
                   3636: }
                   3637: 
1.1106    raeburn  3638: sub authform_filesystem {
1.32      matthew  3639:     my %in = (
                   3640:               formname => 'document.cu',
                   3641:               kerb_def_dom => 'MSU.EDU',
                   3642:               @_,
                   3643:               );
1.1259    raeburn  3644:     my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1106    raeburn  3645:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259    raeburn  3646:     if ($in{'readonly'}) {
                   3647:         $disabled = ' disabled="disabled"';
                   3648:     }
1.591     raeburn  3649:     if (defined($in{'curr_authtype'})) {
                   3650:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  3651:             if ($can_assign{'fsys'}) {
1.772     bisitz   3652:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  3653:                 if (defined($in{'mode'})) {
                   3654:                     if ($in{'mode'} eq 'modifyuser') {
                   3655:                         $fsyscheck = '';
                   3656:                     }
                   3657:                 }
1.586     raeburn  3658:             } else {
                   3659:                 $result = &mt('Currently Filesystem Authenticated.');
                   3660:                 return $result;
1.1259    raeburn  3661:             }
1.586     raeburn  3662:         }
                   3663:     } else {
                   3664:         if ($authnum == 1) {
1.784     bisitz   3665:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  3666:         }
                   3667:     }
                   3668:     if (!$can_assign{'fsys'}) {
                   3669:         return;
1.587     raeburn  3670:     } elsif ($authtype eq '') {
1.591     raeburn  3671:         if (defined($in{'mode'})) {
1.587     raeburn  3672:             if ($in{'mode'} eq 'modifycourse') {
                   3673:                 if ($authnum == 1) {
1.1259    raeburn  3674:                     $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587     raeburn  3675:                 }
                   3676:             }
                   3677:         }
1.586     raeburn  3678:     }
                   3679:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   3680:     if ($authtype eq '') {
                   3681:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   3682:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1259    raeburn  3683:                     $jscall.'"'.$disabled.' />';
1.586     raeburn  3684:     }
1.1310    raeburn  3685:     $autharg = '<input type="password" size="10" name="fsysarg" value=""'.
1.1259    raeburn  3686:                ' onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3687:     $result = &mt
1.144     matthew  3688:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.1310    raeburn  3689:          '<label>'.$authtype,'</label>'.$autharg);
                   3690:     return $result;
                   3691: }
                   3692: 
                   3693: sub authform_lti {
                   3694:     my %in = (
                   3695:               formname => 'document.cu',
                   3696:               kerb_def_dom => 'MSU.EDU',
                   3697:               @_,
                   3698:               );
                   3699:     my ($lticheck,$result,$authtype,$autharg,$jscall,$disabled);
                   3700:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
                   3701:     if ($in{'readonly'}) {
                   3702:         $disabled = ' disabled="disabled"';
                   3703:     }
                   3704:     if (defined($in{'curr_authtype'})) {
                   3705:         if ($in{'curr_authtype'} eq 'lti') {
                   3706:             if ($can_assign{'lti'}) {
                   3707:                 $lticheck = 'checked="checked" ';
                   3708:                 if (defined($in{'mode'})) {
                   3709:                     if ($in{'mode'} eq 'modifyuser') {
                   3710:                         $lticheck = '';
                   3711:                     }
                   3712:                 }
                   3713:             } else {
                   3714:                 $result = &mt('Currently LTI Authenticated.');
                   3715:                 return $result;
                   3716:             }
                   3717:         }
                   3718:     } else {
                   3719:         if ($authnum == 1) {
                   3720:             $authtype = '<input type="hidden" name="login" value="lti" />';
                   3721:         }
                   3722:     }
                   3723:     if (!$can_assign{'lti'}) {
                   3724:         return;
                   3725:     } elsif ($authtype eq '') {
                   3726:         if (defined($in{'mode'})) {
                   3727:             if ($in{'mode'} eq 'modifycourse') {
                   3728:                 if ($authnum == 1) {
                   3729:                     $authtype = '<input type="radio" name="login" value="lti"'.$disabled.' />';
                   3730:                 }
                   3731:             }
                   3732:         }
                   3733:     }
                   3734:     $jscall = "javascript:changed_radio('lti',$in{'formname'});";
                   3735:     if (($authtype eq '') && (($in{'mode'} eq 'modifycourse') || ($in{'curr_authtype'} ne 'lti'))) {
                   3736:         $authtype = '<input type="radio" name="login" value="lti" '.
                   3737:                     $lticheck.' onchange="'.$jscall.'" onclick="'.
                   3738:                     $jscall.'"'.$disabled.' />';
                   3739:     }
                   3740:     $autharg = '<input type="hidden" name="ltiarg" value="" />';
                   3741:     if ($authtype) {
                   3742:         $result = &mt('[_1] LTI Authenticated',
                   3743:                       '<label>'.$authtype.'</label>'.$autharg);
                   3744:     } else {
                   3745:         $result = '<b>'.&mt('LTI Authenticated').'</b>'.
                   3746:                   $autharg;
                   3747:     }
1.32      matthew  3748:     return $result;
                   3749: }
                   3750: 
1.586     raeburn  3751: sub get_assignable_auth {
                   3752:     my ($dom) = @_;
                   3753:     if ($dom eq '') {
                   3754:         $dom = $env{'request.role.domain'};
                   3755:     }
                   3756:     my %can_assign = (
                   3757:                           krb4 => 1,
                   3758:                           krb5 => 1,
                   3759:                           int  => 1,
                   3760:                           loc  => 1,
1.1310    raeburn  3761:                           lti  => 1,
1.586     raeburn  3762:                      );
                   3763:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   3764:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   3765:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   3766:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   3767:             my $context;
                   3768:             if ($env{'request.role'} =~ /^au/) {
                   3769:                 $context = 'author';
1.1259    raeburn  3770:             } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586     raeburn  3771:                 $context = 'domain';
                   3772:             } elsif ($env{'request.course.id'}) {
                   3773:                 $context = 'course';
                   3774:             }
                   3775:             if ($context) {
                   3776:                 if (ref($authhash->{$context}) eq 'HASH') {
                   3777:                    %can_assign = %{$authhash->{$context}}; 
                   3778:                 }
                   3779:             }
                   3780:         }
                   3781:     }
                   3782:     my $authnum = 0;
                   3783:     foreach my $key (keys(%can_assign)) {
                   3784:         if ($can_assign{$key}) {
                   3785:             $authnum ++;
                   3786:         }
                   3787:     }
                   3788:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   3789:         $authnum --;
                   3790:     }
                   3791:     return ($authnum,%can_assign);
                   3792: }
                   3793: 
1.1331    raeburn  3794: sub check_passwd_rules {
                   3795:     my ($domain,$plainpass) = @_;
                   3796:     my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
                   3797:     my ($min,$max,@chars,@brokerule,$warning);
1.1333    raeburn  3798:     $min = $Apache::lonnet::passwdmin;
1.1331    raeburn  3799:     if (ref($passwdconf{'chars'}) eq 'ARRAY') {
                   3800:         if ($passwdconf{'min'} =~ /^\d+$/) {
1.1333    raeburn  3801:             if ($passwdconf{'min'} > $min) {
                   3802:                 $min = $passwdconf{'min'};
                   3803:             }
1.1331    raeburn  3804:         }
                   3805:         if ($passwdconf{'max'} =~ /^\d+$/) {
                   3806:             $max = $passwdconf{'max'};
                   3807:         }
                   3808:         @chars = @{$passwdconf{'chars'}};
                   3809:     }
                   3810:     if (($min) && (length($plainpass) < $min)) {
                   3811:         push(@brokerule,'min');
                   3812:     }
                   3813:     if (($max) && (length($plainpass) > $max)) {
                   3814:         push(@brokerule,'max');
                   3815:     }
                   3816:     if (@chars) {
                   3817:         my %rules;
                   3818:         map { $rules{$_} = 1; } @chars;
                   3819:         if ($rules{'uc'}) {
                   3820:             unless ($plainpass =~ /[A-Z]/) {
                   3821:                 push(@brokerule,'uc');
                   3822:             }
                   3823:         }
                   3824:         if ($rules{'lc'}) {
1.1332    raeburn  3825:             unless ($plainpass =~ /[a-z]/) {
1.1331    raeburn  3826:                 push(@brokerule,'lc');
                   3827:             }
                   3828:         }
                   3829:         if ($rules{'num'}) {
                   3830:             unless ($plainpass =~ /\d/) {
                   3831:                 push(@brokerule,'num');
                   3832:             }
                   3833:         }
                   3834:         if ($rules{'spec'}) {
                   3835:             unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
                   3836:                 push(@brokerule,'spec');
                   3837:             }
                   3838:         }
                   3839:     }
                   3840:     if (@brokerule) {
                   3841:         my %rulenames = &Apache::lonlocal::texthash(
                   3842:             uc   => 'At least one upper case letter',
                   3843:             lc   => 'At least one lower case letter',
                   3844:             num  => 'At least one number',
                   3845:             spec => 'At least one non-alphanumeric',
                   3846:         );
                   3847:         $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
                   3848:         $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
                   3849:         $rulenames{'num'} .= ': 0123456789';
                   3850:         $rulenames{'spec'} .= ': !&quot;\#$%&amp;\'()*+,-./:;&lt;=&gt;?@[\]^_\`{|}~';
                   3851:         $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
                   3852:         $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
                   3853:         $warning = &mt('Password did not satisfy the following:').'<ul>';
1.1336    raeburn  3854:         foreach my $rule ('min','max','uc','lc','num','spec') {
1.1331    raeburn  3855:             if (grep(/^$rule$/,@brokerule)) {
                   3856:                 $warning .= '<li>'.$rulenames{$rule}.'</li>';
                   3857:             }
                   3858:         }
                   3859:         $warning .= '</ul>';
                   3860:     }
1.1332    raeburn  3861:     if (wantarray) {
                   3862:         return @brokerule;
                   3863:     }
1.1331    raeburn  3864:     return $warning;
                   3865: }
                   3866: 
1.1376    raeburn  3867: sub passwd_validation_js {
1.1377    raeburn  3868:     my ($currpasswdval,$domain,$context,$id) = @_;
                   3869:     my (%passwdconf,$alertmsg);
                   3870:     if ($context eq 'linkprot') {
                   3871:         my %domconfig = &Apache::lonnet::get_dom('configuration',['ltisec'],$domain);
                   3872:         if (ref($domconfig{'ltisec'}) eq 'HASH') {
                   3873:             if (ref($domconfig{'ltisec'}{'rules'}) eq 'HASH') {
                   3874:                 %passwdconf = %{$domconfig{'ltisec'}{'rules'}};
                   3875:             }
                   3876:         }
                   3877:         if ($id eq 'add') {
                   3878:             $alertmsg = &mt('Secret for added launcher did not satisfy requirement(s):').'\n\n';
                   3879:         } elsif ($id =~ /^\d+$/) {
                   3880:             my $pos = $id+1;
                   3881:             $alertmsg = &mt('Secret for launcher [_1] did not satisfy requirement(s):','#'.$pos).'\n\n';
                   3882:         } else {
                   3883:             $alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n';
                   3884:         }
                   3885:     } else {
                   3886:         %passwdconf = &Apache::lonnet::get_passwdconf($domain);
                   3887:         $alertmsg = &mt('Initial password did not satisfy requirement(s):').'\n\n';
                   3888:     }
1.1376    raeburn  3889:     my ($min,$max,@chars,$numrules,$intargjs,%alert);
                   3890:     $numrules = 0;
                   3891:     $min = $Apache::lonnet::passwdmin;
                   3892:     if (ref($passwdconf{'chars'}) eq 'ARRAY') {
                   3893:         if ($passwdconf{'min'} =~ /^\d+$/) {
                   3894:             if ($passwdconf{'min'} > $min) {
                   3895:                 $min = $passwdconf{'min'};
                   3896:             }
                   3897:         }
                   3898:         if ($passwdconf{'max'} =~ /^\d+$/) {
                   3899:             $max = $passwdconf{'max'};
                   3900:             $numrules ++;
                   3901:         }
                   3902:         @chars = @{$passwdconf{'chars'}};
                   3903:         if (@chars) {
                   3904:             $numrules ++;
                   3905:         }
                   3906:     }
                   3907:     if ($min > 0) {
                   3908:         $numrules ++;
                   3909:     }
                   3910:     if (($min > 0) || ($max ne '') || (@chars > 0)) {
                   3911:         if ($min) {
                   3912:             $alert{'min'} = &mt('minimum [quant,_1,character]',$min).'\n';
                   3913:         }
                   3914:         if ($max) {
                   3915:             $alert{'max'} = &mt('maximum [quant,_1,character]',$max).'\n';
                   3916:         }
                   3917:         my (@charalerts,@charrules);
                   3918:         if (@chars) {
                   3919:             if (grep(/^uc$/,@chars)) {
                   3920:                 push(@charalerts,&mt('contain at least one upper case letter'));
                   3921:                 push(@charrules,'uc');
                   3922:             }
                   3923:             if (grep(/^lc$/,@chars)) {
                   3924:                 push(@charalerts,&mt('contain at least one lower case letter'));
                   3925:                 push(@charrules,'lc');
                   3926:             }
                   3927:             if (grep(/^num$/,@chars)) {
                   3928:                 push(@charalerts,&mt('contain at least one number'));
                   3929:                 push(@charrules,'num');
                   3930:             }
                   3931:             if (grep(/^spec$/,@chars)) {
                   3932:                 push(@charalerts,&mt('contain at least one non-alphanumeric'));
                   3933:                 push(@charrules,'spec');
                   3934:             }
                   3935:         }
                   3936:         $intargjs = qq|            var rulesmsg = '';\n|.
                   3937:                     qq|            var currpwval = $currpasswdval;\n|;
                   3938:             if ($min) {
                   3939:                 $intargjs .= qq|
                   3940:             if (currpwval.length < $min) {
                   3941:                 rulesmsg += ' - $alert{min}';
                   3942:             }
                   3943: |;
                   3944:             }
                   3945:             if ($max) {
                   3946:                 $intargjs .= qq|
                   3947:             if (currpwval.length > $max) {
                   3948:                 rulesmsg += ' - $alert{max}';
                   3949:             }
                   3950: |;
                   3951:             }
                   3952:             if (@chars > 0) {
                   3953:                 my $charrulestr = '"'.join('","',@charrules).'"';
                   3954:                 my $charalertstr = '"'.join('","',@charalerts).'"';
                   3955:                 $intargjs .= qq|            var brokerules = new Array();\n|.
                   3956:                              qq|            var charrules = new Array($charrulestr);\n|.
                   3957:                              qq|            var charalerts = new Array($charalertstr);\n|;
                   3958:                 my %rules;
                   3959:                 map { $rules{$_} = 1; } @chars;
                   3960:                 if ($rules{'uc'}) {
                   3961:                     $intargjs .= qq|
                   3962:             var ucRegExp = /[A-Z]/;
                   3963:             if (!ucRegExp.test(currpwval)) {
                   3964:                 brokerules.push('uc');
                   3965:             }
                   3966: |;
                   3967:                 }
                   3968:                 if ($rules{'lc'}) {
                   3969:                     $intargjs .= qq|
                   3970:             var lcRegExp = /[a-z]/;
                   3971:             if (!lcRegExp.test(currpwval)) {
                   3972:                 brokerules.push('lc');
                   3973:             }
                   3974: |;
                   3975:                 }
                   3976:                 if ($rules{'num'}) {
                   3977:                      $intargjs .= qq|
                   3978:             var numRegExp = /[0-9]/;
                   3979:             if (!numRegExp.test(currpwval)) {
                   3980:                 brokerules.push('num');
                   3981:             }
                   3982: |;
                   3983:                 }
                   3984:                 if ($rules{'spec'}) {
                   3985:                      $intargjs .= q|
                   3986:             var specRegExp = /[!"#$%&'()*+,\-.\/:;<=>?@[\\^\]_`{\|}~]/;
                   3987:             if (!specRegExp.test(currpwval)) {
                   3988:                 brokerules.push('spec');
                   3989:             }
                   3990: |;
                   3991:                 }
                   3992:                 $intargjs .= qq|
                   3993:             if (brokerules.length > 0) {
                   3994:                 for (var i=0; i<brokerules.length; i++) {
                   3995:                     for (var j=0; j<charrules.length; j++) {
                   3996:                         if (brokerules[i] == charrules[j]) {
                   3997:                             rulesmsg += ' - '+charalerts[j]+'\\n';
                   3998:                             break;
                   3999:                         }
                   4000:                     }
                   4001:                 }
                   4002:             }
                   4003: |;
                   4004:             }
                   4005:             $intargjs .= qq|
                   4006:             if (rulesmsg != '') {
                   4007:                 rulesmsg = '$alertmsg'+rulesmsg;
                   4008:                 alert(rulesmsg);
                   4009:                 return false;
                   4010:             }
                   4011: |;
                   4012:     }
                   4013:     return ($numrules,$intargjs);
                   4014: }
                   4015: 
1.80      albertel 4016: ###############################################################
                   4017: ##    Get Kerberos Defaults for Domain                 ##
                   4018: ###############################################################
                   4019: ##
                   4020: ## Returns default kerberos version and an associated argument
                   4021: ## as listed in file domain.tab. If not listed, provides
                   4022: ## appropriate default domain and kerberos version.
                   4023: ##
                   4024: #-------------------------------------------
                   4025: 
                   4026: =pod
                   4027: 
1.648     raeburn  4028: =item * &get_kerberos_defaults()
1.80      albertel 4029: 
                   4030: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  4031: version and domain. If not found, it defaults to version 4 and the 
                   4032: domain of the server.
1.80      albertel 4033: 
1.648     raeburn  4034: =over 4
                   4035: 
1.80      albertel 4036: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   4037: 
1.648     raeburn  4038: =back
                   4039: 
                   4040: =back
                   4041: 
1.80      albertel 4042: =cut
                   4043: 
                   4044: #-------------------------------------------
                   4045: sub get_kerberos_defaults {
                   4046:     my $domain=shift;
1.641     raeburn  4047:     my ($krbdef,$krbdefdom);
                   4048:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   4049:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   4050:         $krbdef = $domdefaults{'auth_def'};
                   4051:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   4052:     } else {
1.80      albertel 4053:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   4054:         my $krbdefdom=$1;
                   4055:         $krbdefdom=~tr/a-z/A-Z/;
                   4056:         $krbdef = "krb4";
                   4057:     }
                   4058:     return ($krbdef,$krbdefdom);
                   4059: }
1.112     bowersj2 4060: 
1.32      matthew  4061: 
1.46      matthew  4062: ###############################################################
                   4063: ##                Thesaurus Functions                        ##
                   4064: ###############################################################
1.20      www      4065: 
1.46      matthew  4066: =pod
1.20      www      4067: 
1.112     bowersj2 4068: =head1 Thesaurus Functions
                   4069: 
                   4070: =over 4
                   4071: 
1.648     raeburn  4072: =item * &initialize_keywords()
1.46      matthew  4073: 
                   4074: Initializes the package variable %Keywords if it is empty.  Uses the
                   4075: package variable $thesaurus_db_file.
                   4076: 
                   4077: =cut
                   4078: 
                   4079: ###################################################
                   4080: 
                   4081: sub initialize_keywords {
                   4082:     return 1 if (scalar keys(%Keywords));
                   4083:     # If we are here, %Keywords is empty, so fill it up
                   4084:     #   Make sure the file we need exists...
                   4085:     if (! -e $thesaurus_db_file) {
                   4086:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   4087:                                  " failed because it does not exist");
                   4088:         return 0;
                   4089:     }
                   4090:     #   Set up the hash as a database
                   4091:     my %thesaurus_db;
                   4092:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 4093:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  4094:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   4095:                                  $thesaurus_db_file);
                   4096:         return 0;
                   4097:     } 
                   4098:     #  Get the average number of appearances of a word.
                   4099:     my $avecount = $thesaurus_db{'average.count'};
                   4100:     #  Put keywords (those that appear > average) into %Keywords
                   4101:     while (my ($word,$data)=each (%thesaurus_db)) {
                   4102:         my ($count,undef) = split /:/,$data;
                   4103:         $Keywords{$word}++ if ($count > $avecount);
                   4104:     }
                   4105:     untie %thesaurus_db;
                   4106:     # Remove special values from %Keywords.
1.356     albertel 4107:     foreach my $value ('total.count','average.count') {
                   4108:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  4109:   }
1.46      matthew  4110:     return 1;
                   4111: }
                   4112: 
                   4113: ###################################################
                   4114: 
                   4115: =pod
                   4116: 
1.648     raeburn  4117: =item * &keyword($word)
1.46      matthew  4118: 
                   4119: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   4120: than the average number of times in the thesaurus database.  Calls 
                   4121: &initialize_keywords
                   4122: 
                   4123: =cut
                   4124: 
                   4125: ###################################################
1.20      www      4126: 
                   4127: sub keyword {
1.46      matthew  4128:     return if (!&initialize_keywords());
                   4129:     my $word=lc(shift());
                   4130:     $word=~s/\W//g;
                   4131:     return exists($Keywords{$word});
1.20      www      4132: }
1.46      matthew  4133: 
                   4134: ###############################################################
                   4135: 
                   4136: =pod 
1.20      www      4137: 
1.648     raeburn  4138: =item * &get_related_words()
1.46      matthew  4139: 
1.160     matthew  4140: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  4141: an array of words.  If the keyword is not in the thesaurus, an empty array
                   4142: will be returned.  The order of the words returned is determined by the
                   4143: database which holds them.
                   4144: 
                   4145: Uses global $thesaurus_db_file.
                   4146: 
1.1057    foxr     4147: 
1.46      matthew  4148: =cut
                   4149: 
                   4150: ###############################################################
                   4151: sub get_related_words {
                   4152:     my $keyword = shift;
                   4153:     my %thesaurus_db;
                   4154:     if (! -e $thesaurus_db_file) {
                   4155:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   4156:                                  "failed because the file does not exist");
                   4157:         return ();
                   4158:     }
                   4159:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 4160:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  4161:         return ();
                   4162:     } 
                   4163:     my @Words=();
1.429     www      4164:     my $count=0;
1.46      matthew  4165:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 4166: 	# The first element is the number of times
                   4167: 	# the word appears.  We do not need it now.
1.429     www      4168: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   4169: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   4170: 	my $threshold=$mostfrequentcount/10;
                   4171:         foreach my $possibleword (@RelatedWords) {
                   4172:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   4173:             if ($wordcount>$threshold) {
                   4174: 		push(@Words,$word);
                   4175:                 $count++;
                   4176:                 if ($count>10) { last; }
                   4177: 	    }
1.20      www      4178:         }
                   4179:     }
1.46      matthew  4180:     untie %thesaurus_db;
                   4181:     return @Words;
1.14      harris41 4182: }
1.1090    foxr     4183: ###############################################################
                   4184: #
                   4185: #  Spell checking
                   4186: #
                   4187: 
                   4188: =pod
                   4189: 
1.1142    raeburn  4190: =back
                   4191: 
1.1090    foxr     4192: =head1 Spell checking
                   4193: 
                   4194: =over 4
                   4195: 
                   4196: =item * &check_spelling($wordlist $language)
                   4197: 
                   4198: Takes a string containing words and feeds it to an external
                   4199: spellcheck program via a pipeline. Returns a string containing
                   4200: them mis-spelled words.
                   4201: 
                   4202: Parameters:
                   4203: 
                   4204: =over 4
                   4205: 
                   4206: =item - $wordlist
                   4207: 
                   4208: String that will be fed into the spellcheck program.
                   4209: 
                   4210: =item - $language
                   4211: 
                   4212: Language string that specifies the language for which the spell
                   4213: check will be performed.
                   4214: 
                   4215: =back
                   4216: 
                   4217: =back
                   4218: 
                   4219: Note: This sub assumes that aspell is installed.
                   4220: 
                   4221: 
                   4222: =cut
                   4223: 
1.46      matthew  4224: 
1.1090    foxr     4225: sub check_spelling {
                   4226:     my ($wordlist, $language) = @_;
1.1091    foxr     4227:     my @misspellings;
                   4228:     
                   4229:     # Generate the speller and set the langauge.
                   4230:     # if explicitly selected:
1.1090    foxr     4231: 
1.1091    foxr     4232:     my $speller = Text::Aspell->new;
1.1090    foxr     4233:     if ($language) {
1.1091    foxr     4234: 	$speller->set_option('lang', $language);
1.1090    foxr     4235:     }
                   4236: 
1.1091    foxr     4237:     # Turn the word list into an array of words by splittingon whitespace
1.1090    foxr     4238: 
1.1091    foxr     4239:     my @words = split(/\s+/, $wordlist);
1.1090    foxr     4240: 
1.1091    foxr     4241:     foreach my $word (@words) {
                   4242: 	if(! $speller->check($word)) {
                   4243: 	    push(@misspellings, $word);
1.1090    foxr     4244: 	}
                   4245:     }
1.1091    foxr     4246:     return join(' ', @misspellings);
                   4247:     
1.1090    foxr     4248: }
                   4249: 
1.61      www      4250: # -------------------------------------------------------------- Plaintext name
1.81      albertel 4251: =pod
                   4252: 
1.112     bowersj2 4253: =head1 User Name Functions
                   4254: 
                   4255: =over 4
                   4256: 
1.648     raeburn  4257: =item * &plainname($uname,$udom,$first)
1.81      albertel 4258: 
1.112     bowersj2 4259: Takes a users logon name and returns it as a string in
1.226     albertel 4260: "first middle last generation" form 
                   4261: if $first is set to 'lastname' then it returns it as
                   4262: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 4263: 
                   4264: =cut
1.61      www      4265: 
1.295     www      4266: 
1.81      albertel 4267: ###############################################################
1.61      www      4268: sub plainname {
1.226     albertel 4269:     my ($uname,$udom,$first)=@_;
1.537     albertel 4270:     return if (!defined($uname) || !defined($udom));
1.295     www      4271:     my %names=&getnames($uname,$udom);
1.226     albertel 4272:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   4273: 					  $names{'middlename'},
                   4274: 					  $names{'lastname'},
                   4275: 					  $names{'generation'},$first);
                   4276:     $name=~s/^\s+//;
1.62      www      4277:     $name=~s/\s+$//;
                   4278:     $name=~s/\s+/ /g;
1.353     albertel 4279:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      4280:     return $name;
1.61      www      4281: }
1.66      www      4282: 
                   4283: # -------------------------------------------------------------------- Nickname
1.81      albertel 4284: =pod
                   4285: 
1.648     raeburn  4286: =item * &nickname($uname,$udom)
1.81      albertel 4287: 
                   4288: Gets a users name and returns it as a string as
                   4289: 
                   4290: "&quot;nickname&quot;"
1.66      www      4291: 
1.81      albertel 4292: if the user has a nickname or
                   4293: 
                   4294: "first middle last generation"
                   4295: 
                   4296: if the user does not
                   4297: 
                   4298: =cut
1.66      www      4299: 
                   4300: sub nickname {
                   4301:     my ($uname,$udom)=@_;
1.537     albertel 4302:     return if (!defined($uname) || !defined($udom));
1.295     www      4303:     my %names=&getnames($uname,$udom);
1.68      albertel 4304:     my $name=$names{'nickname'};
1.66      www      4305:     if ($name) {
                   4306:        $name='&quot;'.$name.'&quot;'; 
                   4307:     } else {
                   4308:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   4309: 	     $names{'lastname'}.' '.$names{'generation'};
                   4310:        $name=~s/\s+$//;
                   4311:        $name=~s/\s+/ /g;
                   4312:     }
                   4313:     return $name;
                   4314: }
                   4315: 
1.295     www      4316: sub getnames {
                   4317:     my ($uname,$udom)=@_;
1.537     albertel 4318:     return if (!defined($uname) || !defined($udom));
1.433     albertel 4319:     if ($udom eq 'public' && $uname eq 'public') {
                   4320: 	return ('lastname' => &mt('Public'));
                   4321:     }
1.295     www      4322:     my $id=$uname.':'.$udom;
                   4323:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   4324:     if ($cached) {
                   4325: 	return %{$names};
                   4326:     } else {
                   4327: 	my %loadnames=&Apache::lonnet::get('environment',
                   4328:                     ['firstname','middlename','lastname','generation','nickname'],
                   4329: 					 $udom,$uname);
                   4330: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   4331: 	return %loadnames;
                   4332:     }
                   4333: }
1.61      www      4334: 
1.542     raeburn  4335: # -------------------------------------------------------------------- getemails
1.648     raeburn  4336: 
1.542     raeburn  4337: =pod
                   4338: 
1.648     raeburn  4339: =item * &getemails($uname,$udom)
1.542     raeburn  4340: 
                   4341: Gets a user's email information and returns it as a hash with keys:
                   4342: notification, critnotification, permanentemail
                   4343: 
                   4344: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  4345: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  4346:  
1.648     raeburn  4347: 
1.542     raeburn  4348: =cut
                   4349: 
1.648     raeburn  4350: 
1.466     albertel 4351: sub getemails {
                   4352:     my ($uname,$udom)=@_;
                   4353:     if ($udom eq 'public' && $uname eq 'public') {
                   4354: 	return;
                   4355:     }
1.467     www      4356:     if (!$udom) { $udom=$env{'user.domain'}; }
                   4357:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 4358:     my $id=$uname.':'.$udom;
                   4359:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   4360:     if ($cached) {
                   4361: 	return %{$names};
                   4362:     } else {
                   4363: 	my %loadnames=&Apache::lonnet::get('environment',
                   4364:                     			   ['notification','critnotification',
                   4365: 					    'permanentemail'],
                   4366: 					   $udom,$uname);
                   4367: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   4368: 	return %loadnames;
                   4369:     }
                   4370: }
                   4371: 
1.551     albertel 4372: sub flush_email_cache {
                   4373:     my ($uname,$udom)=@_;
                   4374:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   4375:     if (!$uname) { $uname=$env{'user.name'};   }
                   4376:     return if ($udom eq 'public' && $uname eq 'public');
                   4377:     my $id=$uname.':'.$udom;
                   4378:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   4379: }
                   4380: 
1.728     raeburn  4381: # -------------------------------------------------------------------- getlangs
                   4382: 
                   4383: =pod
                   4384: 
                   4385: =item * &getlangs($uname,$udom)
                   4386: 
                   4387: Gets a user's language preference and returns it as a hash with key:
                   4388: language.
                   4389: 
                   4390: =cut
                   4391: 
                   4392: 
                   4393: sub getlangs {
                   4394:     my ($uname,$udom) = @_;
                   4395:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   4396:     if (!$uname) { $uname=$env{'user.name'};   }
                   4397:     my $id=$uname.':'.$udom;
                   4398:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   4399:     if ($cached) {
                   4400:         return %{$langs};
                   4401:     } else {
                   4402:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   4403:                                            $udom,$uname);
                   4404:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   4405:         return %loadlangs;
                   4406:     }
                   4407: }
                   4408: 
                   4409: sub flush_langs_cache {
                   4410:     my ($uname,$udom)=@_;
                   4411:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   4412:     if (!$uname) { $uname=$env{'user.name'};   }
                   4413:     return if ($udom eq 'public' && $uname eq 'public');
                   4414:     my $id=$uname.':'.$udom;
                   4415:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   4416: }
                   4417: 
1.61      www      4418: # ------------------------------------------------------------------ Screenname
1.81      albertel 4419: 
                   4420: =pod
                   4421: 
1.648     raeburn  4422: =item * &screenname($uname,$udom)
1.81      albertel 4423: 
                   4424: Gets a users screenname and returns it as a string
                   4425: 
                   4426: =cut
1.61      www      4427: 
                   4428: sub screenname {
                   4429:     my ($uname,$udom)=@_;
1.258     albertel 4430:     if ($uname eq $env{'user.name'} &&
                   4431: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 4432:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 4433:     return $names{'screenname'};
1.62      www      4434: }
                   4435: 
1.212     albertel 4436: 
1.802     bisitz   4437: # ------------------------------------------------------------- Confirm Wrapper
                   4438: =pod
                   4439: 
1.1142    raeburn  4440: =item * &confirmwrapper($message)
1.802     bisitz   4441: 
                   4442: Wrap messages about completion of operation in box
                   4443: 
                   4444: =cut
                   4445: 
                   4446: sub confirmwrapper {
                   4447:     my ($message)=@_;
                   4448:     if ($message) {
                   4449:         return "\n".'<div class="LC_confirm_box">'."\n"
                   4450:                .$message."\n"
                   4451:                .'</div>'."\n";
                   4452:     } else {
                   4453:         return $message;
                   4454:     }
                   4455: }
                   4456: 
1.62      www      4457: # ------------------------------------------------------------- Message Wrapper
                   4458: 
                   4459: sub messagewrapper {
1.369     www      4460:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      4461:     return 
1.441     albertel 4462:         '<a href="/adm/email?compose=individual&amp;'.
                   4463:         'recname='.$username.'&amp;recdom='.$domain.
                   4464: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  4465:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      4466: }
1.802     bisitz   4467: 
1.74      www      4468: # --------------------------------------------------------------- Notes Wrapper
                   4469: 
                   4470: sub noteswrapper {
                   4471:     my ($link,$un,$do)=@_;
                   4472:     return 
1.896     amueller 4473: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      4474: }
1.802     bisitz   4475: 
1.62      www      4476: # ------------------------------------------------------------- Aboutme Wrapper
                   4477: 
                   4478: sub aboutmewrapper {
1.1070    raeburn  4479:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  4480:     if (!defined($username)  && !defined($domain)) {
                   4481:         return;
                   4482:     }
1.1096    raeburn  4483:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  4484: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      4485: }
                   4486: 
                   4487: # ------------------------------------------------------------ Syllabus Wrapper
                   4488: 
                   4489: sub syllabuswrapper {
1.707     bisitz   4490:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  4491:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      4492: }
1.14      harris41 4493: 
1.1397    raeburn  4494: # -----------------------------------------------------------------------------
                   4495: 
1.1396    raeburn  4496: sub aboutme_on {
                   4497:     my ($uname,$udom)=@_;
                   4498:     unless ($uname) { $uname=$env{'user.name'}; }
                   4499:     unless ($udom)  { $udom=$env{'user.domain'}; }
                   4500:     return if ($udom eq 'public' && $uname eq 'public');
                   4501:     my $hashkey=$uname.':'.$udom;
                   4502:     my ($aboutme,$cached)=&Apache::lonnet::is_cached_new('aboutme',$hashkey);
                   4503:     if ($cached) {
                   4504:         return $aboutme;
                   4505:     }
                   4506:     $aboutme = &Apache::lonnet::usertools_access($uname,$udom,'aboutme');
                   4507:     &Apache::lonnet::do_cache_new('aboutme',$hashkey,$aboutme,3600);
                   4508:     return $aboutme;
                   4509: }
                   4510: 
                   4511: sub devalidate_aboutme_cache {
                   4512:     my ($uname,$udom)=@_;
                   4513:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   4514:     if (!$uname) { $uname=$env{'user.name'};   }
                   4515:     return if ($udom eq 'public' && $uname eq 'public');
                   4516:     my $id=$uname.':'.$udom;
                   4517:     &Apache::lonnet::devalidate_cache_new('aboutme',$id);
                   4518: }
                   4519: 
1.208     matthew  4520: sub track_student_link {
1.887     raeburn  4521:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 4522:     my $link ="/adm/trackstudent?";
1.208     matthew  4523:     my $title = 'View recent activity';
                   4524:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   4525:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 4526:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  4527:         $title .= ' of this student';
1.268     albertel 4528:     } 
1.208     matthew  4529:     if (defined($target) && $target !~ /^\s*$/) {
                   4530:         $target = qq{target="$target"};
                   4531:     } else {
                   4532:         $target = '';
                   4533:     }
1.268     albertel 4534:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  4535:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 4536:     $title = &mt($title);
                   4537:     $linktext = &mt($linktext);
1.448     albertel 4538:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   4539: 	&help_open_topic('View_recent_activity');
1.208     matthew  4540: }
                   4541: 
1.781     raeburn  4542: sub slot_reservations_link {
                   4543:     my ($linktext,$sname,$sdom,$target) = @_;
                   4544:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   4545:     my $title = 'View slot reservation history';
                   4546:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   4547:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   4548:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   4549:         $title .= ' of this student';
                   4550:     }
                   4551:     if (defined($target) && $target !~ /^\s*$/) {
                   4552:         $target = qq{target="$target"};
                   4553:     } else {
                   4554:         $target = '';
                   4555:     }
                   4556:     $title = &mt($title);
                   4557:     $linktext = &mt($linktext);
                   4558:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   4559: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   4560: 
                   4561: }
                   4562: 
1.508     www      4563: # ===================================================== Display a student photo
                   4564: 
                   4565: 
1.509     albertel 4566: sub student_image_tag {
1.508     www      4567:     my ($domain,$user)=@_;
                   4568:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   4569:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   4570: 	return '<img src="'.$imgsrc.'" align="right" />';
                   4571:     } else {
                   4572: 	return '';
                   4573:     }
                   4574: }
                   4575: 
1.112     bowersj2 4576: =pod
                   4577: 
                   4578: =back
                   4579: 
                   4580: =head1 Access .tab File Data
                   4581: 
                   4582: =over 4
                   4583: 
1.648     raeburn  4584: =item * &languageids() 
1.112     bowersj2 4585: 
                   4586: returns list of all language ids
                   4587: 
                   4588: =cut
                   4589: 
1.14      harris41 4590: sub languageids {
1.16      harris41 4591:     return sort(keys(%language));
1.14      harris41 4592: }
                   4593: 
1.112     bowersj2 4594: =pod
                   4595: 
1.648     raeburn  4596: =item * &languagedescription() 
1.112     bowersj2 4597: 
                   4598: returns description of a specified language id
                   4599: 
                   4600: =cut
                   4601: 
1.14      harris41 4602: sub languagedescription {
1.125     www      4603:     my $code=shift;
                   4604:     return  ($supported_language{$code}?'* ':'').
                   4605:             $language{$code}.
1.126     www      4606: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      4607: }
                   4608: 
1.1048    foxr     4609: =pod
                   4610: 
                   4611: =item * &plainlanguagedescription
                   4612: 
                   4613: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   4614: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   4615: 
                   4616: =cut
                   4617: 
1.145     www      4618: sub plainlanguagedescription {
                   4619:     my $code=shift;
                   4620:     return $language{$code};
                   4621: }
                   4622: 
1.1048    foxr     4623: =pod
                   4624: 
                   4625: =item * &supportedlanguagecode
                   4626: 
                   4627: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   4628: code.
                   4629: 
                   4630: =cut
                   4631: 
1.145     www      4632: sub supportedlanguagecode {
                   4633:     my $code=shift;
                   4634:     return $supported_language{$code};
1.97      www      4635: }
                   4636: 
1.112     bowersj2 4637: =pod
                   4638: 
1.1048    foxr     4639: =item * &latexlanguage()
                   4640: 
                   4641: Given a language key code returns the correspondnig language to use
                   4642: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   4643: is no supported hyphenation for the language code.
                   4644: 
                   4645: =cut
                   4646: 
                   4647: sub latexlanguage {
                   4648:     my $code = shift;
                   4649:     return $latex_language{$code};
                   4650: }
                   4651: 
                   4652: =pod
                   4653: 
                   4654: =item * &latexhyphenation()
                   4655: 
                   4656: Same as above but what's supplied is the language as it might be stored
                   4657: in the metadata.
                   4658: 
                   4659: =cut
                   4660: 
                   4661: sub latexhyphenation {
                   4662:     my $key = shift;
                   4663:     return $latex_language_bykey{$key};
                   4664: }
                   4665: 
                   4666: =pod
                   4667: 
1.648     raeburn  4668: =item * &copyrightids() 
1.112     bowersj2 4669: 
                   4670: returns list of all copyrights
                   4671: 
                   4672: =cut
                   4673: 
                   4674: sub copyrightids {
                   4675:     return sort(keys(%cprtag));
                   4676: }
                   4677: 
                   4678: =pod
                   4679: 
1.648     raeburn  4680: =item * &copyrightdescription() 
1.112     bowersj2 4681: 
                   4682: returns description of a specified copyright id
                   4683: 
                   4684: =cut
                   4685: 
                   4686: sub copyrightdescription {
1.166     www      4687:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 4688: }
1.197     matthew  4689: 
                   4690: =pod
                   4691: 
1.648     raeburn  4692: =item * &source_copyrightids() 
1.192     taceyjo1 4693: 
                   4694: returns list of all source copyrights
                   4695: 
                   4696: =cut
                   4697: 
                   4698: sub source_copyrightids {
                   4699:     return sort(keys(%scprtag));
                   4700: }
                   4701: 
                   4702: =pod
                   4703: 
1.648     raeburn  4704: =item * &source_copyrightdescription() 
1.192     taceyjo1 4705: 
                   4706: returns description of a specified source copyright id
                   4707: 
                   4708: =cut
                   4709: 
                   4710: sub source_copyrightdescription {
                   4711:     return &mt($scprtag{shift(@_)});
                   4712: }
1.112     bowersj2 4713: 
                   4714: =pod
                   4715: 
1.648     raeburn  4716: =item * &filecategories() 
1.112     bowersj2 4717: 
                   4718: returns list of all file categories
                   4719: 
                   4720: =cut
                   4721: 
                   4722: sub filecategories {
                   4723:     return sort(keys(%category_extensions));
                   4724: }
                   4725: 
                   4726: =pod
                   4727: 
1.648     raeburn  4728: =item * &filecategorytypes() 
1.112     bowersj2 4729: 
                   4730: returns list of file types belonging to a given file
                   4731: category
                   4732: 
                   4733: =cut
                   4734: 
                   4735: sub filecategorytypes {
1.356     albertel 4736:     my ($cat) = @_;
1.1248    raeburn  4737:     if (ref($category_extensions{lc($cat)}) eq 'ARRAY') { 
                   4738:         return @{$category_extensions{lc($cat)}};
                   4739:     } else {
                   4740:         return ();
                   4741:     }
1.112     bowersj2 4742: }
                   4743: 
                   4744: =pod
                   4745: 
1.648     raeburn  4746: =item * &fileembstyle() 
1.112     bowersj2 4747: 
                   4748: returns embedding style for a specified file type
                   4749: 
                   4750: =cut
                   4751: 
                   4752: sub fileembstyle {
                   4753:     return $fe{lc(shift(@_))};
1.169     www      4754: }
                   4755: 
1.351     www      4756: sub filemimetype {
                   4757:     return $fm{lc(shift(@_))};
                   4758: }
                   4759: 
1.169     www      4760: 
                   4761: sub filecategoryselect {
                   4762:     my ($name,$value)=@_;
1.189     matthew  4763:     return &select_form($value,$name,
1.970     raeburn  4764:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 4765: }
                   4766: 
                   4767: =pod
                   4768: 
1.648     raeburn  4769: =item * &filedescription() 
1.112     bowersj2 4770: 
                   4771: returns description for a specified file type
                   4772: 
                   4773: =cut
                   4774: 
                   4775: sub filedescription {
1.188     matthew  4776:     my $file_description = $fd{lc(shift())};
                   4777:     $file_description =~ s:([\[\]]):~$1:g;
                   4778:     return &mt($file_description);
1.112     bowersj2 4779: }
                   4780: 
                   4781: =pod
                   4782: 
1.648     raeburn  4783: =item * &filedescriptionex() 
1.112     bowersj2 4784: 
                   4785: returns description for a specified file type with
                   4786: extra formatting
                   4787: 
                   4788: =cut
                   4789: 
                   4790: sub filedescriptionex {
                   4791:     my $ex=shift;
1.188     matthew  4792:     my $file_description = $fd{lc($ex)};
                   4793:     $file_description =~ s:([\[\]]):~$1:g;
                   4794:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 4795: }
                   4796: 
                   4797: # End of .tab access
                   4798: =pod
                   4799: 
                   4800: =back
                   4801: 
                   4802: =cut
                   4803: 
                   4804: # ------------------------------------------------------------------ File Types
                   4805: sub fileextensions {
                   4806:     return sort(keys(%fe));
                   4807: }
                   4808: 
1.97      www      4809: # ----------------------------------------------------------- Display Languages
                   4810: # returns a hash with all desired display languages
                   4811: #
                   4812: 
                   4813: sub display_languages {
                   4814:     my %languages=();
1.695     raeburn  4815:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 4816: 	$languages{$lang}=1;
1.97      www      4817:     }
                   4818:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 4819:     if ($env{'form.displaylanguage'}) {
1.356     albertel 4820: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   4821: 	    $languages{$lang}=1;
1.97      www      4822:         }
                   4823:     }
                   4824:     return %languages;
1.14      harris41 4825: }
                   4826: 
1.582     albertel 4827: sub languages {
                   4828:     my ($possible_langs) = @_;
1.695     raeburn  4829:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 4830:     if (!ref($possible_langs)) {
                   4831: 	if( wantarray ) {
                   4832: 	    return @preferred_langs;
                   4833: 	} else {
                   4834: 	    return $preferred_langs[0];
                   4835: 	}
                   4836:     }
                   4837:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   4838:     my @preferred_possibilities;
                   4839:     foreach my $preferred_lang (@preferred_langs) {
                   4840: 	if (exists($possibilities{$preferred_lang})) {
                   4841: 	    push(@preferred_possibilities, $preferred_lang);
                   4842: 	}
                   4843:     }
                   4844:     if( wantarray ) {
                   4845: 	return @preferred_possibilities;
                   4846:     }
                   4847:     return $preferred_possibilities[0];
                   4848: }
                   4849: 
1.742     raeburn  4850: sub user_lang {
                   4851:     my ($touname,$toudom,$fromcid) = @_;
                   4852:     my @userlangs;
                   4853:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   4854:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   4855:                     $env{'course.'.$fromcid.'.languages'}));
                   4856:     } else {
                   4857:         my %langhash = &getlangs($touname,$toudom);
                   4858:         if ($langhash{'languages'} ne '') {
                   4859:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   4860:         } else {
                   4861:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   4862:             if ($domdefs{'lang_def'} ne '') {
                   4863:                 @userlangs = ($domdefs{'lang_def'});
                   4864:             }
                   4865:         }
                   4866:     }
                   4867:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   4868:     my $user_lh = Apache::localize->get_handle(@languages);
                   4869:     return $user_lh;
                   4870: }
                   4871: 
                   4872: 
1.112     bowersj2 4873: ###############################################################
                   4874: ##               Student Answer Attempts                     ##
                   4875: ###############################################################
                   4876: 
                   4877: =pod
                   4878: 
                   4879: =head1 Alternate Problem Views
                   4880: 
                   4881: =over 4
                   4882: 
1.648     raeburn  4883: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199    raeburn  4884:     $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112     bowersj2 4885: 
                   4886: Return string with previous attempt on problem. Arguments:
                   4887: 
                   4888: =over 4
                   4889: 
                   4890: =item * $symb: Problem, including path
                   4891: 
                   4892: =item * $username: username of the desired student
                   4893: 
                   4894: =item * $domain: domain of the desired student
1.14      harris41 4895: 
1.112     bowersj2 4896: =item * $course: Course ID
1.14      harris41 4897: 
1.112     bowersj2 4898: =item * $getattempt: Leave blank for all attempts, otherwise put
                   4899:     something
1.14      harris41 4900: 
1.112     bowersj2 4901: =item * $regexp: if string matches this regexp, the string will be
                   4902:     sent to $gradesub
1.14      harris41 4903: 
1.112     bowersj2 4904: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 4905: 
1.1199    raeburn  4906: =item * $usec: section of the desired student
                   4907: 
                   4908: =item * $identifier: counter for student (multiple students one problem) or 
                   4909:     problem (one student; whole sequence).
                   4910: 
1.112     bowersj2 4911: =back
1.14      harris41 4912: 
1.112     bowersj2 4913: The output string is a table containing all desired attempts, if any.
1.16      harris41 4914: 
1.112     bowersj2 4915: =cut
1.1       albertel 4916: 
                   4917: sub get_previous_attempt {
1.1199    raeburn  4918:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1       albertel 4919:   my $prevattempts='';
1.43      ng       4920:   no strict 'refs';
1.1       albertel 4921:   if ($symb) {
1.3       albertel 4922:     my (%returnhash)=
                   4923:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 4924:     if ($returnhash{'version'}) {
                   4925:       my %lasthash=();
                   4926:       my $version;
                   4927:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212    raeburn  4928:         foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
                   4929:             if ($key =~ /\.rawrndseed$/) {
                   4930:                 my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
                   4931:                 $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
                   4932:             } else {
                   4933:                 $lasthash{$key}=$returnhash{$version.':'.$key};
                   4934:             }
1.19      harris41 4935:         }
1.1       albertel 4936:       }
1.596     albertel 4937:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   4938:       $prevattempts.='<th>'.&mt('History').'</th>';
1.1199    raeburn  4939:       my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945     raeburn  4940:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 4941:       foreach my $key (sort(keys(%lasthash))) {
                   4942: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       4943: 	if ($#parts > 0) {
1.31      albertel 4944: 	  my $data=$parts[-1];
1.989     raeburn  4945:           next if ($data eq 'foilorder');
1.31      albertel 4946: 	  pop(@parts);
1.1010    www      4947:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  4948:           if ($data eq 'type') {
                   4949:               unless ($showsurv) {
                   4950:                   my $id = join(',',@parts);
                   4951:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  4952:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   4953:                       $lasthidden{$ign.'.'.$id} = 1;
                   4954:                   }
1.945     raeburn  4955:               }
1.1199    raeburn  4956:               if ($identifier ne '') {
                   4957:                   my $id = join(',',@parts);
                   4958:                   if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
                   4959:                                                $domain,$username,$usec,undef,$course) =~ /^no/) {
                   4960:                       $hidestatus{$ign.'.'.$id} = 1;
                   4961:                   }
                   4962:               }
                   4963:           } elsif ($data eq 'regrader') {
                   4964:               if (($identifier ne '') && (@parts)) {
1.1200    raeburn  4965:                   my $id = join(',',@parts);
                   4966:                   $regraded{$ign.'.'.$id} = 1;
1.1199    raeburn  4967:               }
1.1010    www      4968:           } 
1.31      albertel 4969: 	} else {
1.41      ng       4970: 	  if ($#parts == 0) {
                   4971: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   4972: 	  } else {
                   4973: 	    $prevattempts.='<th>'.$ign.'</th>';
                   4974: 	  }
1.31      albertel 4975: 	}
1.16      harris41 4976:       }
1.596     albertel 4977:       $prevattempts.=&end_data_table_header_row();
1.40      ng       4978:       if ($getattempt eq '') {
1.1199    raeburn  4979:         my (%solved,%resets,%probstatus);
1.1200    raeburn  4980:         if (($identifier ne '') && (keys(%regraded) > 0)) {
                   4981:             for ($version=1;$version<=$returnhash{'version'};$version++) {
                   4982:                 foreach my $id (keys(%regraded)) {
                   4983:                     if (($returnhash{$version.':'.$id.'.regrader'}) &&
                   4984:                         ($returnhash{$version.':'.$id.'.tries'} eq '') &&
                   4985:                         ($returnhash{$version.':'.$id.'.award'} eq '')) {
                   4986:                         push(@{$resets{$id}},$version);
1.1199    raeburn  4987:                     }
                   4988:                 }
                   4989:             }
1.1200    raeburn  4990:         }
                   4991: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199    raeburn  4992:             my (@hidden,@unsolved);
1.945     raeburn  4993:             if (%typeparts) {
                   4994:                 foreach my $id (keys(%typeparts)) {
1.1199    raeburn  4995:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || 
                   4996:                         ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945     raeburn  4997:                         push(@hidden,$id);
1.1199    raeburn  4998:                     } elsif ($identifier ne '') {
                   4999:                         unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
                   5000:                                 ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
                   5001:                                 ($hidestatus{$id})) {
1.1200    raeburn  5002:                             next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199    raeburn  5003:                             if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
                   5004:                                 push(@{$solved{$id}},$version);
                   5005:                             } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
                   5006:                                      (ref($solved{$id}) eq 'ARRAY')) {
                   5007:                                 my $skip;
                   5008:                                 if (ref($resets{$id}) eq 'ARRAY') {
                   5009:                                     foreach my $reset (@{$resets{$id}}) {
                   5010:                                         if ($reset > $solved{$id}[-1]) {
                   5011:                                             $skip=1;
                   5012:                                             last;
                   5013:                                         }
                   5014:                                     }
                   5015:                                 }
                   5016:                                 unless ($skip) {
                   5017:                                     my ($ign,$partslist) = split(/\./,$id,2);
                   5018:                                     push(@unsolved,$partslist);
                   5019:                                 }
                   5020:                             }
                   5021:                         }
1.945     raeburn  5022:                     }
                   5023:                 }
                   5024:             }
                   5025:             $prevattempts.=&start_data_table_row().
1.1199    raeburn  5026:                            '<td>'.&mt('Transaction [_1]',$version);
                   5027:             if (@unsolved) {
                   5028:                 $prevattempts .= '<span class="LC_nobreak"><label>'.
                   5029:                                  '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
                   5030:                                  &mt('Hide').'</label></span>';
                   5031:             }
                   5032:             $prevattempts .= '</td>';
1.945     raeburn  5033:             if (@hidden) {
                   5034:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  5035:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  5036:                     my $hide;
                   5037:                     foreach my $id (@hidden) {
                   5038:                         if ($key =~ /^\Q$id\E/) {
                   5039:                             $hide = 1;
                   5040:                             last;
                   5041:                         }
                   5042:                     }
                   5043:                     if ($hide) {
                   5044:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   5045:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   5046:                             my $value = &format_previous_attempt_value($key,
                   5047:                                              $returnhash{$version.':'.$key});
1.1173    kruse    5048:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  5049:                         } else {
                   5050:                             $prevattempts.='<td>&nbsp;</td>';
                   5051:                         }
                   5052:                     } else {
                   5053:                         if ($key =~ /\./) {
1.1212    raeburn  5054:                             my $value = $returnhash{$version.':'.$key};
                   5055:                             if ($key =~ /\.rndseed$/) {
                   5056:                                 my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                   5057:                                 if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   5058:                                     $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   5059:                                 }
                   5060:                             }
                   5061:                             $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   5062:                                            '&nbsp;</td>';
1.945     raeburn  5063:                         } else {
                   5064:                             $prevattempts.='<td>&nbsp;</td>';
                   5065:                         }
                   5066:                     }
                   5067:                 }
                   5068:             } else {
                   5069: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  5070:                     next if ($key =~ /\.foilorder$/);
1.1212    raeburn  5071:                     my $value = $returnhash{$version.':'.$key};
                   5072:                     if ($key =~ /\.rndseed$/) {
                   5073:                         my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                   5074:                         if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   5075:                             $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   5076:                         }
                   5077:                     }
                   5078:                     $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   5079:                                    '&nbsp;</td>';
1.945     raeburn  5080: 	        }
                   5081:             }
                   5082: 	    $prevattempts.=&end_data_table_row();
1.40      ng       5083: 	 }
1.1       albertel 5084:       }
1.945     raeburn  5085:       my @currhidden = keys(%lasthidden);
1.596     albertel 5086:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 5087:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  5088:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  5089:           if (%typeparts) {
                   5090:               my $hidden;
                   5091:               foreach my $id (@currhidden) {
                   5092:                   if ($key =~ /^\Q$id\E/) {
                   5093:                       $hidden = 1;
                   5094:                       last;
                   5095:                   }
                   5096:               }
                   5097:               if ($hidden) {
                   5098:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   5099:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   5100:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   5101:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   5102:                           $value = &$gradesub($value);
                   5103:                       }
1.1173    kruse    5104:                       $prevattempts.='<td>'. $value.'&nbsp;</td>';
1.945     raeburn  5105:                   } else {
                   5106:                       $prevattempts.='<td>&nbsp;</td>';
                   5107:                   }
                   5108:               } else {
                   5109:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   5110:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   5111:                       $value = &$gradesub($value);
                   5112:                   }
1.1173    kruse    5113:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  5114:               }
                   5115:           } else {
                   5116: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   5117: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   5118:                   $value = &$gradesub($value);
                   5119:               }
1.1173    kruse    5120: 	     $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  5121:           }
1.16      harris41 5122:       }
1.596     albertel 5123:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 5124:     } else {
1.1305    raeburn  5125:       my $msg;
                   5126:       if ($symb =~ /ext\.tool$/) {
                   5127:           $msg = &mt('No grade passed back.');
                   5128:       } else {
                   5129:           $msg = &mt('Nothing submitted - no attempts.');
                   5130:       }
1.596     albertel 5131:       $prevattempts=
                   5132: 	  &start_data_table().&start_data_table_row().
1.1305    raeburn  5133: 	  '<td>'.$msg.'</td>'.
1.596     albertel 5134: 	  &end_data_table_row().&end_data_table();
1.1       albertel 5135:     }
                   5136:   } else {
1.596     albertel 5137:     $prevattempts=
                   5138: 	  &start_data_table().&start_data_table_row().
                   5139: 	  '<td>'.&mt('No data.').'</td>'.
                   5140: 	  &end_data_table_row().&end_data_table();
1.1       albertel 5141:   }
1.10      albertel 5142: }
                   5143: 
1.581     albertel 5144: sub format_previous_attempt_value {
                   5145:     my ($key,$value) = @_;
1.1011    www      5146:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173    kruse    5147:         $value = &Apache::lonlocal::locallocaltime($value);
1.581     albertel 5148:     } elsif (ref($value) eq 'ARRAY') {
1.1173    kruse    5149:         $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988     raeburn  5150:     } elsif ($key =~ /answerstring$/) {
                   5151:         my %answers = &Apache::lonnet::str2hash($value);
1.1173    kruse    5152:         my @answer = %answers;
                   5153:         %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988     raeburn  5154:         my @anskeys = sort(keys(%answers));
                   5155:         if (@anskeys == 1) {
                   5156:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  5157:             if ($answer =~ m{\0}) {
                   5158:                 $answer =~ s{\0}{,}g;
1.988     raeburn  5159:             }
                   5160:             my $tag_internal_answer_name = 'INTERNAL';
                   5161:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   5162:                 $value = $answer; 
                   5163:             } else {
                   5164:                 $value = $anskeys[0].'='.$answer;
                   5165:             }
                   5166:         } else {
                   5167:             foreach my $ans (@anskeys) {
                   5168:                 my $answer = $answers{$ans};
1.1001    raeburn  5169:                 if ($answer =~ m{\0}) {
                   5170:                     $answer =~ s{\0}{,}g;
1.988     raeburn  5171:                 }
                   5172:                 $value .=  $ans.'='.$answer.'<br />';;
                   5173:             } 
                   5174:         }
1.581     albertel 5175:     } else {
1.1173    kruse    5176:         $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581     albertel 5177:     }
                   5178:     return $value;
                   5179: }
                   5180: 
                   5181: 
1.107     albertel 5182: sub relative_to_absolute {
                   5183:     my ($url,$output)=@_;
                   5184:     my $parser=HTML::TokeParser->new(\$output);
                   5185:     my $token;
                   5186:     my $thisdir=$url;
                   5187:     my @rlinks=();
                   5188:     while ($token=$parser->get_token) {
                   5189: 	if ($token->[0] eq 'S') {
                   5190: 	    if ($token->[1] eq 'a') {
                   5191: 		if ($token->[2]->{'href'}) {
                   5192: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   5193: 		}
                   5194: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   5195: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   5196: 	    } elsif ($token->[1] eq 'base') {
                   5197: 		$thisdir=$token->[2]->{'href'};
                   5198: 	    }
                   5199: 	}
                   5200:     }
                   5201:     $thisdir=~s-/[^/]*$--;
1.356     albertel 5202:     foreach my $link (@rlinks) {
1.726     raeburn  5203: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 5204: 		($link=~/^\//) ||
                   5205: 		($link=~/^javascript:/i) ||
                   5206: 		($link=~/^mailto:/i) ||
                   5207: 		($link=~/^\#/)) {
                   5208: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   5209: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 5210: 	}
                   5211:     }
                   5212: # -------------------------------------------------- Deal with Applet codebases
                   5213:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   5214:     return $output;
                   5215: }
                   5216: 
1.112     bowersj2 5217: =pod
                   5218: 
1.648     raeburn  5219: =item * &get_student_view()
1.112     bowersj2 5220: 
                   5221: show a snapshot of what student was looking at
                   5222: 
                   5223: =cut
                   5224: 
1.10      albertel 5225: sub get_student_view {
1.186     albertel 5226:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      5227:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 5228:   my (%form);
1.10      albertel 5229:   my @elements=('symb','courseid','domain','username');
                   5230:   foreach my $element (@elements) {
1.186     albertel 5231:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 5232:   }
1.186     albertel 5233:   if (defined($moreenv)) {
                   5234:       %form=(%form,%{$moreenv});
                   5235:   }
1.236     albertel 5236:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 5237:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.1306    raeburn  5238:   if (($feedurl =~ /ext\.tool$/) && ($target eq 'tex')) {
                   5239:       $feedurl =~ s{^/adm/wrapper}{};
                   5240:   }
1.650     www      5241:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 5242:   $userview=~s/\<body[^\>]*\>//gi;
                   5243:   $userview=~s/\<\/body\>//gi;
                   5244:   $userview=~s/\<html\>//gi;
                   5245:   $userview=~s/\<\/html\>//gi;
                   5246:   $userview=~s/\<head\>//gi;
                   5247:   $userview=~s/\<\/head\>//gi;
                   5248:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 5249:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      5250:   if (wantarray) {
                   5251:      return ($userview,$response);
                   5252:   } else {
                   5253:      return $userview;
                   5254:   }
                   5255: }
                   5256: 
                   5257: sub get_student_view_with_retries {
                   5258:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   5259: 
                   5260:     my $ok = 0;                 # True if we got a good response.
                   5261:     my $content;
                   5262:     my $response;
                   5263: 
                   5264:     # Try to get the student_view done. within the retries count:
                   5265:     
                   5266:     do {
                   5267:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   5268:          $ok      = $response->is_success;
                   5269:          if (!$ok) {
                   5270:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   5271:          }
                   5272:          $retries--;
                   5273:     } while (!$ok && ($retries > 0));
                   5274:     
                   5275:     if (!$ok) {
                   5276:        $content = '';          # On error return an empty content.
                   5277:     }
1.651     www      5278:     if (wantarray) {
                   5279:        return ($content, $response);
                   5280:     } else {
                   5281:        return $content;
                   5282:     }
1.11      albertel 5283: }
                   5284: 
1.1349    raeburn  5285: sub css_links {
                   5286:     my ($currsymb,$level) = @_;
                   5287:     my ($links,@symbs,%cssrefs,%httpref);
                   5288:     if ($level eq 'map') {
                   5289:         my $navmap = Apache::lonnavmaps::navmap->new();
                   5290:         if (ref($navmap)) {
                   5291:             my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
                   5292:             my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
                   5293:             foreach my $res (@resources) {
                   5294:                 if (ref($res) && $res->symb()) {
                   5295:                     push(@symbs,$res->symb());
                   5296:                 }
                   5297:             }
                   5298:         }
                   5299:     } else {
                   5300:         @symbs = ($currsymb);
                   5301:     }
                   5302:     foreach my $symb (@symbs) {
                   5303:         my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
                   5304:         if ($css_href =~ /\S/) {
                   5305:             unless ($css_href =~ m{https?://}) {
                   5306:                 my $url = (&Apache::lonnet::decode_symb($symb))[-1];
                   5307:                 my $proburl =  &Apache::lonnet::clutter($url);
                   5308:                 my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
                   5309:                 unless ($css_href =~ m{^/}) {
                   5310:                     $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
                   5311:                 }
                   5312:                 if ($css_href =~ m{^/(res|uploaded)/}) {
                   5313:                     unless (($httpref{'httpref.'.$css_href}) ||
                   5314:                             (&Apache::lonnet::is_on_map($css_href))) {
                   5315:                         my $thisurl = $proburl;
                   5316:                         if ($env{'httpref.'.$proburl}) {
                   5317:                             $thisurl = $env{'httpref.'.$proburl};
                   5318:                         }
                   5319:                         $httpref{'httpref.'.$css_href} = $thisurl;
                   5320:                     }
                   5321:                 }
                   5322:             }
                   5323:             $cssrefs{$css_href} = 1;
                   5324:         }
                   5325:     }
                   5326:     if (keys(%httpref)) {
                   5327:         &Apache::lonnet::appenv(\%httpref);
                   5328:     }
                   5329:     if (keys(%cssrefs)) {
                   5330:         foreach my $css_href (keys(%cssrefs)) {
                   5331:             next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});
                   5332:             $links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";
                   5333:         }
                   5334:     }
                   5335:     return $links;
                   5336: }
                   5337: 
1.112     bowersj2 5338: =pod
                   5339: 
1.648     raeburn  5340: =item * &get_student_answers() 
1.112     bowersj2 5341: 
                   5342: show a snapshot of how student was answering problem
                   5343: 
                   5344: =cut
                   5345: 
1.11      albertel 5346: sub get_student_answers {
1.100     sakharuk 5347:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      5348:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 5349:   my (%moreenv);
1.11      albertel 5350:   my @elements=('symb','courseid','domain','username');
                   5351:   foreach my $element (@elements) {
1.186     albertel 5352:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 5353:   }
1.186     albertel 5354:   $moreenv{'grade_target'}='answer';
                   5355:   %moreenv=(%form,%moreenv);
1.497     raeburn  5356:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   5357:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 5358:   return $userview;
1.1       albertel 5359: }
1.116     albertel 5360: 
                   5361: =pod
                   5362: 
                   5363: =item * &submlink()
                   5364: 
1.242     albertel 5365: Inputs: $text $uname $udom $symb $target
1.116     albertel 5366: 
                   5367: Returns: A link to grades.pm such as to see the SUBM view of a student
                   5368: 
                   5369: =cut
                   5370: 
                   5371: ###############################################
                   5372: sub submlink {
1.242     albertel 5373:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 5374:     if (!($uname && $udom)) {
                   5375: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 5376: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 5377: 	if (!$symb) { $symb=$cursymb; }
                   5378:     }
1.254     matthew  5379:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      5380:     $symb=&escape($symb);
1.960     bisitz   5381:     if ($target) { $target=" target=\"$target\""; }
                   5382:     return
                   5383:         '<a href="/adm/grades?command=submission'.
                   5384:         '&amp;symb='.$symb.
                   5385:         '&amp;student='.$uname.
                   5386:         '&amp;userdom='.$udom.'"'.
                   5387:         $target.'>'.$text.'</a>';
1.242     albertel 5388: }
                   5389: ##############################################
                   5390: 
                   5391: =pod
                   5392: 
                   5393: =item * &pgrdlink()
                   5394: 
                   5395: Inputs: $text $uname $udom $symb $target
                   5396: 
                   5397: Returns: A link to grades.pm such as to see the PGRD view of a student
                   5398: 
                   5399: =cut
                   5400: 
                   5401: ###############################################
                   5402: sub pgrdlink {
                   5403:     my $link=&submlink(@_);
                   5404:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   5405:     return $link;
                   5406: }
                   5407: ##############################################
                   5408: 
                   5409: =pod
                   5410: 
                   5411: =item * &pprmlink()
                   5412: 
                   5413: Inputs: $text $uname $udom $symb $target
                   5414: 
                   5415: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 5416: student and a specific resource
1.242     albertel 5417: 
                   5418: =cut
                   5419: 
                   5420: ###############################################
                   5421: sub pprmlink {
                   5422:     my ($text,$uname,$udom,$symb,$target)=@_;
                   5423:     if (!($uname && $udom)) {
                   5424: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 5425: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 5426: 	if (!$symb) { $symb=$cursymb; }
                   5427:     }
1.254     matthew  5428:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      5429:     $symb=&escape($symb);
1.242     albertel 5430:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 5431:     return '<a href="/adm/parmset?command=set&amp;'.
                   5432: 	'symb='.$symb.'&amp;uname='.$uname.
                   5433: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 5434: }
                   5435: ##############################################
1.37      matthew  5436: 
1.112     bowersj2 5437: =pod
                   5438: 
                   5439: =back
                   5440: 
                   5441: =cut
                   5442: 
1.37      matthew  5443: ###############################################
1.51      www      5444: 
                   5445: 
                   5446: sub timehash {
1.687     raeburn  5447:     my ($thistime) = @_;
                   5448:     my $timezone = &Apache::lonlocal::gettimezone();
                   5449:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   5450:                      ->set_time_zone($timezone);
                   5451:     my $wday = $dt->day_of_week();
                   5452:     if ($wday == 7) { $wday = 0; }
                   5453:     return ( 'second' => $dt->second(),
                   5454:              'minute' => $dt->minute(),
                   5455:              'hour'   => $dt->hour(),
                   5456:              'day'     => $dt->day_of_month(),
                   5457:              'month'   => $dt->month(),
                   5458:              'year'    => $dt->year(),
                   5459:              'weekday' => $wday,
                   5460:              'dayyear' => $dt->day_of_year(),
                   5461:              'dlsav'   => $dt->is_dst() );
1.51      www      5462: }
                   5463: 
1.370     www      5464: sub utc_string {
                   5465:     my ($date)=@_;
1.371     www      5466:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      5467: }
                   5468: 
1.51      www      5469: sub maketime {
                   5470:     my %th=@_;
1.687     raeburn  5471:     my ($epoch_time,$timezone,$dt);
                   5472:     $timezone = &Apache::lonlocal::gettimezone();
                   5473:     eval {
                   5474:         $dt = DateTime->new( year   => $th{'year'},
                   5475:                              month  => $th{'month'},
                   5476:                              day    => $th{'day'},
                   5477:                              hour   => $th{'hour'},
                   5478:                              minute => $th{'minute'},
                   5479:                              second => $th{'second'},
                   5480:                              time_zone => $timezone,
                   5481:                          );
                   5482:     };
                   5483:     if (!$@) {
                   5484:         $epoch_time = $dt->epoch;
                   5485:         if ($epoch_time) {
                   5486:             return $epoch_time;
                   5487:         }
                   5488:     }
1.51      www      5489:     return POSIX::mktime(
                   5490:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      5491:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      5492: }
                   5493: 
                   5494: #########################################
1.51      www      5495: 
                   5496: sub findallcourses {
1.482     raeburn  5497:     my ($roles,$uname,$udom) = @_;
1.355     albertel 5498:     my %roles;
                   5499:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 5500:     my %courses;
1.51      www      5501:     my $now=time;
1.482     raeburn  5502:     if (!defined($uname)) {
                   5503:         $uname = $env{'user.name'};
                   5504:     }
                   5505:     if (!defined($udom)) {
                   5506:         $udom = $env{'user.domain'};
                   5507:     }
                   5508:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  5509:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  5510:         if (!%roles) {
                   5511:             %roles = (
                   5512:                        cc => 1,
1.907     raeburn  5513:                        co => 1,
1.482     raeburn  5514:                        in => 1,
                   5515:                        ep => 1,
                   5516:                        ta => 1,
                   5517:                        cr => 1,
                   5518:                        st => 1,
                   5519:              );
                   5520:         }
                   5521:         foreach my $entry (keys(%roleshash)) {
                   5522:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   5523:             if ($trole =~ /^cr/) { 
                   5524:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   5525:             } else {
                   5526:                 next if (!exists($roles{$trole}));
                   5527:             }
                   5528:             if ($tend) {
                   5529:                 next if ($tend < $now);
                   5530:             }
                   5531:             if ($tstart) {
                   5532:                 next if ($tstart > $now);
                   5533:             }
1.1058    raeburn  5534:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  5535:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  5536:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  5537:             if ($secpart eq '') {
                   5538:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   5539:                 $sec = 'none';
1.1058    raeburn  5540:                 $value .= $cnum.'/';
1.482     raeburn  5541:             } else {
                   5542:                 $cnum = $cnumpart;
                   5543:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  5544:                 $value .= $cnum.'/'.$sec;
                   5545:             }
                   5546:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   5547:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   5548:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   5549:                 }
                   5550:             } else {
                   5551:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  5552:             }
1.482     raeburn  5553:         }
                   5554:     } else {
                   5555:         foreach my $key (keys(%env)) {
1.483     albertel 5556: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   5557:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  5558: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   5559: 	        next if ($role eq 'ca' || $role eq 'aa');
                   5560: 	        next if (%roles && !exists($roles{$role}));
                   5561: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   5562:                 my $active=1;
                   5563:                 if ($starttime) {
                   5564: 		    if ($now<$starttime) { $active=0; }
                   5565:                 }
                   5566:                 if ($endtime) {
                   5567:                     if ($now>$endtime) { $active=0; }
                   5568:                 }
                   5569:                 if ($active) {
1.1058    raeburn  5570:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  5571:                     if ($sec eq '') {
                   5572:                         $sec = 'none';
1.1058    raeburn  5573:                     } else {
                   5574:                         $value .= $sec;
                   5575:                     }
                   5576:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   5577:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   5578:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   5579:                         }
                   5580:                     } else {
                   5581:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  5582:                     }
1.474     raeburn  5583:                 }
                   5584:             }
1.51      www      5585:         }
                   5586:     }
1.474     raeburn  5587:     return %courses;
1.51      www      5588: }
1.37      matthew  5589: 
1.54      www      5590: ###############################################
1.474     raeburn  5591: 
                   5592: sub blockcheck {
1.1372    raeburn  5593:     my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
                   5594:     unless (($activity eq 'docs') || ($activity eq 'reinit') || ($activity eq 'alert')) {
                   5595:         my ($has_evb,$check_ipaccess);
                   5596:         my $dom = $env{'user.domain'};
                   5597:         if ($env{'request.course.id'}) {
                   5598:             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5599:             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5600:             my $checkrole = "cm./$cdom/$cnum";
                   5601:             my $sec = $env{'request.course.sec'};
                   5602:             if ($sec ne '') {
                   5603:                 $checkrole .= "/$sec";
                   5604:             }
                   5605:             if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   5606:                 ($env{'request.role'} !~ /^st/)) {
                   5607:                 $has_evb = 1;
                   5608:             }
                   5609:             unless ($has_evb) {
                   5610:                 if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||
                   5611:                     ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) {
                   5612:                     if ($udom eq $cdom) {
                   5613:                         $check_ipaccess = 1;
                   5614:                     }
                   5615:                 }
                   5616:             }
1.1375    raeburn  5617:         } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') ||
                   5618:                 ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) {
                   5619:             my $checkrole;
                   5620:             if ($env{'request.role.domain'} eq '') {
                   5621:                 $checkrole = "cm./$env{'user.domain'}/";
                   5622:             } else {
                   5623:                 $checkrole = "cm./$env{'request.role.domain'}/";
                   5624:             }
                   5625:             if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {
                   5626:                 $has_evb = 1;
                   5627:             }
1.1372    raeburn  5628:         }
                   5629:         unless ($has_evb || $check_ipaccess) {
                   5630:             my @machinedoms = &Apache::lonnet::current_machine_domains();
                   5631:             if (($dom eq 'public') && ($activity eq 'port')) {
                   5632:                 $dom = $udom;
                   5633:             }
                   5634:             if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
                   5635:                 $check_ipaccess = 1;
                   5636:             } else {
                   5637:                 my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   5638:                 my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
                   5639:                 my $prim = &Apache::lonnet::domain($dom,'primary');
                   5640:                 my $intdom = &Apache::lonnet::internet_dom($prim);
                   5641:                 if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
                   5642:                     if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
                   5643:                         $check_ipaccess = 1;
                   5644:                     }
                   5645:                 }
                   5646:             }
                   5647:         }
                   5648:         if ($check_ipaccess) {
                   5649:             my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
                   5650:             unless (defined($cached)) {
                   5651:                 my %domconfig =
                   5652:                     &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
                   5653:                 $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
                   5654:             }
                   5655:             if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
                   5656:                 foreach my $id (keys(%{$ipaccessref})) {
                   5657:                     if (ref($ipaccessref->{$id}) eq 'HASH') {
                   5658:                         my $range = $ipaccessref->{$id}->{'ip'};
                   5659:                         if ($range) {
                   5660:                             if (&Apache::lonnet::ip_match($clientip,$range)) {
                   5661:                                 if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
                   5662:                                     if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
                   5663:                                         return ('','','',$id,$dom);
                   5664:                                         last;
                   5665:                                     }
                   5666:                                 }
                   5667:                             }
                   5668:                         }
                   5669:                     }
                   5670:                 }
                   5671:             }
                   5672:         }
1.1373    raeburn  5673:         if (($activity eq 'wishlist') || ($activity eq 'annotate')) {
                   5674:             return ();
                   5675:         }
1.1372    raeburn  5676:     }
1.1189    raeburn  5677:     if (defined($udom) && defined($uname)) {
                   5678:         # If uname and udom are for a course, check for blocks in the course.
                   5679:         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
                   5680:             my ($startblock,$endblock,$triggerblock) =
1.1347    raeburn  5681:                 &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
1.1189    raeburn  5682:             return ($startblock,$endblock,$triggerblock);
                   5683:         }
                   5684:     } else {
1.490     raeburn  5685:         $udom = $env{'user.domain'};
                   5686:         $uname = $env{'user.name'};
                   5687:     }
                   5688: 
1.502     raeburn  5689:     my $startblock = 0;
                   5690:     my $endblock = 0;
1.1062    raeburn  5691:     my $triggerblock = '';
1.1373    raeburn  5692:     my %live_courses;
                   5693:     unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {
                   5694:         %live_courses = &findallcourses(undef,$uname,$udom);
                   5695:     }
1.474     raeburn  5696: 
1.490     raeburn  5697:     # If uname is for a user, and activity is course-specific, i.e.,
                   5698:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  5699: 
1.490     raeburn  5700:     if (($activity eq 'boards' || $activity eq 'chat' ||
1.1282    raeburn  5701:          $activity eq 'groups' || $activity eq 'printout' ||
1.1346    raeburn  5702:          $activity eq 'search' || $activity eq 'reinit' ||
                   5703:          $activity eq 'alert') &&
1.1189    raeburn  5704:         ($env{'request.course.id'})) {
1.490     raeburn  5705:         foreach my $key (keys(%live_courses)) {
                   5706:             if ($key ne $env{'request.course.id'}) {
                   5707:                 delete($live_courses{$key});
                   5708:             }
                   5709:         }
                   5710:     }
                   5711: 
                   5712:     my $otheruser = 0;
                   5713:     my %own_courses;
                   5714:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   5715:         # Resource belongs to user other than current user.
                   5716:         $otheruser = 1;
                   5717:         # Gather courses for current user
                   5718:         %own_courses = 
                   5719:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   5720:     }
                   5721: 
                   5722:     # Gather active course roles - course coordinator, instructor, 
                   5723:     # exam proctor, ta, student, or custom role.
1.474     raeburn  5724: 
                   5725:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  5726:         my ($cdom,$cnum);
                   5727:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   5728:             $cdom = $env{'course.'.$course.'.domain'};
                   5729:             $cnum = $env{'course.'.$course.'.num'};
                   5730:         } else {
1.490     raeburn  5731:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  5732:         }
                   5733:         my $no_ownblock = 0;
                   5734:         my $no_userblock = 0;
1.533     raeburn  5735:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  5736:             # Check if current user has 'evb' priv for this
                   5737:             if (defined($own_courses{$course})) {
                   5738:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   5739:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   5740:                     if ($sec ne 'none') {
                   5741:                         $checkrole .= '/'.$sec;
                   5742:                     }
                   5743:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   5744:                         $no_ownblock = 1;
                   5745:                         last;
                   5746:                     }
                   5747:                 }
                   5748:             }
                   5749:             # if they have 'evb' priv and are currently not playing student
                   5750:             next if (($no_ownblock) &&
                   5751:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   5752:         }
1.474     raeburn  5753:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  5754:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  5755:             if ($sec ne 'none') {
1.482     raeburn  5756:                 $checkrole .= '/'.$sec;
1.474     raeburn  5757:             }
1.490     raeburn  5758:             if ($otheruser) {
                   5759:                 # Resource belongs to user other than current user.
                   5760:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  5761:                 my (%allroles,%userroles);
                   5762:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   5763:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   5764:                         my ($trole,$tdom,$tnum,$tsec);
                   5765:                         if ($entry =~ /^cr/) {
                   5766:                             ($trole,$tdom,$tnum,$tsec) = 
                   5767:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   5768:                         } else {
                   5769:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   5770:                         }
                   5771:                         my ($spec,$area,$trest);
                   5772:                         $area = '/'.$tdom.'/'.$tnum;
                   5773:                         $trest = $tnum;
                   5774:                         if ($tsec ne '') {
                   5775:                             $area .= '/'.$tsec;
                   5776:                             $trest .= '/'.$tsec;
                   5777:                         }
                   5778:                         $spec = $trole.'.'.$area;
                   5779:                         if ($trole =~ /^cr/) {
                   5780:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   5781:                                                               $tdom,$spec,$trest,$area);
                   5782:                         } else {
                   5783:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   5784:                                                                 $tdom,$spec,$trest,$area);
                   5785:                         }
                   5786:                     }
1.1276    raeburn  5787:                     my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058    raeburn  5788:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   5789:                         if ($1) {
                   5790:                             $no_userblock = 1;
                   5791:                             last;
                   5792:                         }
1.486     raeburn  5793:                     }
                   5794:                 }
1.490     raeburn  5795:             } else {
                   5796:                 # Resource belongs to current user
                   5797:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  5798:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   5799:                     $no_ownblock = 1;
                   5800:                     last;
                   5801:                 }
1.474     raeburn  5802:             }
                   5803:         }
                   5804:         # if they have the evb priv and are currently not playing student
1.482     raeburn  5805:         next if (($no_ownblock) &&
1.491     albertel 5806:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  5807:         next if ($no_userblock);
1.474     raeburn  5808: 
1.1303    raeburn  5809:         # Retrieve blocking times and identity of blocker for course
1.490     raeburn  5810:         # of specified user, unless user has 'evb' privilege.
1.1284    raeburn  5811: 
1.1062    raeburn  5812:         my ($start,$end,$trigger) = 
1.1347    raeburn  5813:             &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
1.502     raeburn  5814:         if (($start != 0) && 
                   5815:             (($startblock == 0) || ($startblock > $start))) {
                   5816:             $startblock = $start;
1.1062    raeburn  5817:             if ($trigger ne '') {
                   5818:                 $triggerblock = $trigger;
                   5819:             }
1.502     raeburn  5820:         }
                   5821:         if (($end != 0)  &&
                   5822:             (($endblock == 0) || ($endblock < $end))) {
                   5823:             $endblock = $end;
1.1062    raeburn  5824:             if ($trigger ne '') {
                   5825:                 $triggerblock = $trigger;
                   5826:             }
1.502     raeburn  5827:         }
1.490     raeburn  5828:     }
1.1062    raeburn  5829:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  5830: }
                   5831: 
                   5832: sub get_blocks {
1.1347    raeburn  5833:     my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
1.490     raeburn  5834:     my $startblock = 0;
                   5835:     my $endblock = 0;
1.1062    raeburn  5836:     my $triggerblock = '';
1.490     raeburn  5837:     my $course = $cdom.'_'.$cnum;
                   5838:     $setters->{$course} = {};
                   5839:     $setters->{$course}{'staff'} = [];
                   5840:     $setters->{$course}{'times'} = [];
1.1062    raeburn  5841:     $setters->{$course}{'triggers'} = [];
                   5842:     my (@blockers,%triggered);
                   5843:     my $now = time;
                   5844:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   5845:     if ($activity eq 'docs') {
1.1348    raeburn  5846:         my ($blocked,$nosymbcache,$noenccheck);
1.1347    raeburn  5847:         if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
                   5848:             $blocked = 1;
                   5849:             $nosymbcache = 1;
1.1348    raeburn  5850:             $noenccheck = 1;
1.1347    raeburn  5851:         }
1.1348    raeburn  5852:         @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
1.1062    raeburn  5853:         foreach my $block (@blockers) {
                   5854:             if ($block =~ /^firstaccess____(.+)$/) {
                   5855:                 my $item = $1;
                   5856:                 my $type = 'map';
                   5857:                 my $timersymb = $item;
                   5858:                 if ($item eq 'course') {
                   5859:                     $type = 'course';
                   5860:                 } elsif ($item =~ /___\d+___/) {
                   5861:                     $type = 'resource';
                   5862:                 } else {
                   5863:                     $timersymb = &Apache::lonnet::symbread($item);
                   5864:                 }
                   5865:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   5866:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   5867:                 $triggered{$block} = {
                   5868:                                        start => $start,
                   5869:                                        end   => $end,
                   5870:                                        type  => $type,
                   5871:                                      };
                   5872:             }
                   5873:         }
                   5874:     } else {
                   5875:         foreach my $block (keys(%commblocks)) {
                   5876:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   5877:                 my ($start,$end) = ($1,$2);
                   5878:                 if ($start <= time && $end >= time) {
                   5879:                     if (ref($commblocks{$block}) eq 'HASH') {
                   5880:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   5881:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   5882:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   5883:                                     push(@blockers,$block);
                   5884:                                 }
                   5885:                             }
                   5886:                         }
                   5887:                     }
                   5888:                 }
                   5889:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   5890:                 my $item = $1;
                   5891:                 my $timersymb = $item; 
                   5892:                 my $type = 'map';
                   5893:                 if ($item eq 'course') {
                   5894:                     $type = 'course';
                   5895:                 } elsif ($item =~ /___\d+___/) {
                   5896:                     $type = 'resource';
                   5897:                 } else {
                   5898:                     $timersymb = &Apache::lonnet::symbread($item);
                   5899:                 }
                   5900:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   5901:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   5902:                 if ($start && $end) {
                   5903:                     if (($start <= time) && ($end >= time)) {
1.1281    raeburn  5904:                         if (ref($commblocks{$block}) eq 'HASH') {
                   5905:                             if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   5906:                                 if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   5907:                                     unless(grep(/^\Q$block\E$/,@blockers)) {
                   5908:                                         push(@blockers,$block);
                   5909:                                         $triggered{$block} = {
                   5910:                                                                start => $start,
                   5911:                                                                end   => $end,
                   5912:                                                                type  => $type,
                   5913:                                                              };
                   5914:                                     }
                   5915:                                 }
                   5916:                             }
1.1062    raeburn  5917:                         }
                   5918:                     }
1.490     raeburn  5919:                 }
1.1062    raeburn  5920:             }
                   5921:         }
                   5922:     }
                   5923:     foreach my $blocker (@blockers) {
                   5924:         my ($staff_name,$staff_dom,$title,$blocks) =
                   5925:             &parse_block_record($commblocks{$blocker});
                   5926:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   5927:         my ($start,$end,$triggertype);
                   5928:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   5929:             ($start,$end) = ($1,$2);
                   5930:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   5931:             $start = $triggered{$blocker}{'start'};
                   5932:             $end = $triggered{$blocker}{'end'};
                   5933:             $triggertype = $triggered{$blocker}{'type'};
                   5934:         }
                   5935:         if ($start) {
                   5936:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   5937:             if ($triggertype) {
                   5938:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   5939:             } else {
                   5940:                 push(@{$$setters{$course}{'triggers'}},0);
                   5941:             }
                   5942:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   5943:                 $startblock = $start;
                   5944:                 if ($triggertype) {
                   5945:                     $triggerblock = $blocker;
1.474     raeburn  5946:                 }
                   5947:             }
1.1062    raeburn  5948:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   5949:                $endblock = $end;
                   5950:                if ($triggertype) {
                   5951:                    $triggerblock = $blocker;
                   5952:                }
                   5953:             }
1.474     raeburn  5954:         }
                   5955:     }
1.1062    raeburn  5956:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  5957: }
                   5958: 
                   5959: sub parse_block_record {
                   5960:     my ($record) = @_;
                   5961:     my ($setuname,$setudom,$title,$blocks);
                   5962:     if (ref($record) eq 'HASH') {
                   5963:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   5964:         $title = &unescape($record->{'event'});
                   5965:         $blocks = $record->{'blocks'};
                   5966:     } else {
                   5967:         my @data = split(/:/,$record,3);
                   5968:         if (scalar(@data) eq 2) {
                   5969:             $title = $data[1];
                   5970:             ($setuname,$setudom) = split(/@/,$data[0]);
                   5971:         } else {
                   5972:             ($setuname,$setudom,$title) = @data;
                   5973:         }
                   5974:         $blocks = { 'com' => 'on' };
                   5975:     }
                   5976:     return ($setuname,$setudom,$title,$blocks);
                   5977: }
                   5978: 
1.854     kalberla 5979: sub blocking_status {
1.1372    raeburn  5980:     my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
1.1061    raeburn  5981:     my %setters;
1.890     droeschl 5982: 
1.1061    raeburn  5983: # check for active blocking
1.1372    raeburn  5984:     if ($clientip eq '') {
                   5985:         $clientip = &Apache::lonnet::get_requestor_ip();
                   5986:     }
                   5987:     my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) = 
                   5988:         &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
1.1062    raeburn  5989:     my $blocked = 0;
1.1372    raeburn  5990:     if (($startblock && $endblock) || ($by_ip)) {
1.1062    raeburn  5991:         $blocked = 1;
                   5992:     }
1.890     droeschl 5993: 
1.1061    raeburn  5994: # caller just wants to know whether a block is active
                   5995:     if (!wantarray) { return $blocked; }
                   5996: 
                   5997: # build a link to a popup window containing the details
                   5998:     my $querystring  = "?activity=$activity";
1.1351    raeburn  5999: # $uname and $udom decide whose portfolio (or information page) the user is trying to look at
                   6000:     if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) {
1.1232    raeburn  6001:         $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/); 
                   6002:         $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);
1.1062    raeburn  6003:     } elsif ($activity eq 'docs') {
1.1347    raeburn  6004:         my $showurl = &Apache::lonenc::check_encrypt($url);
                   6005:         $querystring .= '&amp;url='.&HTML::Entities::encode($showurl,'\'&"<>');
                   6006:         if ($symb) {
                   6007:             my $showsymb = &Apache::lonenc::check_encrypt($symb);
                   6008:             $querystring .= '&amp;symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
                   6009:         }
1.1062    raeburn  6010:     }
1.1061    raeburn  6011: 
                   6012:     my $output .= <<'END_MYBLOCK';
                   6013: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   6014:     var options = "width=" + w + ",height=" + h + ",";
                   6015:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   6016:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   6017:     var newWin = window.open(url, wdwName, options);
                   6018:     newWin.focus();
                   6019: }
1.890     droeschl 6020: END_MYBLOCK
1.854     kalberla 6021: 
1.1061    raeburn  6022:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 6023:   
1.1061    raeburn  6024:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  6025:     my $text = &mt('Communication Blocked');
1.1217    raeburn  6026:     my $class = 'LC_comblock';
1.1062    raeburn  6027:     if ($activity eq 'docs') {
                   6028:         $text = &mt('Content Access Blocked');
1.1217    raeburn  6029:         $class = '';
1.1063    raeburn  6030:     } elsif ($activity eq 'printout') {
                   6031:         $text = &mt('Printing Blocked');
1.1232    raeburn  6032:     } elsif ($activity eq 'passwd') {
                   6033:         $text = &mt('Password Changing Blocked');
1.1345    raeburn  6034:     } elsif ($activity eq 'grades') {
                   6035:         $text = &mt('Gradebook Blocked');
1.1346    raeburn  6036:     } elsif ($activity eq 'search') {
                   6037:         $text = &mt('Search Blocked');
1.1282    raeburn  6038:     } elsif ($activity eq 'alert') {
                   6039:         $text = &mt('Checking Critical Messages Blocked');
                   6040:     } elsif ($activity eq 'reinit') {
                   6041:         $text = &mt('Checking Course Update Blocked');
1.1351    raeburn  6042:     } elsif ($activity eq 'about') {
                   6043:         $text = &mt('Access to User Information Pages Blocked');
1.1373    raeburn  6044:     } elsif ($activity eq 'wishlist') {
                   6045:         $text = &mt('Access to Stored Links Blocked');
                   6046:     } elsif ($activity eq 'annotate') {
                   6047:         $text = &mt('Access to Annotations Blocked');
1.1062    raeburn  6048:     }
1.1061    raeburn  6049:     $output .= <<"END_BLOCK";
1.1217    raeburn  6050: <div class='$class'>
1.869     kalberla 6051:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 6052:   title='$text'>
                   6053:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 6054:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 6055:   title='$text'>$text</a>
1.867     kalberla 6056: </div>
                   6057: 
                   6058: END_BLOCK
1.474     raeburn  6059: 
1.1061    raeburn  6060:     return ($blocked, $output);
1.854     kalberla 6061: }
1.490     raeburn  6062: 
1.60      matthew  6063: ###############################################
                   6064: 
1.682     raeburn  6065: sub check_ip_acc {
1.1201    raeburn  6066:     my ($acc,$clientip)=@_;
1.682     raeburn  6067:     &Apache::lonxml::debug("acc is $acc");
                   6068:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   6069:         return 1;
                   6070:     }
1.1339    raeburn  6071:     my ($ip,$allowed);
                   6072:     if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
                   6073:         ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
                   6074:         $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
                   6075:     } else {
1.1350    raeburn  6076:         my $remote_ip = &Apache::lonnet::get_requestor_ip();
                   6077:         $ip = $remote_ip || $env{'request.host'} || $clientip;
1.1339    raeburn  6078:     }
1.682     raeburn  6079: 
                   6080:     my $name;
1.1219    raeburn  6081:     my %access = (
                   6082:                      allowfrom => 1,
                   6083:                      denyfrom  => 0,
                   6084:                  );
                   6085:     my @allows;
                   6086:     my @denies;
                   6087:     foreach my $item (split(',',$acc)) {
                   6088:         $item =~ s/^\s*//;
                   6089:         $item =~ s/\s*$//;
                   6090:         my $pattern;
                   6091:         if ($item =~ /^\!(.+)$/) {
                   6092:             push(@denies,$1);
                   6093:         } else {
                   6094:             push(@allows,$item);
                   6095:         }
                   6096:    }
                   6097:    my $numdenies = scalar(@denies);
                   6098:    my $numallows = scalar(@allows);
                   6099:    my $count = 0;
                   6100:    foreach my $pattern (@denies,@allows) {
                   6101:         $count ++; 
                   6102:         my $acctype = 'allowfrom';
                   6103:         if ($count <= $numdenies) {
                   6104:             $acctype = 'denyfrom';
                   6105:         }
1.682     raeburn  6106:         if ($pattern =~ /\*$/) {
                   6107:             #35.8.*
                   6108:             $pattern=~s/\*//;
1.1219    raeburn  6109:             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682     raeburn  6110:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   6111:             #35.8.3.[34-56]
                   6112:             my $low=$2;
                   6113:             my $high=$3;
                   6114:             $pattern=$1;
                   6115:             if ($ip =~ /^\Q$pattern\E/) {
                   6116:                 my $last=(split(/\./,$ip))[3];
1.1219    raeburn  6117:                 if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682     raeburn  6118:             }
                   6119:         } elsif ($pattern =~ /^\*/) {
                   6120:             #*.msu.edu
                   6121:             $pattern=~s/\*//;
                   6122:             if (!defined($name)) {
                   6123:                 use Socket;
                   6124:                 my $netaddr=inet_aton($ip);
                   6125:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   6126:             }
1.1219    raeburn  6127:             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682     raeburn  6128:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   6129:             #127.0.0.1
1.1219    raeburn  6130:             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682     raeburn  6131:         } else {
                   6132:             #some.name.com
                   6133:             if (!defined($name)) {
                   6134:                 use Socket;
                   6135:                 my $netaddr=inet_aton($ip);
                   6136:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   6137:             }
1.1219    raeburn  6138:             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
                   6139:         }
                   6140:         if ($allowed =~ /^(0|1)$/) { last; }
                   6141:     }
                   6142:     if ($allowed eq '') {
                   6143:         if ($numdenies && !$numallows) {
                   6144:             $allowed = 1;
                   6145:         } else {
                   6146:             $allowed = 0;
1.682     raeburn  6147:         }
                   6148:     }
                   6149:     return $allowed;
                   6150: }
                   6151: 
                   6152: ###############################################
                   6153: 
1.60      matthew  6154: =pod
                   6155: 
1.112     bowersj2 6156: =head1 Domain Template Functions
                   6157: 
                   6158: =over 4
                   6159: 
                   6160: =item * &determinedomain()
1.60      matthew  6161: 
                   6162: Inputs: $domain (usually will be undef)
                   6163: 
1.63      www      6164: Returns: Determines which domain should be used for designs
1.60      matthew  6165: 
                   6166: =cut
1.54      www      6167: 
1.60      matthew  6168: ###############################################
1.63      www      6169: sub determinedomain {
                   6170:     my $domain=shift;
1.531     albertel 6171:     if (! $domain) {
1.60      matthew  6172:         # Determine domain if we have not been given one
1.893     raeburn  6173:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 6174:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   6175:         if ($env{'request.role.domain'}) { 
                   6176:             $domain=$env{'request.role.domain'}; 
1.60      matthew  6177:         }
                   6178:     }
1.63      www      6179:     return $domain;
                   6180: }
                   6181: ###############################################
1.517     raeburn  6182: 
1.518     albertel 6183: sub devalidate_domconfig_cache {
                   6184:     my ($udom)=@_;
                   6185:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   6186: }
                   6187: 
                   6188: # ---------------------- Get domain configuration for a domain
                   6189: sub get_domainconf {
                   6190:     my ($udom) = @_;
                   6191:     my $cachetime=1800;
                   6192:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   6193:     if (defined($cached)) { return %{$result}; }
                   6194: 
                   6195:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  6196: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  6197:     my (%designhash,%legacy);
1.518     albertel 6198:     if (keys(%domconfig) > 0) {
                   6199:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  6200:             if (keys(%{$domconfig{'login'}})) {
                   6201:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  6202:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208    raeburn  6203:                         if (($key eq 'loginvia') || ($key eq 'headtag')) {
                   6204:                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                   6205:                                 foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
                   6206:                                     if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
                   6207:                                         if ($key eq 'loginvia') {
                   6208:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   6209:                                                 my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   6210:                                                 $designhash{$udom.'.login.loginvia'} = $server;
                   6211:                                                 if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   6212: 
                   6213:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   6214:                                                 } else {
                   6215:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
                   6216:                                                 }
1.948     raeburn  6217:                                             }
1.1208    raeburn  6218:                                         } elsif ($key eq 'headtag') {
                   6219:                                             if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
                   6220:                                                 $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948     raeburn  6221:                                             }
1.946     raeburn  6222:                                         }
1.1208    raeburn  6223:                                         if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
                   6224:                                             $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
                   6225:                                         }
1.946     raeburn  6226:                                     }
                   6227:                                 }
                   6228:                             }
1.1366    raeburn  6229:                         } elsif ($key eq 'saml') {
                   6230:                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                   6231:                                 foreach my $host (keys(%{$domconfig{'login'}{$key}})) {
                   6232:                                     if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {
                   6233:                                         $designhash{$udom.'.login.'.$key.'_'.$host} = 1;
1.1386    raeburn  6234:                                         foreach my $item ('text','img','alt','url','title','window','notsso') {
1.1366    raeburn  6235:                                             $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};
                   6236:                                         }
                   6237:                                     }
                   6238:                                 }
                   6239:                             }
1.946     raeburn  6240:                         } else {
                   6241:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   6242:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   6243:                                     $domconfig{'login'}{$key}{$img};
                   6244:                             }
1.699     raeburn  6245:                         }
                   6246:                     } else {
                   6247:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   6248:                     }
1.632     raeburn  6249:                 }
                   6250:             } else {
                   6251:                 $legacy{'login'} = 1;
1.518     albertel 6252:             }
1.632     raeburn  6253:         } else {
                   6254:             $legacy{'login'} = 1;
1.518     albertel 6255:         }
                   6256:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  6257:             if (keys(%{$domconfig{'rolecolors'}})) {
                   6258:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   6259:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   6260:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   6261:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   6262:                         }
1.518     albertel 6263:                     }
                   6264:                 }
1.632     raeburn  6265:             } else {
                   6266:                 $legacy{'rolecolors'} = 1;
1.518     albertel 6267:             }
1.632     raeburn  6268:         } else {
                   6269:             $legacy{'rolecolors'} = 1;
1.518     albertel 6270:         }
1.948     raeburn  6271:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   6272:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   6273:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   6274:             }
                   6275:         }
1.632     raeburn  6276:         if (keys(%legacy) > 0) {
                   6277:             my %legacyhash = &get_legacy_domconf($udom);
                   6278:             foreach my $item (keys(%legacyhash)) {
                   6279:                 if ($item =~ /^\Q$udom\E\.login/) {
                   6280:                     if ($legacy{'login'}) { 
                   6281:                         $designhash{$item} = $legacyhash{$item};
                   6282:                     }
                   6283:                 } else {
                   6284:                     if ($legacy{'rolecolors'}) {
                   6285:                         $designhash{$item} = $legacyhash{$item};
                   6286:                     }
1.518     albertel 6287:                 }
                   6288:             }
                   6289:         }
1.632     raeburn  6290:     } else {
                   6291:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 6292:     }
                   6293:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   6294: 				  $cachetime);
                   6295:     return %designhash;
                   6296: }
                   6297: 
1.632     raeburn  6298: sub get_legacy_domconf {
                   6299:     my ($udom) = @_;
                   6300:     my %legacyhash;
                   6301:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   6302:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   6303:     if (-e $designfile) {
1.1317    raeburn  6304:         if ( open (my $fh,'<',$designfile) ) {
1.632     raeburn  6305:             while (my $line = <$fh>) {
                   6306:                 next if ($line =~ /^\#/);
                   6307:                 chomp($line);
                   6308:                 my ($key,$val)=(split(/\=/,$line));
                   6309:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   6310:             }
                   6311:             close($fh);
                   6312:         }
                   6313:     }
1.1026    raeburn  6314:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  6315:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   6316:     }
                   6317:     return %legacyhash;
                   6318: }
                   6319: 
1.63      www      6320: =pod
                   6321: 
1.112     bowersj2 6322: =item * &domainlogo()
1.63      www      6323: 
                   6324: Inputs: $domain (usually will be undef)
                   6325: 
                   6326: Returns: A link to a domain logo, if the domain logo exists.
                   6327: If the domain logo does not exist, a description of the domain.
                   6328: 
                   6329: =cut
1.112     bowersj2 6330: 
1.63      www      6331: ###############################################
                   6332: sub domainlogo {
1.517     raeburn  6333:     my $domain = &determinedomain(shift);
1.518     albertel 6334:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  6335:     # See if there is a logo
                   6336:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  6337:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 6338:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   6339: 	    if ($imgsrc =~ m{^/res/}) {
                   6340: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   6341: 		&Apache::lonnet::repcopy($local_name);
                   6342: 	    }
                   6343: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.1374    raeburn  6344:         }
                   6345:         my $alttext = $domain;
                   6346:         if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {
                   6347:             $alttext = $designhash{$domain.'.login.alttext_domlogo'};
                   6348:         }
                   6349:         return '<img src="'.$imgsrc.'" alt="'.$alttext.'" id="lclogindomlogo" />';
1.514     albertel 6350:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   6351:         return &Apache::lonnet::domain($domain,'description');
1.59      www      6352:     } else {
1.60      matthew  6353:         return '';
1.59      www      6354:     }
                   6355: }
1.63      www      6356: ##############################################
                   6357: 
                   6358: =pod
                   6359: 
1.112     bowersj2 6360: =item * &designparm()
1.63      www      6361: 
                   6362: Inputs: $which parameter; $domain (usually will be undef)
                   6363: 
                   6364: Returns: value of designparamter $which
                   6365: 
                   6366: =cut
1.112     bowersj2 6367: 
1.397     albertel 6368: 
1.400     albertel 6369: ##############################################
1.397     albertel 6370: sub designparm {
                   6371:     my ($which,$domain)=@_;
                   6372:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   6373:         return $env{'environment.color.'.$which};
1.96      www      6374:     }
1.63      www      6375:     $domain=&determinedomain($domain);
1.1016    raeburn  6376:     my %domdesign;
                   6377:     unless ($domain eq 'public') {
                   6378:         %domdesign = &get_domainconf($domain);
                   6379:     }
1.520     raeburn  6380:     my $output;
1.517     raeburn  6381:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   6382:         $output = $domdesign{$domain.'.'.$which};
1.63      www      6383:     } else {
1.520     raeburn  6384:         $output = $defaultdesign{$which};
                   6385:     }
                   6386:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  6387:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 6388:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   6389:             if ($output =~ m{^/res/}) {
                   6390:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   6391:                 &Apache::lonnet::repcopy($local_name);
                   6392:             }
1.520     raeburn  6393:             $output = &lonhttpdurl($output);
                   6394:         }
1.63      www      6395:     }
1.520     raeburn  6396:     return $output;
1.63      www      6397: }
1.59      www      6398: 
1.822     bisitz   6399: ##############################################
                   6400: =pod
                   6401: 
1.832     bisitz   6402: =item * &authorspace()
                   6403: 
1.1028    raeburn  6404: Inputs: $url (usually will be undef).
1.832     bisitz   6405: 
1.1132    raeburn  6406: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  6407:          directory being viewed (or for which action is being taken). 
                   6408:          If $url is provided, and begins /priv/<domain>/<uname>
                   6409:          the path will be that portion of the $context argument.
                   6410:          Otherwise the path will be for the author space of the current
                   6411:          user when the current role is author, or for that of the 
                   6412:          co-author/assistant co-author space when the current role 
                   6413:          is co-author or assistant co-author.
1.832     bisitz   6414: 
                   6415: =cut
                   6416: 
                   6417: sub authorspace {
1.1028    raeburn  6418:     my ($url) = @_;
                   6419:     if ($url ne '') {
                   6420:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   6421:            return $1;
                   6422:         }
                   6423:     }
1.832     bisitz   6424:     my $caname = '';
1.1024    www      6425:     my $cadom = '';
1.1028    raeburn  6426:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      6427:         ($cadom,$caname) =
1.832     bisitz   6428:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  6429:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   6430:         $caname = $env{'user.name'};
1.1024    www      6431:         $cadom = $env{'user.domain'};
1.832     bisitz   6432:     }
1.1028    raeburn  6433:     if (($caname ne '') && ($cadom ne '')) {
                   6434:         return "/priv/$cadom/$caname/";
                   6435:     }
                   6436:     return;
1.832     bisitz   6437: }
                   6438: 
                   6439: ##############################################
                   6440: =pod
                   6441: 
1.822     bisitz   6442: =item * &head_subbox()
                   6443: 
                   6444: Inputs: $content (contains HTML code with page functions, etc.)
                   6445: 
                   6446: Returns: HTML div with $content
                   6447:          To be included in page header
                   6448: 
                   6449: =cut
                   6450: 
                   6451: sub head_subbox {
                   6452:     my ($content)=@_;
                   6453:     my $output =
1.993     raeburn  6454:         '<div class="LC_head_subbox">'
1.822     bisitz   6455:        .$content
                   6456:        .'</div>'
                   6457: }
                   6458: 
                   6459: ##############################################
                   6460: =pod
                   6461: 
                   6462: =item * &CSTR_pageheader()
                   6463: 
1.1026    raeburn  6464: Input: (optional) filename from which breadcrumb trail is built.
                   6465:        In most cases no input as needed, as $env{'request.filename'}
                   6466:        is appropriate for use in building the breadcrumb trail.
1.1379    raeburn  6467:        frameset flag
                   6468:        If page header is being requested for use in a frameset, then
                   6469:        the second (option) argument -- frameset will be true, and
                   6470:        the target attribute set for links should be target="_parent".
1.1407    raeburn  6471:        If $title is supplied as the thitd arg, that will be used to 
                   6472:        the left of the breadcrumbs tail for the current path.
1.822     bisitz   6473: 
                   6474: Returns: HTML div with CSTR path and recent box
1.1132    raeburn  6475:          To be included on Authoring Space pages
1.822     bisitz   6476: 
                   6477: =cut
                   6478: 
                   6479: sub CSTR_pageheader {
1.1407    raeburn  6480:     my ($trailfile,$frameset,$title) = @_;
1.1026    raeburn  6481:     if ($trailfile eq '') {
                   6482:         $trailfile = $env{'request.filename'};
                   6483:     }
                   6484: 
                   6485: # this is for resources; directories have customtitle, and crumbs
                   6486: # and select recent are created in lonpubdir.pm
                   6487: 
                   6488:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      6489:     my ($udom,$uname,$thisdisfn)=
1.1113    raeburn  6490:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  6491:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   6492:     $formaction =~ s{/+}{/}g;
1.822     bisitz   6493: 
                   6494:     my $parentpath = '';
                   6495:     my $lastitem = '';
                   6496:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   6497:         $parentpath = $1;
                   6498:         $lastitem = $2;
                   6499:     } else {
                   6500:         $lastitem = $thisdisfn;
                   6501:     }
1.921     bisitz   6502: 
1.1406    raeburn  6503:     my $crsauthor;
1.1246    raeburn  6504:     if (($env{'request.course.id'}) &&
                   6505:         ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
1.1247    raeburn  6506:         ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
1.1246    raeburn  6507:         $crsauthor = 1;
1.1406    raeburn  6508:         if ($title eq '') {
                   6509:             $title = &mt('Course Authoring Space');
                   6510:         }
                   6511:     } elsif ($title eq '') {
1.1246    raeburn  6512:         $title = &mt('Authoring Space');
                   6513:     }
                   6514: 
1.1379    raeburn  6515:     my ($target,$crumbtarget) = (' target="_top"','_top');
                   6516:     if ($frameset) {
                   6517:         $target = ' target="_parent"';
                   6518:         $crumbtarget = '_parent';
                   6519:     } elsif (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
1.1314    raeburn  6520:         $target = '';
                   6521:         $crumbtarget = '';
1.1379    raeburn  6522:     } elsif (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'})) {
1.1378    raeburn  6523:         $target = ' target="'.$env{'request.deeplink.target'}.'"';
                   6524:         $crumbtarget = $env{'request.deeplink.target'};
                   6525:     }
1.1313    raeburn  6526: 
1.921     bisitz   6527:     my $output =
1.1407    raeburn  6528:          '<div>'
1.822     bisitz   6529:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1246    raeburn  6530:         .'<b>'.$title.'</b> '
1.1314    raeburn  6531:         .'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
                   6532:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
1.921     bisitz   6533: 
                   6534:     if ($lastitem) {
                   6535:         $output .=
                   6536:              '<span class="LC_filename">'
                   6537:             .$lastitem
                   6538:             .'</span>';
                   6539:     }
1.1245    raeburn  6540: 
1.1246    raeburn  6541:     if ($crsauthor) {
1.1379    raeburn  6542:         $output .= '</form>'.&Apache::lonmenu::constspaceform($frameset);
1.1246    raeburn  6543:     } else {
                   6544:         $output .=
                   6545:              '<br />'
1.1314    raeburn  6546:             #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"
1.1246    raeburn  6547:             .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   6548:             .'</form>'
1.1379    raeburn  6549:             .&Apache::lonmenu::constspaceform($frameset);
1.1246    raeburn  6550:     }
1.1407    raeburn  6551:     $output .= '</div>';
1.921     bisitz   6552: 
                   6553:     return $output;
1.822     bisitz   6554: }
                   6555: 
1.1419    raeburn  6556: ##############################################
                   6557: =pod
                   6558: 
                   6559: =item * &nocodemirror()
                   6560: 
                   6561: Input: None
                   6562: 
                   6563: Returns: 1 if CodeMirror is deactivated based on
                   6564:          user's preference, or domain default,
                   6565:          if user indicated use of default.
                   6566: 
                   6567: =cut
                   6568: 
1.1416    raeburn  6569: sub nocodemirror {
                   6570:     my $nocodem = $env{'environment.nocodemirror'};
                   6571:     unless ($nocodem) {
                   6572:         my %domdefs = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
                   6573:         if ($domdefs{'nocodemirror'}) {
                   6574:             $nocodem = 'yes';
                   6575:         }
                   6576:     }
1.1417    raeburn  6577:     if ($nocodem eq 'yes') {
                   6578:         return 1;
                   6579:     }
                   6580:     return;
1.1416    raeburn  6581: }
                   6582: 
1.1419    raeburn  6583: ##############################################
                   6584: =pod
                   6585: 
                   6586: =item * &permitted_editors()
                   6587: 
                   6588: Input: None
                   6589: 
                   6590: Returns: %editors hash in which keys are editors
                   6591:          permitted in current Authoring Space.
                   6592:          Value for each key is 1. Possible keys
                   6593:          are: edit, xml, and daxe. If no specific
                   6594:          set of editors has been set for the Author
                   6595:          who owns the Authoring Space, then the
                   6596:          domain default will be used.  If no domain
                   6597:          default has been set, then the keys will be
                   6598:          edit and xml.
                   6599: 
                   6600: =cut
                   6601: 
1.1418    raeburn  6602: sub permitted_editors {
                   6603:     my ($is_author,$is_coauthor,$auname,$audom,%editors);
                   6604:     if ($env{'request.role'} =~ m{^au\./}) {
                   6605:         $is_author = 1;
                   6606:     } elsif ($env{'request.role'} =~ m{^(?:ca|aa)\./($match_domain)/($match_username)}) {
                   6607:         ($audom,$auname) = ($1,$2);
                   6608:         if (($audom ne '') && ($auname ne '')) {
                   6609:             if (($env{'user.domain'} eq $audom) &&
                   6610:                 ($env{'user.name'} eq $auname)) {
                   6611:                 $is_author = 1;
                   6612:             } else {
                   6613:                 $is_coauthor = 1;
                   6614:             }
                   6615:         }
                   6616:     } elsif ($env{'request.course.id'}) {
                   6617:         if ($env{'request.editurl'} =~ m{^/priv/($match_domain)/($match_username)/}) {
                   6618:             ($audom,$auname) = ($1,$2);
                   6619:         } elsif ($env{'request.uri'} =~ m{^/priv/($match_domain)/($match_username)/}) {
                   6620:             ($audom,$auname) = ($1,$2);
                   6621:         }
                   6622:         if (($audom ne '') && ($auname ne '')) {
                   6623:             if (($env{'user.domain'} eq $audom) &&
                   6624:                 ($env{'user.name'} eq $auname)) {
                   6625:                 $is_author = 1;
                   6626:             } else {
                   6627:                 $is_coauthor = 1;
                   6628:             }
                   6629:         }
                   6630:     }
                   6631:     if ($is_author) {
                   6632:         if (exists($env{'environment.editors'})) {
                   6633:             map { $editors{$_} = 1; } split(/,/,$env{'environment.editors'});
                   6634:         } else {
                   6635:             %editors = ( edit => 1,
                   6636:                          xml => 1,
                   6637:                        );
                   6638:         }
                   6639:     } elsif ($is_coauthor) {
                   6640:         if (exists($env{"environment.internal.editors./$audom/$auname"})) {
                   6641:             map { $editors{$_} = 1; } split(/,/,$env{"environment.internal.editors./$audom/$auname"});
                   6642:         } else {
                   6643:             %editors = ( edit => 1,
                   6644:                          xml => 1,
                   6645:                        );
                   6646:         }
                   6647:     } else {
                   6648:         %editors = ( edit => 1,
                   6649:                      xml => 1,
                   6650:                    );
                   6651:     }
                   6652:     return %editors;
                   6653: }
                   6654: 
1.60      matthew  6655: ###############################################
                   6656: ###############################################
                   6657: 
                   6658: =pod
                   6659: 
1.112     bowersj2 6660: =back
                   6661: 
1.549     albertel 6662: =head1 HTML Helpers
1.112     bowersj2 6663: 
                   6664: =over 4
                   6665: 
                   6666: =item * &bodytag()
1.60      matthew  6667: 
                   6668: Returns a uniform header for LON-CAPA web pages.
                   6669: 
                   6670: Inputs: 
                   6671: 
1.112     bowersj2 6672: =over 4
                   6673: 
                   6674: =item * $title, A title to be displayed on the page.
                   6675: 
                   6676: =item * $function, the current role (can be undef).
                   6677: 
                   6678: =item * $addentries, extra parameters for the <body> tag.
                   6679: 
                   6680: =item * $bodyonly, if defined, only return the <body> tag.
                   6681: 
                   6682: =item * $domain, if defined, force a given domain.
                   6683: 
                   6684: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      6685:             text interface only)
1.60      matthew  6686: 
1.814     bisitz   6687: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   6688:                      navigational links
1.317     albertel 6689: 
1.338     albertel 6690: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   6691: 
1.460     albertel 6692: =item * $args, optional argument valid values are
                   6693:             no_auto_mt_title -> prevents &mt()ing the title arg
1.1274    raeburn  6694:             use_absolute     -> for external resource or syllabus, this will
                   6695:                                 contain https://<hostname> if server uses
                   6696:                                 https (as per hosts.tab), but request is for http
                   6697:             hostname         -> hostname, from $r->hostname().
1.460     albertel 6698: 
1.1096    raeburn  6699: =item * $advtoolsref, optional argument, ref to an array containing
                   6700:             inlineremote items to be added in "Functions" menu below
                   6701:             breadcrumbs.
                   6702: 
1.1316    raeburn  6703: =item * $ltiscope, optional argument, will be one of: resource, map or
                   6704:             course, if LON-CAPA is in LTI Provider context. Value is
                   6705:             the scope of use, i.e., launch was for access to a single, a map
                   6706:             or the entire course.
                   6707: 
                   6708: =item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider
                   6709:             context, this will contain the URL for the landing item in
                   6710:             the course, after launch from an LTI Consumer
                   6711: 
1.1318    raeburn  6712: =item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
                   6713:             context, this will contain a reference to hash of items
                   6714:             to be included in the page header and/or inline menu.
                   6715: 
1.1385    raeburn  6716: =item * $menucoll, optional argument, if specific menu collection is in
                   6717:             effect, either set as the default for the course, or set for
                   6718:             the deeplink paramater for $env{'request.deeplink.login'}
                   6719:             then $menucoll will be the number of that collection. 
                   6720: 
                   6721: =item * $menuref, optional argument, reference to a hash, containing the
                   6722:             menu options included for the menu in effect, based on the
                   6723:             configuration for the numbered menu collection in use.  
                   6724: 
                   6725: =item * $showncrumbsref, reference to a scalar. Calls to lonmenu::innerregister
                   6726:             within &bodytag() can result in calls to lonhtmlcommon::breadcrumbs(),
                   6727:             if so, $showncrumbsref is set there to 1, and will propagate back
                   6728:             via &bodytag() to &start_page(), to prevent lonhtmlcommon::breadcrumbs()
                   6729:             being called a second time.
                   6730: 
1.112     bowersj2 6731: =back
                   6732: 
1.60      matthew  6733: Returns: A uniform header for LON-CAPA web pages.  
                   6734: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   6735: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   6736: other decorations will be returned.
                   6737: 
                   6738: =cut
                   6739: 
1.54      www      6740: sub bodytag {
1.831     bisitz   6741:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1359    raeburn  6742:         $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,
1.1385    raeburn  6743:         $ltimenu,$menucoll,$menuref,$showncrumbsref)=@_;
1.339     albertel 6744: 
1.954     raeburn  6745:     my $public;
                   6746:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   6747:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   6748:         $public = 1;
                   6749:     }
1.460     albertel 6750:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154    raeburn  6751:     my $httphost = $args->{'use_absolute'};
1.1274    raeburn  6752:     my $hostname = $args->{'hostname'};
1.339     albertel 6753: 
1.183     matthew  6754:     $function = &get_users_function() if (!$function);
1.339     albertel 6755:     my $img =    &designparm($function.'.img',$domain);
                   6756:     my $font =   &designparm($function.'.font',$domain);
                   6757:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   6758: 
1.803     bisitz   6759:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 6760: 		   'bgcolor' => $pgbg,
1.339     albertel 6761: 		   'text'    => $font,
                   6762:                    'alink'   => &designparm($function.'.alink',$domain),
                   6763: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   6764: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 6765:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 6766: 
1.63      www      6767:  # role and realm
1.1178    raeburn  6768:     my ($role,$realm) = split(m{\./},$env{'request.role'},2);
                   6769:     if ($realm) {
                   6770:         $realm = '/'.$realm;
                   6771:     }
1.1357    raeburn  6772:     if ($role eq 'ca') {
1.479     albertel 6773:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 6774:         $realm = &plainname($rname,$rdom);
1.378     raeburn  6775:     } 
1.55      www      6776: # realm
1.1357    raeburn  6777:     my ($cid,$sec);
1.258     albertel 6778:     if ($env{'request.course.id'}) {
1.1357    raeburn  6779:         $cid = $env{'request.course.id'};
                   6780:         if ($env{'request.course.sec'}) {
                   6781:             $sec = $env{'request.course.sec'};
                   6782:         }
                   6783:     } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {
                   6784:         if (&Apache::lonnet::is_course($1,$2)) {
                   6785:             $cid = $1.'_'.$2;
                   6786:             $sec = $3;
                   6787:         }
                   6788:     }
                   6789:     if ($cid) {
1.378     raeburn  6790:         if ($env{'request.role'} !~ /^cr/) {
                   6791:             $role = &Apache::lonnet::plaintext($role,&course_type());
1.1257    raeburn  6792:         } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1269    raeburn  6793:             if ($env{'request.role.desc'}) {
                   6794:                 $role = $env{'request.role.desc'};
                   6795:             } else {
                   6796:                 $role = &mt('Helpdesk[_1]','&nbsp;'.$2);
                   6797:             }
1.1257    raeburn  6798:         } else {
                   6799:             $role = (split(/\//,$role,4))[-1]; 
1.378     raeburn  6800:         }
1.1357    raeburn  6801:         if ($sec) {
                   6802:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$sec;
1.898     raeburn  6803:         }   
1.1357    raeburn  6804: 	$realm = $env{'course.'.$cid.'.description'};
1.378     raeburn  6805:     } else {
                   6806:         $role = &Apache::lonnet::plaintext($role);
1.54      www      6807:     }
1.433     albertel 6808: 
1.359     albertel 6809:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 6810: 
1.438     albertel 6811:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 6812: 
1.101     www      6813: # construct main body tag
1.359     albertel 6814:     my $bodytag = "<body $extra_body_attr>".
1.1235    raeburn  6815: 	&Apache::lontexconvert::init_math_support();
1.252     albertel 6816: 
1.1131    raeburn  6817:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   6818: 
1.1130    raeburn  6819:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  6820:         return $bodytag;
1.1130    raeburn  6821:     }
1.359     albertel 6822: 
1.954     raeburn  6823:     if ($public) {
1.433     albertel 6824: 	undef($role);
                   6825:     }
1.1318    raeburn  6826: 
1.1359    raeburn  6827:     my $showcrstitle = 1;
1.1357    raeburn  6828:     if (($cid) && ($env{'request.lti.login'})) {
1.1318    raeburn  6829:         if (ref($ltimenu) eq 'HASH') {
                   6830:             unless ($ltimenu->{'role'}) {
                   6831:                 undef($role);
                   6832:             }
                   6833:             unless ($ltimenu->{'coursetitle'}) {
                   6834:                 $realm='&nbsp;';
1.1359    raeburn  6835:                 $showcrstitle = 0;
                   6836:             }
                   6837:         }
                   6838:     } elsif (($cid) && ($menucoll)) {
                   6839:         if (ref($menuref) eq 'HASH') {
                   6840:             unless ($menuref->{'role'}) {
                   6841:                 undef($role);
                   6842:             }
                   6843:             unless ($menuref->{'crs'}) {
                   6844:                 $realm='&nbsp;';
                   6845:                 $showcrstitle = 0;
1.1318    raeburn  6846:             }
                   6847:         }
                   6848:     }
                   6849: 
1.762     bisitz   6850:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 6851:     #
                   6852:     # Extra info if you are the DC
                   6853:     my $dc_info = '';
1.1359    raeburn  6854:     if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle &&
1.1357    raeburn  6855:         (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
1.917     raeburn  6856:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      6857:         $dc_info =~ s/\s+$//;
1.359     albertel 6858:     }
                   6859: 
1.1237    raeburn  6860:     my $crstype;
1.1357    raeburn  6861:     if ($cid) {
                   6862:         $crstype = $env{'course.'.$cid.'.type'};
1.1237    raeburn  6863:     } elsif ($args->{'crstype'}) {
                   6864:         $crstype = $args->{'crstype'};
                   6865:     }
                   6866:     if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
                   6867:         undef($role);
                   6868:     } else {
1.1242    raeburn  6869:         $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237    raeburn  6870:     }
1.853     droeschl 6871: 
1.903     droeschl 6872:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   6873: 
                   6874:         #    if ($env{'request.state'} eq 'construct') {
                   6875:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   6876:         #    }
                   6877: 
1.1130    raeburn  6878:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154    raeburn  6879:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 6880: 
1.1318    raeburn  6881:         unless ($args->{'no_primary_menu'}) {
1.1369    raeburn  6882:             my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref,
1.1380    raeburn  6883:                                                               $args->{'links_disabled'},
                   6884:                                                               $args->{'links_target'});
1.359     albertel 6885: 
1.1318    raeburn  6886:             if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
                   6887:                 if ($dc_info) {
                   6888:                     $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   6889:                 }
                   6890:                 $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
                   6891:                                <em>$realm</em> $dc_info</div>|;
                   6892:                 return $bodytag;
                   6893:             }
1.894     droeschl 6894: 
1.1318    raeburn  6895:             unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
                   6896:                 $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
                   6897:             }
1.916     droeschl 6898: 
1.1318    raeburn  6899:             $bodytag .= $right;
1.852     droeschl 6900: 
1.1318    raeburn  6901:             if ($dc_info) {
                   6902:                 $dc_info = &dc_courseid_toggle($dc_info);
                   6903:             }
                   6904:             $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.917     raeburn  6905:         }
1.916     droeschl 6906: 
1.1169    raeburn  6907:         #if directed to not display the secondary menu, don't.  
1.1168    raeburn  6908:         if ($args->{'no_secondary_menu'}) {
                   6909:             return $bodytag;
                   6910:         }
1.1169    raeburn  6911:         #don't show menus for public users
1.954     raeburn  6912:         if (!$public){
1.1318    raeburn  6913:             unless ($args->{'no_inline_menu'}) {
                   6914:                 $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
1.1359    raeburn  6915:                                                             $args->{'no_primary_menu'},
1.1369    raeburn  6916:                                                             $menucoll,$menuref,
1.1380    raeburn  6917:                                                             $args->{'links_disabled'},
                   6918:                                                             $args->{'links_target'});
1.1318    raeburn  6919:             }
1.903     droeschl 6920:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  6921:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   6922:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 6923:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1385    raeburn  6924:                                 $args->{'bread_crumbs'},'','',$hostname,
                   6925:                                 $ltiscope,$ltiuri,$showncrumbsref);
1.1096    raeburn  6926:             } elsif ($forcereg) {
                   6927:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1385    raeburn  6928:                                 $args->{'group'},$args->{'hide_buttons'},
                   6929:                                 $hostname,$ltiscope,$ltiuri,$showncrumbsref);
1.1096    raeburn  6930:             } else {
                   6931:                 $bodytag .= 
                   6932:                     &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   6933:                                                         $forcereg,$args->{'group'},
                   6934:                                                         $args->{'bread_crumbs'},
1.1274    raeburn  6935:                                                         $advtoolsref,'',$hostname);
1.920     raeburn  6936:             }
1.903     droeschl 6937:         }else{
                   6938:             # this is to seperate menu from content when there's no secondary
                   6939:             # menu. Especially needed for public accessible ressources.
                   6940:             $bodytag .= '<hr style="clear:both" />';
                   6941:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  6942:         }
1.903     droeschl 6943: 
1.235     raeburn  6944:         return $bodytag;
1.182     matthew  6945: }
                   6946: 
1.917     raeburn  6947: sub dc_courseid_toggle {
                   6948:     my ($dc_info) = @_;
1.980     raeburn  6949:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  6950:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  6951:            &mt('(More ...)').'</a></span>'.
                   6952:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   6953: }
                   6954: 
1.330     albertel 6955: sub make_attr_string {
                   6956:     my ($register,$attr_ref) = @_;
                   6957: 
                   6958:     if ($attr_ref && !ref($attr_ref)) {
                   6959: 	die("addentries Must be a hash ref ".
                   6960: 	    join(':',caller(1))." ".
                   6961: 	    join(':',caller(0))." ");
                   6962:     }
                   6963: 
                   6964:     if ($register) {
1.339     albertel 6965: 	my ($on_load,$on_unload);
                   6966: 	foreach my $key (keys(%{$attr_ref})) {
                   6967: 	    if      (lc($key) eq 'onload') {
                   6968: 		$on_load.=$attr_ref->{$key}.';';
                   6969: 		delete($attr_ref->{$key});
                   6970: 
                   6971: 	    } elsif (lc($key) eq 'onunload') {
                   6972: 		$on_unload.=$attr_ref->{$key}.';';
                   6973: 		delete($attr_ref->{$key});
                   6974: 	    }
                   6975: 	}
1.953     droeschl 6976: 	$attr_ref->{'onload'}  = $on_load;
                   6977: 	$attr_ref->{'onunload'}= $on_unload;
1.330     albertel 6978:     }
1.339     albertel 6979: 
1.330     albertel 6980:     my $attr_string;
1.1159    raeburn  6981:     foreach my $attr (sort(keys(%$attr_ref))) {
1.330     albertel 6982: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   6983:     }
                   6984:     return $attr_string;
                   6985: }
                   6986: 
                   6987: 
1.182     matthew  6988: ###############################################
1.251     albertel 6989: ###############################################
                   6990: 
                   6991: =pod
                   6992: 
                   6993: =item * &endbodytag()
                   6994: 
                   6995: Returns a uniform footer for LON-CAPA web pages.
                   6996: 
1.635     raeburn  6997: Inputs: 1 - optional reference to an args hash
                   6998: If in the hash, key for noredirectlink has a value which evaluates to true,
                   6999: a 'Continue' link is not displayed if the page contains an
                   7000: internal redirect in the <head></head> section,
                   7001: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 7002: 
                   7003: =cut
                   7004: 
                   7005: sub endbodytag {
1.635     raeburn  7006:     my ($args) = @_;
1.1080    raeburn  7007:     my $endbodytag;
                   7008:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   7009:         $endbodytag='</body>';
                   7010:     }
1.315     albertel 7011:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  7012:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
1.1386    raeburn  7013:             my ($endbodyjs,$idattr);
                   7014:             if ($env{'internal.head.to_opener'}) {
                   7015:                 my $linkid = 'LC_continue_link';
                   7016:                 $idattr = ' id="'.$linkid.'"';
                   7017:                 my $redirect_for_js = &js_escape($env{'internal.head.redirect'});
                   7018:                 $endbodyjs=<<ENDJS;
                   7019: <script type="text/javascript">
                   7020: // <![CDATA[
                   7021: function ebFunction(evt) {
                   7022:     evt.preventDefault();
                   7023:     var dest = '$redirect_for_js';
                   7024:     if (window.opener != null && !window.opener.closed) {
                   7025:         window.opener.location.href=dest;
                   7026:         window.close();
                   7027:     } else {
                   7028:         window.location.href=dest;
                   7029:     }
                   7030:     return false;
                   7031: }
                   7032: 
                   7033: \$(document).ready(function () {
                   7034:   if (document.getElementById('$linkid')) {
                   7035:     var clickelem = document.getElementById('$linkid');
                   7036:     clickelem.addEventListener('click',ebFunction,false);
                   7037:   }
                   7038: });
                   7039: // ]]>
                   7040: </script>
                   7041: ENDJS
                   7042:             }
1.635     raeburn  7043: 	    $endbodytag=
1.1386    raeburn  7044: 	        "$endbodyjs<br /><a href=\"$env{'internal.head.redirect'}\"$idattr>".
1.635     raeburn  7045: 	        &mt('Continue').'</a>'.
                   7046: 	        $endbodytag;
                   7047:         }
1.315     albertel 7048:     }
1.1411    raeburn  7049:     if ((ref($args) eq 'HASH') && ($args->{'dashjs'})) {
                   7050:         $endbodytag = &Apache::lonhtmlcommon::dash_to_minus_js().$endbodytag;
                   7051:     }
1.251     albertel 7052:     return $endbodytag;
                   7053: }
                   7054: 
1.352     albertel 7055: =pod
                   7056: 
                   7057: =item * &standard_css()
                   7058: 
                   7059: Returns a style sheet
                   7060: 
                   7061: Inputs: (all optional)
                   7062:             domain         -> force to color decorate a page for a specific
                   7063:                                domain
                   7064:             function       -> force usage of a specific rolish color scheme
                   7065:             bgcolor        -> override the default page bgcolor
                   7066: 
                   7067: =cut
                   7068: 
1.343     albertel 7069: sub standard_css {
1.345     albertel 7070:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 7071:     $function  = &get_users_function() if (!$function);
                   7072:     my $img    = &designparm($function.'.img',   $domain);
                   7073:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   7074:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 7075:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 7076: #second colour for later usage
1.345     albertel 7077:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 7078:     my $pgbg_or_bgcolor =
                   7079: 	         $bgcolor ||
1.352     albertel 7080: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 7081:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 7082:     my $alink  = &designparm($function.'.alink', $domain);
                   7083:     my $vlink  = &designparm($function.'.vlink', $domain);
                   7084:     my $link   = &designparm($function.'.link',  $domain);
                   7085: 
1.602     albertel 7086:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 7087:     my $mono                 = 'monospace';
1.850     bisitz   7088:     my $data_table_head      = $sidebg;
                   7089:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   7090:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 7091:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 7092:     my $data_table_highlight = '#FFFF00';
1.352     albertel 7093:     my $mail_new             = '#FFBB77';
                   7094:     my $mail_new_hover       = '#DD9955';
                   7095:     my $mail_read            = '#BBBB77';
                   7096:     my $mail_read_hover      = '#999944';
                   7097:     my $mail_replied         = '#AAAA88';
                   7098:     my $mail_replied_hover   = '#888855';
                   7099:     my $mail_other           = '#99BBBB';
                   7100:     my $mail_other_hover     = '#669999';
1.391     albertel 7101:     my $table_header         = '#DDDDDD';
1.489     raeburn  7102:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   7103:     my $lg_border_color      = '#C8C8C8';
1.952     onken    7104:     my $button_hover         = '#BF2317';
1.392     albertel 7105: 
1.608     albertel 7106:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   7107:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   7108:                                              : '0 3px 0 4px';
1.448     albertel 7109: 
1.523     albertel 7110: 
1.343     albertel 7111:     return <<END;
1.947     droeschl 7112: 
                   7113: /* needed for iframe to allow 100% height in FF */
                   7114: body, html { 
                   7115:     margin: 0;
                   7116:     padding: 0 0.5%;
                   7117:     height: 99%; /* to avoid scrollbars */
                   7118: }
                   7119: 
1.795     www      7120: body {
1.911     bisitz   7121:   font-family: $sans;
                   7122:   line-height:130%;
                   7123:   font-size:0.83em;
                   7124:   color:$font;
1.795     www      7125: }
                   7126: 
1.959     onken    7127: a:focus,
                   7128: a:focus img {
1.795     www      7129:   color: red;
                   7130: }
1.698     harmsja  7131: 
1.911     bisitz   7132: form, .inline {
                   7133:   display: inline;
1.795     www      7134: }
1.721     harmsja  7135: 
1.795     www      7136: .LC_right {
1.911     bisitz   7137:   text-align:right;
1.795     www      7138: }
                   7139: 
                   7140: .LC_middle {
1.911     bisitz   7141:   vertical-align:middle;
1.795     www      7142: }
1.721     harmsja  7143: 
1.1130    raeburn  7144: .LC_floatleft {
                   7145:   float: left;
                   7146: }
                   7147: 
                   7148: .LC_floatright {
                   7149:   float: right;
                   7150: }
                   7151: 
1.911     bisitz   7152: .LC_400Box {
                   7153:   width:400px;
                   7154: }
1.721     harmsja  7155: 
1.947     droeschl 7156: .LC_iframecontainer {
                   7157:     width: 98%;
                   7158:     margin: 0;
                   7159:     position: fixed;
                   7160:     top: 8.5em;
                   7161:     bottom: 0;
                   7162: }
                   7163: 
                   7164: .LC_iframecontainer iframe{
                   7165:     border: none;
                   7166:     width: 100%;
                   7167:     height: 100%;
                   7168: }
                   7169: 
1.778     bisitz   7170: .LC_filename {
                   7171:   font-family: $mono;
                   7172:   white-space:pre;
1.921     bisitz   7173:   font-size: 120%;
1.778     bisitz   7174: }
                   7175: 
                   7176: .LC_fileicon {
                   7177:   border: none;
                   7178:   height: 1.3em;
                   7179:   vertical-align: text-bottom;
                   7180:   margin-right: 0.3em;
                   7181:   text-decoration:none;
                   7182: }
                   7183: 
1.1008    www      7184: .LC_setting {
                   7185:   text-decoration:underline;
                   7186: }
                   7187: 
1.350     albertel 7188: .LC_error {
                   7189:   color: red;
                   7190: }
1.795     www      7191: 
1.1097    bisitz   7192: .LC_warning {
                   7193:   color: darkorange;
                   7194: }
                   7195: 
1.457     albertel 7196: .LC_diff_removed {
1.733     bisitz   7197:   color: red;
1.394     albertel 7198: }
1.532     albertel 7199: 
                   7200: .LC_info,
1.457     albertel 7201: .LC_success,
                   7202: .LC_diff_added {
1.350     albertel 7203:   color: green;
                   7204: }
1.795     www      7205: 
1.802     bisitz   7206: div.LC_confirm_box {
                   7207:   background-color: #FAFAFA;
                   7208:   border: 1px solid $lg_border_color;
                   7209:   margin-right: 0;
                   7210:   padding: 5px;
                   7211: }
                   7212: 
                   7213: div.LC_confirm_box .LC_error img,
                   7214: div.LC_confirm_box .LC_success img {
                   7215:   vertical-align: middle;
                   7216: }
                   7217: 
1.1242    raeburn  7218: .LC_maxwidth {
                   7219:   max-width: 100%;
                   7220:   height: auto;
                   7221: }
                   7222: 
1.1243    raeburn  7223: .LC_textsize_mobile {
                   7224:   \@media only screen and (max-device-width: 480px) {
                   7225:       -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
                   7226:   }
                   7227: }
                   7228: 
1.440     albertel 7229: .LC_icon {
1.771     droeschl 7230:   border: none;
1.790     droeschl 7231:   vertical-align: middle;
1.771     droeschl 7232: }
                   7233: 
1.543     albertel 7234: .LC_docs_spacer {
                   7235:   width: 25px;
                   7236:   height: 1px;
1.771     droeschl 7237:   border: none;
1.543     albertel 7238: }
1.346     albertel 7239: 
1.532     albertel 7240: .LC_internal_info {
1.735     bisitz   7241:   color: #999999;
1.532     albertel 7242: }
                   7243: 
1.794     www      7244: .LC_discussion {
1.1050    www      7245:   background: $data_table_dark;
1.911     bisitz   7246:   border: 1px solid black;
                   7247:   margin: 2px;
1.794     www      7248: }
                   7249: 
                   7250: .LC_disc_action_left {
1.1050    www      7251:   background: $sidebg;
1.911     bisitz   7252:   text-align: left;
1.1050    www      7253:   padding: 4px;
                   7254:   margin: 2px;
1.794     www      7255: }
                   7256: 
                   7257: .LC_disc_action_right {
1.1050    www      7258:   background: $sidebg;
1.911     bisitz   7259:   text-align: right;
1.1050    www      7260:   padding: 4px;
                   7261:   margin: 2px;
1.794     www      7262: }
                   7263: 
                   7264: .LC_disc_new_item {
1.911     bisitz   7265:   background: white;
                   7266:   border: 2px solid red;
1.1050    www      7267:   margin: 4px;
                   7268:   padding: 4px;
1.794     www      7269: }
                   7270: 
                   7271: .LC_disc_old_item {
1.911     bisitz   7272:   background: white;
1.1050    www      7273:   margin: 4px;
                   7274:   padding: 4px;
1.794     www      7275: }
                   7276: 
1.458     albertel 7277: table.LC_pastsubmission {
                   7278:   border: 1px solid black;
                   7279:   margin: 2px;
                   7280: }
                   7281: 
1.924     bisitz   7282: table#LC_menubuttons {
1.345     albertel 7283:   width: 100%;
                   7284:   background: $pgbg;
1.392     albertel 7285:   border: 2px;
1.402     albertel 7286:   border-collapse: separate;
1.803     bisitz   7287:   padding: 0;
1.345     albertel 7288: }
1.392     albertel 7289: 
1.801     tempelho 7290: table#LC_title_bar a {
                   7291:   color: $fontmenu;
                   7292: }
1.836     bisitz   7293: 
1.807     droeschl 7294: table#LC_title_bar {
1.819     tempelho 7295:   clear: both;
1.836     bisitz   7296:   display: none;
1.807     droeschl 7297: }
                   7298: 
1.795     www      7299: table#LC_title_bar,
1.933     droeschl 7300: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 7301: table#LC_title_bar.LC_with_remote {
1.359     albertel 7302:   width: 100%;
1.392     albertel 7303:   border-color: $pgbg;
                   7304:   border-style: solid;
                   7305:   border-width: $border;
1.379     albertel 7306:   background: $pgbg;
1.801     tempelho 7307:   color: $fontmenu;
1.392     albertel 7308:   border-collapse: collapse;
1.803     bisitz   7309:   padding: 0;
1.819     tempelho 7310:   margin: 0;
1.359     albertel 7311: }
1.795     www      7312: 
1.933     droeschl 7313: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 7314:     margin: 0;
                   7315:     padding: 0;
1.933     droeschl 7316:     position: relative;
                   7317:     list-style: none;
1.913     droeschl 7318: }
1.933     droeschl 7319: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 7320:     display: inline;
                   7321: }
1.933     droeschl 7322: 
                   7323: .LC_breadcrumb_tools_navigation {
1.913     droeschl 7324:     padding: 0;
1.933     droeschl 7325:     margin: 0;
                   7326:     float: left;
1.913     droeschl 7327: }
1.933     droeschl 7328: .LC_breadcrumb_tools_tools {
                   7329:     padding: 0;
                   7330:     margin: 0;
1.913     droeschl 7331:     float: right;
                   7332: }
                   7333: 
1.1240    raeburn  7334: .LC_placement_prog {
                   7335:     padding-right: 20px;
                   7336:     font-weight: bold;
                   7337:     font-size: 90%;
                   7338: }
                   7339: 
1.359     albertel 7340: table#LC_title_bar td {
                   7341:   background: $tabbg;
                   7342: }
1.795     www      7343: 
1.911     bisitz   7344: table#LC_menubuttons img {
1.803     bisitz   7345:   border: none;
1.346     albertel 7346: }
1.795     www      7347: 
1.842     droeschl 7348: .LC_breadcrumbs_component {
1.911     bisitz   7349:   float: right;
                   7350:   margin: 0 1em;
1.357     albertel 7351: }
1.842     droeschl 7352: .LC_breadcrumbs_component img {
1.911     bisitz   7353:   vertical-align: middle;
1.777     tempelho 7354: }
1.795     www      7355: 
1.1243    raeburn  7356: .LC_breadcrumbs_hoverable {
                   7357:   background: $sidebg;
                   7358: }
                   7359: 
1.383     albertel 7360: td.LC_table_cell_checkbox {
                   7361:   text-align: center;
                   7362: }
1.795     www      7363: 
                   7364: .LC_fontsize_small {
1.911     bisitz   7365:   font-size: 70%;
1.705     tempelho 7366: }
                   7367: 
1.844     bisitz   7368: #LC_breadcrumbs {
1.911     bisitz   7369:   clear:both;
                   7370:   background: $sidebg;
                   7371:   border-bottom: 1px solid $lg_border_color;
                   7372:   line-height: 2.5em;
1.933     droeschl 7373:   overflow: hidden;
1.911     bisitz   7374:   margin: 0;
                   7375:   padding: 0;
1.995     raeburn  7376:   text-align: left;
1.819     tempelho 7377: }
1.862     bisitz   7378: 
1.1098    bisitz   7379: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   7380:   clear:both;
                   7381:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 7382:   border: 1px solid $sidebg;
1.1098    bisitz   7383:   margin: 0 0 10px 0;
1.966     bisitz   7384:   padding: 3px;
1.995     raeburn  7385:   text-align: left;
1.822     bisitz   7386: }
                   7387: 
1.795     www      7388: .LC_fontsize_medium {
1.911     bisitz   7389:   font-size: 85%;
1.705     tempelho 7390: }
                   7391: 
1.795     www      7392: .LC_fontsize_large {
1.911     bisitz   7393:   font-size: 120%;
1.705     tempelho 7394: }
                   7395: 
1.346     albertel 7396: .LC_menubuttons_inline_text {
                   7397:   color: $font;
1.698     harmsja  7398:   font-size: 90%;
1.701     harmsja  7399:   padding-left:3px;
1.346     albertel 7400: }
                   7401: 
1.934     droeschl 7402: .LC_menubuttons_inline_text img{
                   7403:   vertical-align: middle;
                   7404: }
                   7405: 
1.1051    www      7406: li.LC_menubuttons_inline_text img {
1.951     onken    7407:   cursor:pointer;
1.1002    droeschl 7408:   text-decoration: none;
1.951     onken    7409: }
                   7410: 
1.526     www      7411: .LC_menubuttons_link {
                   7412:   text-decoration: none;
                   7413: }
1.795     www      7414: 
1.522     albertel 7415: .LC_menubuttons_category {
1.521     www      7416:   color: $font;
1.526     www      7417:   background: $pgbg;
1.521     www      7418:   font-size: larger;
                   7419:   font-weight: bold;
                   7420: }
                   7421: 
1.346     albertel 7422: td.LC_menubuttons_text {
1.911     bisitz   7423:   color: $font;
1.346     albertel 7424: }
1.706     harmsja  7425: 
1.346     albertel 7426: .LC_current_location {
                   7427:   background: $tabbg;
                   7428: }
1.795     www      7429: 
1.1286    raeburn  7430: td.LC_zero_height {
                   7431:   line-height: 0; 
                   7432:   cellpadding: 0;
                   7433: }
                   7434: 
1.938     bisitz   7435: table.LC_data_table {
1.347     albertel 7436:   border: 1px solid #000000;
1.402     albertel 7437:   border-collapse: separate;
1.426     albertel 7438:   border-spacing: 1px;
1.610     albertel 7439:   background: $pgbg;
1.347     albertel 7440: }
1.795     www      7441: 
1.422     albertel 7442: .LC_data_table_dense {
                   7443:   font-size: small;
                   7444: }
1.795     www      7445: 
1.507     raeburn  7446: table.LC_nested_outer {
                   7447:   border: 1px solid #000000;
1.589     raeburn  7448:   border-collapse: collapse;
1.803     bisitz   7449:   border-spacing: 0;
1.507     raeburn  7450:   width: 100%;
                   7451: }
1.795     www      7452: 
1.879     raeburn  7453: table.LC_innerpickbox,
1.507     raeburn  7454: table.LC_nested {
1.803     bisitz   7455:   border: none;
1.589     raeburn  7456:   border-collapse: collapse;
1.803     bisitz   7457:   border-spacing: 0;
1.507     raeburn  7458:   width: 100%;
                   7459: }
1.795     www      7460: 
1.911     bisitz   7461: table.LC_data_table tr th,
                   7462: table.LC_calendar tr th,
1.879     raeburn  7463: table.LC_prior_tries tr th,
                   7464: table.LC_innerpickbox tr th {
1.349     albertel 7465:   font-weight: bold;
                   7466:   background-color: $data_table_head;
1.801     tempelho 7467:   color:$fontmenu;
1.701     harmsja  7468:   font-size:90%;
1.347     albertel 7469: }
1.795     www      7470: 
1.879     raeburn  7471: table.LC_innerpickbox tr th,
                   7472: table.LC_innerpickbox tr td {
                   7473:   vertical-align: top;
                   7474: }
                   7475: 
1.711     raeburn  7476: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   7477:   background-color: #CCCCCC;
1.711     raeburn  7478:   font-weight: bold;
                   7479:   text-align: left;
                   7480: }
1.795     www      7481: 
1.912     bisitz   7482: table.LC_data_table tr.LC_odd_row > td {
                   7483:   background-color: $data_table_light;
                   7484:   padding: 2px;
                   7485:   vertical-align: top;
                   7486: }
                   7487: 
1.809     bisitz   7488: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 7489:   background-color: $data_table_light;
1.912     bisitz   7490:   vertical-align: top;
                   7491: }
                   7492: 
                   7493: table.LC_data_table tr.LC_even_row > td {
                   7494:   background-color: $data_table_dark;
1.425     albertel 7495:   padding: 2px;
1.900     bisitz   7496:   vertical-align: top;
1.347     albertel 7497: }
1.795     www      7498: 
1.809     bisitz   7499: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 7500:   background-color: $data_table_dark;
1.900     bisitz   7501:   vertical-align: top;
1.347     albertel 7502: }
1.795     www      7503: 
1.425     albertel 7504: table.LC_data_table tr.LC_data_table_highlight td {
                   7505:   background-color: $data_table_darker;
                   7506: }
1.795     www      7507: 
1.639     raeburn  7508: table.LC_data_table tr td.LC_leftcol_header {
                   7509:   background-color: $data_table_head;
                   7510:   font-weight: bold;
                   7511: }
1.795     www      7512: 
1.451     albertel 7513: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  7514: table.LC_nested tr.LC_empty_row td {
1.421     albertel 7515:   font-weight: bold;
                   7516:   font-style: italic;
                   7517:   text-align: center;
                   7518:   padding: 8px;
1.347     albertel 7519: }
1.795     www      7520: 
1.1114    raeburn  7521: table.LC_data_table tr.LC_empty_row td,
                   7522: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   7523:   background-color: $sidebg;
                   7524: }
                   7525: 
                   7526: table.LC_nested tr.LC_empty_row td {
                   7527:   background-color: #FFFFFF;
                   7528: }
                   7529: 
1.890     droeschl 7530: table.LC_caption {
                   7531: }
                   7532: 
1.507     raeburn  7533: table.LC_nested tr.LC_empty_row td {
1.465     albertel 7534:   padding: 4ex
                   7535: }
1.795     www      7536: 
1.507     raeburn  7537: table.LC_nested_outer tr th {
                   7538:   font-weight: bold;
1.801     tempelho 7539:   color:$fontmenu;
1.507     raeburn  7540:   background-color: $data_table_head;
1.701     harmsja  7541:   font-size: small;
1.507     raeburn  7542:   border-bottom: 1px solid #000000;
                   7543: }
1.795     www      7544: 
1.507     raeburn  7545: table.LC_nested_outer tr td.LC_subheader {
                   7546:   background-color: $data_table_head;
                   7547:   font-weight: bold;
                   7548:   font-size: small;
                   7549:   border-bottom: 1px solid #000000;
                   7550:   text-align: right;
1.451     albertel 7551: }
1.795     www      7552: 
1.507     raeburn  7553: table.LC_nested tr.LC_info_row td {
1.735     bisitz   7554:   background-color: #CCCCCC;
1.451     albertel 7555:   font-weight: bold;
                   7556:   font-size: small;
1.507     raeburn  7557:   text-align: center;
                   7558: }
1.795     www      7559: 
1.589     raeburn  7560: table.LC_nested tr.LC_info_row td.LC_left_item,
                   7561: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  7562:   text-align: left;
1.451     albertel 7563: }
1.795     www      7564: 
1.507     raeburn  7565: table.LC_nested td {
1.735     bisitz   7566:   background-color: #FFFFFF;
1.451     albertel 7567:   font-size: small;
1.507     raeburn  7568: }
1.795     www      7569: 
1.507     raeburn  7570: table.LC_nested_outer tr th.LC_right_item,
                   7571: table.LC_nested tr.LC_info_row td.LC_right_item,
                   7572: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   7573: table.LC_nested tr td.LC_right_item {
1.451     albertel 7574:   text-align: right;
                   7575: }
                   7576: 
1.507     raeburn  7577: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   7578:   background-color: #EEEEEE;
1.451     albertel 7579: }
                   7580: 
1.473     raeburn  7581: table.LC_createuser {
                   7582: }
                   7583: 
                   7584: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  7585:   font-size: small;
1.473     raeburn  7586: }
                   7587: 
                   7588: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   7589:   background-color: #CCCCCC;
1.473     raeburn  7590:   font-weight: bold;
                   7591:   text-align: center;
                   7592: }
                   7593: 
1.349     albertel 7594: table.LC_calendar {
                   7595:   border: 1px solid #000000;
                   7596:   border-collapse: collapse;
1.917     raeburn  7597:   width: 98%;
1.349     albertel 7598: }
1.795     www      7599: 
1.349     albertel 7600: table.LC_calendar_pickdate {
                   7601:   font-size: xx-small;
                   7602: }
1.795     www      7603: 
1.349     albertel 7604: table.LC_calendar tr td {
                   7605:   border: 1px solid #000000;
                   7606:   vertical-align: top;
1.917     raeburn  7607:   width: 14%;
1.349     albertel 7608: }
1.795     www      7609: 
1.349     albertel 7610: table.LC_calendar tr td.LC_calendar_day_empty {
                   7611:   background-color: $data_table_dark;
                   7612: }
1.795     www      7613: 
1.779     bisitz   7614: table.LC_calendar tr td.LC_calendar_day_current {
                   7615:   background-color: $data_table_highlight;
1.777     tempelho 7616: }
1.795     www      7617: 
1.938     bisitz   7618: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 7619:   background-color: $mail_new;
                   7620: }
1.795     www      7621: 
1.938     bisitz   7622: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 7623:   background-color: $mail_new_hover;
                   7624: }
1.795     www      7625: 
1.938     bisitz   7626: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 7627:   background-color: $mail_read;
                   7628: }
1.795     www      7629: 
1.938     bisitz   7630: /*
                   7631: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 7632:   background-color: $mail_read_hover;
                   7633: }
1.938     bisitz   7634: */
1.795     www      7635: 
1.938     bisitz   7636: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 7637:   background-color: $mail_replied;
                   7638: }
1.795     www      7639: 
1.938     bisitz   7640: /*
                   7641: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 7642:   background-color: $mail_replied_hover;
                   7643: }
1.938     bisitz   7644: */
1.795     www      7645: 
1.938     bisitz   7646: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 7647:   background-color: $mail_other;
                   7648: }
1.795     www      7649: 
1.938     bisitz   7650: /*
                   7651: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 7652:   background-color: $mail_other_hover;
                   7653: }
1.938     bisitz   7654: */
1.494     raeburn  7655: 
1.777     tempelho 7656: table.LC_data_table tr > td.LC_browser_file,
                   7657: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   7658:   background: #AAEE77;
1.389     albertel 7659: }
1.795     www      7660: 
1.777     tempelho 7661: table.LC_data_table tr > td.LC_browser_file_locked,
                   7662: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 7663:   background: #FFAA99;
1.387     albertel 7664: }
1.795     www      7665: 
1.777     tempelho 7666: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   7667:   background: #888888;
1.779     bisitz   7668: }
1.795     www      7669: 
1.777     tempelho 7670: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   7671: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   7672:   background: #F8F866;
1.777     tempelho 7673: }
1.795     www      7674: 
1.696     bisitz   7675: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   7676:   background: #E0E8FF;
1.387     albertel 7677: }
1.696     bisitz   7678: 
1.707     bisitz   7679: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   7680:   /* background: #77FF77; */
1.707     bisitz   7681: }
1.795     www      7682: 
1.707     bisitz   7683: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   7684:   border-right: 8px solid #FFFF77;
1.707     bisitz   7685: }
1.795     www      7686: 
1.707     bisitz   7687: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   7688:   border-right: 8px solid #FFAA77;
1.707     bisitz   7689: }
1.795     www      7690: 
1.707     bisitz   7691: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   7692:   border-right: 8px solid #FF7777;
1.707     bisitz   7693: }
1.795     www      7694: 
1.707     bisitz   7695: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   7696:   border-right: 8px solid #AAFF77;
1.707     bisitz   7697: }
1.795     www      7698: 
1.707     bisitz   7699: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   7700:   border-right: 8px solid #11CC55;
1.707     bisitz   7701: }
                   7702: 
1.388     albertel 7703: span.LC_current_location {
1.701     harmsja  7704:   font-size:larger;
1.388     albertel 7705:   background: $pgbg;
                   7706: }
1.387     albertel 7707: 
1.1029    www      7708: span.LC_current_nav_location {
                   7709:   font-weight:bold;
                   7710:   background: $sidebg;
                   7711: }
                   7712: 
1.395     albertel 7713: span.LC_parm_menu_item {
                   7714:   font-size: larger;
                   7715: }
1.795     www      7716: 
1.395     albertel 7717: span.LC_parm_scope_all {
                   7718:   color: red;
                   7719: }
1.795     www      7720: 
1.395     albertel 7721: span.LC_parm_scope_folder {
                   7722:   color: green;
                   7723: }
1.795     www      7724: 
1.395     albertel 7725: span.LC_parm_scope_resource {
                   7726:   color: orange;
                   7727: }
1.795     www      7728: 
1.395     albertel 7729: span.LC_parm_part {
                   7730:   color: blue;
                   7731: }
1.795     www      7732: 
1.911     bisitz   7733: span.LC_parm_folder,
                   7734: span.LC_parm_symb {
1.395     albertel 7735:   font-size: x-small;
                   7736:   font-family: $mono;
                   7737:   color: #AAAAAA;
                   7738: }
                   7739: 
1.977     bisitz   7740: ul.LC_parm_parmlist li {
                   7741:   display: inline-block;
                   7742:   padding: 0.3em 0.8em;
                   7743:   vertical-align: top;
                   7744:   width: 150px;
                   7745:   border-top:1px solid $lg_border_color;
                   7746: }
                   7747: 
1.795     www      7748: td.LC_parm_overview_level_menu,
                   7749: td.LC_parm_overview_map_menu,
                   7750: td.LC_parm_overview_parm_selectors,
                   7751: td.LC_parm_overview_restrictions  {
1.396     albertel 7752:   border: 1px solid black;
                   7753:   border-collapse: collapse;
                   7754: }
1.795     www      7755: 
1.1285    raeburn  7756: span.LC_parm_recursive,
                   7757: td.LC_parm_recursive {
                   7758:   font-weight: bold;
                   7759:   font-size: smaller;
                   7760: }
                   7761: 
1.396     albertel 7762: table.LC_parm_overview_restrictions td {
                   7763:   border-width: 1px 4px 1px 4px;
                   7764:   border-style: solid;
                   7765:   border-color: $pgbg;
                   7766:   text-align: center;
                   7767: }
1.795     www      7768: 
1.396     albertel 7769: table.LC_parm_overview_restrictions th {
                   7770:   background: $tabbg;
                   7771:   border-width: 1px 4px 1px 4px;
                   7772:   border-style: solid;
                   7773:   border-color: $pgbg;
                   7774: }
1.795     www      7775: 
1.398     albertel 7776: table#LC_helpmenu {
1.803     bisitz   7777:   border: none;
1.398     albertel 7778:   height: 55px;
1.803     bisitz   7779:   border-spacing: 0;
1.398     albertel 7780: }
                   7781: 
                   7782: table#LC_helpmenu fieldset legend {
                   7783:   font-size: larger;
                   7784: }
1.795     www      7785: 
1.397     albertel 7786: table#LC_helpmenu_links {
                   7787:   width: 100%;
                   7788:   border: 1px solid black;
                   7789:   background: $pgbg;
1.803     bisitz   7790:   padding: 0;
1.397     albertel 7791:   border-spacing: 1px;
                   7792: }
1.795     www      7793: 
1.397     albertel 7794: table#LC_helpmenu_links tr td {
                   7795:   padding: 1px;
                   7796:   background: $tabbg;
1.399     albertel 7797:   text-align: center;
                   7798:   font-weight: bold;
1.397     albertel 7799: }
1.396     albertel 7800: 
1.795     www      7801: table#LC_helpmenu_links a:link,
                   7802: table#LC_helpmenu_links a:visited,
1.397     albertel 7803: table#LC_helpmenu_links a:active {
                   7804:   text-decoration: none;
                   7805:   color: $font;
                   7806: }
1.795     www      7807: 
1.397     albertel 7808: table#LC_helpmenu_links a:hover {
                   7809:   text-decoration: underline;
                   7810:   color: $vlink;
                   7811: }
1.396     albertel 7812: 
1.417     albertel 7813: .LC_chrt_popup_exists {
                   7814:   border: 1px solid #339933;
                   7815:   margin: -1px;
                   7816: }
1.795     www      7817: 
1.417     albertel 7818: .LC_chrt_popup_up {
                   7819:   border: 1px solid yellow;
                   7820:   margin: -1px;
                   7821: }
1.795     www      7822: 
1.417     albertel 7823: .LC_chrt_popup {
                   7824:   border: 1px solid #8888FF;
                   7825:   background: #CCCCFF;
                   7826: }
1.795     www      7827: 
1.421     albertel 7828: table.LC_pick_box {
                   7829:   border-collapse: separate;
                   7830:   background: white;
                   7831:   border: 1px solid black;
                   7832:   border-spacing: 1px;
                   7833: }
1.795     www      7834: 
1.421     albertel 7835: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   7836:   background: $sidebg;
1.421     albertel 7837:   font-weight: bold;
1.900     bisitz   7838:   text-align: left;
1.740     bisitz   7839:   vertical-align: top;
1.421     albertel 7840:   width: 184px;
                   7841:   padding: 8px;
                   7842: }
1.795     www      7843: 
1.579     raeburn  7844: table.LC_pick_box td.LC_pick_box_value {
                   7845:   text-align: left;
                   7846:   padding: 8px;
                   7847: }
1.795     www      7848: 
1.579     raeburn  7849: table.LC_pick_box td.LC_pick_box_select {
                   7850:   text-align: left;
                   7851:   padding: 8px;
                   7852: }
1.795     www      7853: 
1.424     albertel 7854: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   7855:   padding: 0;
1.421     albertel 7856:   height: 1px;
                   7857:   background: black;
                   7858: }
1.795     www      7859: 
1.421     albertel 7860: table.LC_pick_box td.LC_pick_box_submit {
                   7861:   text-align: right;
                   7862: }
1.795     www      7863: 
1.579     raeburn  7864: table.LC_pick_box td.LC_evenrow_value {
                   7865:   text-align: left;
                   7866:   padding: 8px;
                   7867:   background-color: $data_table_light;
                   7868: }
1.795     www      7869: 
1.579     raeburn  7870: table.LC_pick_box td.LC_oddrow_value {
                   7871:   text-align: left;
                   7872:   padding: 8px;
                   7873:   background-color: $data_table_light;
                   7874: }
1.795     www      7875: 
1.579     raeburn  7876: span.LC_helpform_receipt_cat {
                   7877:   font-weight: bold;
                   7878: }
1.795     www      7879: 
1.424     albertel 7880: table.LC_group_priv_box {
                   7881:   background: white;
                   7882:   border: 1px solid black;
                   7883:   border-spacing: 1px;
                   7884: }
1.795     www      7885: 
1.424     albertel 7886: table.LC_group_priv_box td.LC_pick_box_title {
                   7887:   background: $tabbg;
                   7888:   font-weight: bold;
                   7889:   text-align: right;
                   7890:   width: 184px;
                   7891: }
1.795     www      7892: 
1.424     albertel 7893: table.LC_group_priv_box td.LC_groups_fixed {
                   7894:   background: $data_table_light;
                   7895:   text-align: center;
                   7896: }
1.795     www      7897: 
1.424     albertel 7898: table.LC_group_priv_box td.LC_groups_optional {
                   7899:   background: $data_table_dark;
                   7900:   text-align: center;
                   7901: }
1.795     www      7902: 
1.424     albertel 7903: table.LC_group_priv_box td.LC_groups_functionality {
                   7904:   background: $data_table_darker;
                   7905:   text-align: center;
                   7906:   font-weight: bold;
                   7907: }
1.795     www      7908: 
1.424     albertel 7909: table.LC_group_priv td {
                   7910:   text-align: left;
1.803     bisitz   7911:   padding: 0;
1.424     albertel 7912: }
                   7913: 
                   7914: .LC_navbuttons {
                   7915:   margin: 2ex 0ex 2ex 0ex;
                   7916: }
1.795     www      7917: 
1.423     albertel 7918: .LC_topic_bar {
                   7919:   font-weight: bold;
                   7920:   background: $tabbg;
1.918     wenzelju 7921:   margin: 1em 0em 1em 2em;
1.805     bisitz   7922:   padding: 3px;
1.918     wenzelju 7923:   font-size: 1.2em;
1.423     albertel 7924: }
1.795     www      7925: 
1.423     albertel 7926: .LC_topic_bar span {
1.918     wenzelju 7927:   left: 0.5em;
                   7928:   position: absolute;
1.423     albertel 7929:   vertical-align: middle;
1.918     wenzelju 7930:   font-size: 1.2em;
1.423     albertel 7931: }
1.795     www      7932: 
1.423     albertel 7933: table.LC_course_group_status {
                   7934:   margin: 20px;
                   7935: }
1.795     www      7936: 
1.423     albertel 7937: table.LC_status_selector td {
                   7938:   vertical-align: top;
                   7939:   text-align: center;
1.424     albertel 7940:   padding: 4px;
                   7941: }
1.795     www      7942: 
1.599     albertel 7943: div.LC_feedback_link {
1.616     albertel 7944:   clear: both;
1.829     kalberla 7945:   background: $sidebg;
1.779     bisitz   7946:   width: 100%;
1.829     kalberla 7947:   padding-bottom: 10px;
                   7948:   border: 1px $tabbg solid;
1.833     kalberla 7949:   height: 22px;
                   7950:   line-height: 22px;
                   7951:   padding-top: 5px;
                   7952: }
                   7953: 
                   7954: div.LC_feedback_link img {
                   7955:   height: 22px;
1.867     kalberla 7956:   vertical-align:middle;
1.829     kalberla 7957: }
                   7958: 
1.911     bisitz   7959: div.LC_feedback_link a {
1.829     kalberla 7960:   text-decoration: none;
1.489     raeburn  7961: }
1.795     www      7962: 
1.867     kalberla 7963: div.LC_comblock {
1.911     bisitz   7964:   display:inline;
1.867     kalberla 7965:   color:$font;
                   7966:   font-size:90%;
                   7967: }
                   7968: 
                   7969: div.LC_feedback_link div.LC_comblock {
                   7970:   padding-left:5px;
                   7971: }
                   7972: 
                   7973: div.LC_feedback_link div.LC_comblock a {
                   7974:   color:$font;
                   7975: }
                   7976: 
1.489     raeburn  7977: span.LC_feedback_link {
1.858     bisitz   7978:   /* background: $feedback_link_bg; */
1.599     albertel 7979:   font-size: larger;
                   7980: }
1.795     www      7981: 
1.599     albertel 7982: span.LC_message_link {
1.858     bisitz   7983:   /* background: $feedback_link_bg; */
1.599     albertel 7984:   font-size: larger;
                   7985:   position: absolute;
                   7986:   right: 1em;
1.489     raeburn  7987: }
1.421     albertel 7988: 
1.515     albertel 7989: table.LC_prior_tries {
1.524     albertel 7990:   border: 1px solid #000000;
                   7991:   border-collapse: separate;
                   7992:   border-spacing: 1px;
1.515     albertel 7993: }
1.523     albertel 7994: 
1.515     albertel 7995: table.LC_prior_tries td {
1.524     albertel 7996:   padding: 2px;
1.515     albertel 7997: }
1.523     albertel 7998: 
                   7999: .LC_answer_correct {
1.795     www      8000:   background: lightgreen;
                   8001:   color: darkgreen;
                   8002:   padding: 6px;
1.523     albertel 8003: }
1.795     www      8004: 
1.523     albertel 8005: .LC_answer_charged_try {
1.797     www      8006:   background: #FFAAAA;
1.795     www      8007:   color: darkred;
                   8008:   padding: 6px;
1.523     albertel 8009: }
1.795     www      8010: 
1.779     bisitz   8011: .LC_answer_not_charged_try,
1.523     albertel 8012: .LC_answer_no_grade,
                   8013: .LC_answer_late {
1.795     www      8014:   background: lightyellow;
1.523     albertel 8015:   color: black;
1.795     www      8016:   padding: 6px;
1.523     albertel 8017: }
1.795     www      8018: 
1.523     albertel 8019: .LC_answer_previous {
1.795     www      8020:   background: lightblue;
                   8021:   color: darkblue;
                   8022:   padding: 6px;
1.523     albertel 8023: }
1.795     www      8024: 
1.779     bisitz   8025: .LC_answer_no_message {
1.777     tempelho 8026:   background: #FFFFFF;
                   8027:   color: black;
1.795     www      8028:   padding: 6px;
1.779     bisitz   8029: }
1.795     www      8030: 
1.1334    raeburn  8031: .LC_answer_unknown,
                   8032: .LC_answer_warning {
1.779     bisitz   8033:   background: orange;
                   8034:   color: black;
1.795     www      8035:   padding: 6px;
1.777     tempelho 8036: }
1.795     www      8037: 
1.529     albertel 8038: span.LC_prior_numerical,
                   8039: span.LC_prior_string,
                   8040: span.LC_prior_custom,
                   8041: span.LC_prior_reaction,
                   8042: span.LC_prior_math {
1.925     bisitz   8043:   font-family: $mono;
1.523     albertel 8044:   white-space: pre;
                   8045: }
                   8046: 
1.525     albertel 8047: span.LC_prior_string {
1.925     bisitz   8048:   font-family: $mono;
1.525     albertel 8049:   white-space: pre;
                   8050: }
                   8051: 
1.523     albertel 8052: table.LC_prior_option {
                   8053:   width: 100%;
                   8054:   border-collapse: collapse;
                   8055: }
1.795     www      8056: 
1.911     bisitz   8057: table.LC_prior_rank,
1.795     www      8058: table.LC_prior_match {
1.528     albertel 8059:   border-collapse: collapse;
                   8060: }
1.795     www      8061: 
1.528     albertel 8062: table.LC_prior_option tr td,
                   8063: table.LC_prior_rank tr td,
                   8064: table.LC_prior_match tr td {
1.524     albertel 8065:   border: 1px solid #000000;
1.515     albertel 8066: }
                   8067: 
1.855     bisitz   8068: .LC_nobreak {
1.544     albertel 8069:   white-space: nowrap;
1.519     raeburn  8070: }
                   8071: 
1.576     raeburn  8072: span.LC_cusr_emph {
                   8073:   font-style: italic;
                   8074: }
                   8075: 
1.633     raeburn  8076: span.LC_cusr_subheading {
                   8077:   font-weight: normal;
                   8078:   font-size: 85%;
                   8079: }
                   8080: 
1.861     bisitz   8081: div.LC_docs_entry_move {
1.859     bisitz   8082:   border: 1px solid #BBBBBB;
1.545     albertel 8083:   background: #DDDDDD;
1.861     bisitz   8084:   width: 22px;
1.859     bisitz   8085:   padding: 1px;
                   8086:   margin: 0;
1.545     albertel 8087: }
                   8088: 
1.861     bisitz   8089: table.LC_data_table tr > td.LC_docs_entry_commands,
                   8090: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 8091:   font-size: x-small;
                   8092: }
1.795     www      8093: 
1.861     bisitz   8094: .LC_docs_entry_parameter {
                   8095:   white-space: nowrap;
                   8096: }
                   8097: 
1.544     albertel 8098: .LC_docs_copy {
1.545     albertel 8099:   color: #000099;
1.544     albertel 8100: }
1.795     www      8101: 
1.544     albertel 8102: .LC_docs_cut {
1.545     albertel 8103:   color: #550044;
1.544     albertel 8104: }
1.795     www      8105: 
1.544     albertel 8106: .LC_docs_rename {
1.545     albertel 8107:   color: #009900;
1.544     albertel 8108: }
1.795     www      8109: 
1.544     albertel 8110: .LC_docs_remove {
1.545     albertel 8111:   color: #990000;
                   8112: }
                   8113: 
1.1284    raeburn  8114: .LC_docs_alias {
                   8115:   color: #440055;  
                   8116: }
                   8117: 
1.1286    raeburn  8118: .LC_domprefs_email,
1.1284    raeburn  8119: .LC_docs_alias_name,
1.547     albertel 8120: .LC_docs_reinit_warn,
                   8121: .LC_docs_ext_edit {
                   8122:   font-size: x-small;
                   8123: }
                   8124: 
1.545     albertel 8125: table.LC_docs_adddocs td,
                   8126: table.LC_docs_adddocs th {
                   8127:   border: 1px solid #BBBBBB;
                   8128:   padding: 4px;
                   8129:   background: #DDDDDD;
1.543     albertel 8130: }
                   8131: 
1.584     albertel 8132: table.LC_sty_begin {
                   8133:   background: #BBFFBB;
                   8134: }
1.795     www      8135: 
1.584     albertel 8136: table.LC_sty_end {
                   8137:   background: #FFBBBB;
                   8138: }
                   8139: 
1.589     raeburn  8140: table.LC_double_column {
1.803     bisitz   8141:   border-width: 0;
1.589     raeburn  8142:   border-collapse: collapse;
                   8143:   width: 100%;
                   8144:   padding: 2px;
                   8145: }
                   8146: 
                   8147: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  8148:   top: 2px;
1.589     raeburn  8149:   left: 2px;
                   8150:   width: 47%;
                   8151:   vertical-align: top;
                   8152: }
                   8153: 
                   8154: table.LC_double_column tr td.LC_right_col {
                   8155:   top: 2px;
1.779     bisitz   8156:   right: 2px;
1.589     raeburn  8157:   width: 47%;
                   8158:   vertical-align: top;
                   8159: }
                   8160: 
1.591     raeburn  8161: div.LC_left_float {
                   8162:   float: left;
                   8163:   padding-right: 5%;
1.597     albertel 8164:   padding-bottom: 4px;
1.591     raeburn  8165: }
                   8166: 
                   8167: div.LC_clear_float_header {
1.597     albertel 8168:   padding-bottom: 2px;
1.591     raeburn  8169: }
                   8170: 
                   8171: div.LC_clear_float_footer {
1.597     albertel 8172:   padding-top: 10px;
1.591     raeburn  8173:   clear: both;
                   8174: }
                   8175: 
1.597     albertel 8176: div.LC_grade_show_user {
1.941     bisitz   8177: /*  border-left: 5px solid $sidebg; */
                   8178:   border-top: 5px solid #000000;
                   8179:   margin: 50px 0 0 0;
1.936     bisitz   8180:   padding: 15px 0 5px 10px;
1.597     albertel 8181: }
1.795     www      8182: 
1.936     bisitz   8183: div.LC_grade_show_user_odd_row {
1.941     bisitz   8184: /*  border-left: 5px solid #000000; */
                   8185: }
                   8186: 
                   8187: div.LC_grade_show_user div.LC_Box {
                   8188:   margin-right: 50px;
1.597     albertel 8189: }
                   8190: 
                   8191: div.LC_grade_submissions,
                   8192: div.LC_grade_message_center,
1.936     bisitz   8193: div.LC_grade_info_links {
1.597     albertel 8194:   margin: 5px;
                   8195:   width: 99%;
                   8196:   background: #FFFFFF;
                   8197: }
1.795     www      8198: 
1.597     albertel 8199: div.LC_grade_submissions_header,
1.936     bisitz   8200: div.LC_grade_message_center_header {
1.705     tempelho 8201:   font-weight: bold;
                   8202:   font-size: large;
1.597     albertel 8203: }
1.795     www      8204: 
1.597     albertel 8205: div.LC_grade_submissions_body,
1.936     bisitz   8206: div.LC_grade_message_center_body {
1.597     albertel 8207:   border: 1px solid black;
                   8208:   width: 99%;
                   8209:   background: #FFFFFF;
                   8210: }
1.795     www      8211: 
1.613     albertel 8212: table.LC_scantron_action {
                   8213:   width: 100%;
                   8214: }
1.795     www      8215: 
1.613     albertel 8216: table.LC_scantron_action tr th {
1.698     harmsja  8217:   font-weight:bold;
                   8218:   font-style:normal;
1.613     albertel 8219: }
1.795     www      8220: 
1.779     bisitz   8221: .LC_edit_problem_header,
1.614     albertel 8222: div.LC_edit_problem_footer {
1.705     tempelho 8223:   font-weight: normal;
                   8224:   font-size:  medium;
1.602     albertel 8225:   margin: 2px;
1.1060    bisitz   8226:   background-color: $sidebg;
1.600     albertel 8227: }
1.795     www      8228: 
1.600     albertel 8229: div.LC_edit_problem_header,
1.602     albertel 8230: div.LC_edit_problem_header div,
1.614     albertel 8231: div.LC_edit_problem_footer,
                   8232: div.LC_edit_problem_footer div,
1.602     albertel 8233: div.LC_edit_problem_editxml_header,
                   8234: div.LC_edit_problem_editxml_header div {
1.1205    golterma 8235:   z-index: 100;
1.600     albertel 8236: }
1.795     www      8237: 
1.600     albertel 8238: div.LC_edit_problem_header_title {
1.705     tempelho 8239:   font-weight: bold;
                   8240:   font-size: larger;
1.602     albertel 8241:   background: $tabbg;
                   8242:   padding: 3px;
1.1060    bisitz   8243:   margin: 0 0 5px 0;
1.602     albertel 8244: }
1.795     www      8245: 
1.602     albertel 8246: table.LC_edit_problem_header_title {
                   8247:   width: 100%;
1.600     albertel 8248:   background: $tabbg;
1.602     albertel 8249: }
                   8250: 
1.1205    golterma 8251: div.LC_edit_actionbar {
                   8252:     background-color: $sidebg;
1.1218    droeschl 8253:     margin: 0;
                   8254:     padding: 0;
                   8255:     line-height: 200%;
1.602     albertel 8256: }
1.795     www      8257: 
1.1218    droeschl 8258: div.LC_edit_actionbar div{
                   8259:     padding: 0;
                   8260:     margin: 0;
                   8261:     display: inline-block;
1.600     albertel 8262: }
1.795     www      8263: 
1.1124    bisitz   8264: .LC_edit_opt {
                   8265:   padding-left: 1em;
                   8266:   white-space: nowrap;
                   8267: }
                   8268: 
1.1152    golterma 8269: .LC_edit_problem_latexhelper{
                   8270:     text-align: right;
                   8271: }
                   8272: 
                   8273: #LC_edit_problem_colorful div{
                   8274:     margin-left: 40px;
                   8275: }
                   8276: 
1.1205    golterma 8277: #LC_edit_problem_codemirror div{
                   8278:     margin-left: 0px;
                   8279: }
                   8280: 
1.911     bisitz   8281: img.stift {
1.803     bisitz   8282:   border-width: 0;
                   8283:   vertical-align: middle;
1.677     riegler  8284: }
1.680     riegler  8285: 
1.923     bisitz   8286: table td.LC_mainmenu_col_fieldset {
1.680     riegler  8287:   vertical-align: top;
1.777     tempelho 8288: }
1.795     www      8289: 
1.716     raeburn  8290: div.LC_createcourse {
1.911     bisitz   8291:   margin: 10px 10px 10px 10px;
1.716     raeburn  8292: }
                   8293: 
1.917     raeburn  8294: .LC_dccid {
1.1130    raeburn  8295:   float: right;
1.917     raeburn  8296:   margin: 0.2em 0 0 0;
                   8297:   padding: 0;
                   8298:   font-size: 90%;
                   8299:   display:none;
                   8300: }
                   8301: 
1.897     wenzelju 8302: ol.LC_primary_menu a:hover,
1.721     harmsja  8303: ol#LC_MenuBreadcrumbs a:hover,
                   8304: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 8305: ul#LC_secondary_menu a:hover,
1.721     harmsja  8306: .LC_FormSectionClearButton input:hover
1.795     www      8307: ul.LC_TabContent   li:hover a {
1.952     onken    8308:   color:$button_hover;
1.911     bisitz   8309:   text-decoration:none;
1.693     droeschl 8310: }
                   8311: 
1.779     bisitz   8312: h1 {
1.911     bisitz   8313:   padding: 0;
                   8314:   line-height:130%;
1.693     droeschl 8315: }
1.698     harmsja  8316: 
1.911     bisitz   8317: h2,
                   8318: h3,
                   8319: h4,
                   8320: h5,
                   8321: h6 {
                   8322:   margin: 5px 0 5px 0;
                   8323:   padding: 0;
                   8324:   line-height:130%;
1.693     droeschl 8325: }
1.795     www      8326: 
                   8327: .LC_hcell {
1.911     bisitz   8328:   padding:3px 15px 3px 15px;
                   8329:   margin: 0;
                   8330:   background-color:$tabbg;
                   8331:   color:$fontmenu;
                   8332:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 8333: }
1.795     www      8334: 
1.840     bisitz   8335: .LC_Box > .LC_hcell {
1.911     bisitz   8336:   margin: 0 -10px 10px -10px;
1.835     bisitz   8337: }
                   8338: 
1.721     harmsja  8339: .LC_noBorder {
1.911     bisitz   8340:   border: 0;
1.698     harmsja  8341: }
1.693     droeschl 8342: 
1.721     harmsja  8343: .LC_FormSectionClearButton input {
1.911     bisitz   8344:   background-color:transparent;
                   8345:   border: none;
                   8346:   cursor:pointer;
                   8347:   text-decoration:underline;
1.693     droeschl 8348: }
1.763     bisitz   8349: 
                   8350: .LC_help_open_topic {
1.911     bisitz   8351:   color: #FFFFFF;
                   8352:   background-color: #EEEEFF;
                   8353:   margin: 1px;
                   8354:   padding: 4px;
                   8355:   border: 1px solid #000033;
                   8356:   white-space: nowrap;
                   8357:   /* vertical-align: middle; */
1.759     neumanie 8358: }
1.693     droeschl 8359: 
1.911     bisitz   8360: dl,
                   8361: ul,
                   8362: div,
                   8363: fieldset {
                   8364:   margin: 10px 10px 10px 0;
                   8365:   /* overflow: hidden; */
1.693     droeschl 8366: }
1.795     www      8367: 
1.1404    raeburn  8368: fieldset#LC_selectuser {
                   8369:     margin: 0;
                   8370:     padding: 0;
                   8371: }
                   8372: 
1.1211    raeburn  8373: article.geogebraweb div {
                   8374:     margin: 0;
                   8375: }
                   8376: 
1.838     bisitz   8377: fieldset > legend {
1.911     bisitz   8378:   font-weight: bold;
                   8379:   padding: 0 5px 0 5px;
1.838     bisitz   8380: }
                   8381: 
1.813     bisitz   8382: #LC_nav_bar {
1.911     bisitz   8383:   float: left;
1.995     raeburn  8384:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   8385:   margin: 0 0 2px 0;
1.807     droeschl 8386: }
                   8387: 
1.916     droeschl 8388: #LC_realm {
                   8389:   margin: 0.2em 0 0 0;
                   8390:   padding: 0;
                   8391:   font-weight: bold;
                   8392:   text-align: center;
1.995     raeburn  8393:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 8394: }
                   8395: 
1.911     bisitz   8396: #LC_nav_bar em {
                   8397:   font-weight: bold;
                   8398:   font-style: normal;
1.807     droeschl 8399: }
                   8400: 
1.897     wenzelju 8401: ol.LC_primary_menu {
1.934     droeschl 8402:   margin: 0;
1.1076    raeburn  8403:   padding: 0;
1.807     droeschl 8404: }
                   8405: 
1.852     droeschl 8406: ol#LC_PathBreadcrumbs {
1.911     bisitz   8407:   margin: 0;
1.693     droeschl 8408: }
                   8409: 
1.897     wenzelju 8410: ol.LC_primary_menu li {
1.1076    raeburn  8411:   color: RGB(80, 80, 80);
                   8412:   vertical-align: middle;
                   8413:   text-align: left;
                   8414:   list-style: none;
1.1205    golterma 8415:   position: relative;
1.1076    raeburn  8416:   float: left;
1.1205    golterma 8417:   z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
                   8418:   line-height: 1.5em;
1.1076    raeburn  8419: }
                   8420: 
1.1205    golterma 8421: ol.LC_primary_menu li a,
                   8422: ol.LC_primary_menu li p {
1.1076    raeburn  8423:   display: block;
                   8424:   margin: 0;
                   8425:   padding: 0 5px 0 10px;
                   8426:   text-decoration: none;
                   8427: }
                   8428: 
1.1205    golterma 8429: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
                   8430:   display: inline-block;
                   8431:   width: 95%;
                   8432:   text-align: left;
                   8433: }
                   8434: 
                   8435: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
                   8436:   display: inline-block;	
                   8437:   width: 5%;
                   8438:   float: right;
                   8439:   text-align: right;
                   8440:   font-size: 70%;
                   8441: }
                   8442: 
                   8443: ol.LC_primary_menu ul {
1.1076    raeburn  8444:   display: none;
1.1205    golterma 8445:   width: 15em;
1.1076    raeburn  8446:   background-color: $data_table_light;
1.1205    golterma 8447:   position: absolute;
                   8448:   top: 100%;
1.1076    raeburn  8449: }
                   8450: 
1.1205    golterma 8451: ol.LC_primary_menu ul ul {
                   8452:   left: 100%;
                   8453:   top: 0;
                   8454: }
                   8455: 
                   8456: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076    raeburn  8457:   display: block;
                   8458:   position: absolute;
                   8459:   margin: 0;
                   8460:   padding: 0;
1.1078    raeburn  8461:   z-index: 2;
1.1076    raeburn  8462: }
                   8463: 
                   8464: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205    golterma 8465: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076    raeburn  8466:   font-size: 90%;
1.911     bisitz   8467:   vertical-align: top;
1.1076    raeburn  8468:   float: none;
1.1079    raeburn  8469:   border-left: 1px solid black;
                   8470:   border-right: 1px solid black;
1.1205    golterma 8471: /* A dark bottom border to visualize different menu options; 
                   8472: overwritten in the create_submenu routine for the last border-bottom of the menu */
                   8473:   border-bottom: 1px solid $data_table_dark; 
1.1076    raeburn  8474: }
                   8475: 
1.1205    golterma 8476: ol.LC_primary_menu li li p:hover {
                   8477:   color:$button_hover;
                   8478:   text-decoration:none;
                   8479:   background-color:$data_table_dark;
1.1076    raeburn  8480: }
                   8481: 
                   8482: ol.LC_primary_menu li li a:hover {
                   8483:    color:$button_hover;
                   8484:    background-color:$data_table_dark;
1.693     droeschl 8485: }
                   8486: 
1.1205    golterma 8487: /* Font-size equal to the size of the predecessors*/
                   8488: ol.LC_primary_menu li:hover li li {
                   8489:   font-size: 100%;
                   8490: }
                   8491: 
1.897     wenzelju 8492: ol.LC_primary_menu li img {
1.911     bisitz   8493:   vertical-align: bottom;
1.934     droeschl 8494:   height: 1.1em;
1.1077    raeburn  8495:   margin: 0.2em 0 0 0;
1.693     droeschl 8496: }
                   8497: 
1.897     wenzelju 8498: ol.LC_primary_menu a {
1.911     bisitz   8499:   color: RGB(80, 80, 80);
                   8500:   text-decoration: none;
1.693     droeschl 8501: }
1.795     www      8502: 
1.949     droeschl 8503: ol.LC_primary_menu a.LC_new_message {
                   8504:   font-weight:bold;
                   8505:   color: darkred;
                   8506: }
                   8507: 
1.975     raeburn  8508: ol.LC_docs_parameters {
                   8509:   margin-left: 0;
                   8510:   padding: 0;
                   8511:   list-style: none;
                   8512: }
                   8513: 
                   8514: ol.LC_docs_parameters li {
                   8515:   margin: 0;
                   8516:   padding-right: 20px;
                   8517:   display: inline;
                   8518: }
                   8519: 
1.976     raeburn  8520: ol.LC_docs_parameters li:before {
                   8521:   content: "\\002022 \\0020";
                   8522: }
                   8523: 
                   8524: li.LC_docs_parameters_title {
                   8525:   font-weight: bold;
                   8526: }
                   8527: 
                   8528: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   8529:   content: "";
                   8530: }
                   8531: 
1.897     wenzelju 8532: ul#LC_secondary_menu {
1.1107    raeburn  8533:   clear: right;
1.911     bisitz   8534:   color: $fontmenu;
                   8535:   background: $tabbg;
                   8536:   list-style: none;
                   8537:   padding: 0;
                   8538:   margin: 0;
                   8539:   width: 100%;
1.995     raeburn  8540:   text-align: left;
1.1107    raeburn  8541:   float: left;
1.808     droeschl 8542: }
                   8543: 
1.897     wenzelju 8544: ul#LC_secondary_menu li {
1.911     bisitz   8545:   font-weight: bold;
                   8546:   line-height: 1.8em;
1.1107    raeburn  8547:   border-right: 1px solid black;
                   8548:   float: left;
                   8549: }
                   8550: 
                   8551: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   8552:   background-color: $data_table_light;
                   8553: }
                   8554: 
                   8555: ul#LC_secondary_menu li a {
1.911     bisitz   8556:   padding: 0 0.8em;
1.1107    raeburn  8557: }
                   8558: 
                   8559: ul#LC_secondary_menu li ul {
                   8560:   display: none;
                   8561: }
                   8562: 
                   8563: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   8564:   display: block;
                   8565:   position: absolute;
                   8566:   margin: 0;
                   8567:   padding: 0;
                   8568:   list-style:none;
                   8569:   float: none;
                   8570:   background-color: $data_table_light;
                   8571:   z-index: 2;
                   8572:   margin-left: -1px;
                   8573: }
                   8574: 
                   8575: ul#LC_secondary_menu li ul li {
                   8576:   font-size: 90%;
                   8577:   vertical-align: top;
                   8578:   border-left: 1px solid black;
1.911     bisitz   8579:   border-right: 1px solid black;
1.1119    raeburn  8580:   background-color: $data_table_light;
1.1107    raeburn  8581:   list-style:none;
                   8582:   float: none;
                   8583: }
                   8584: 
                   8585: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   8586:   background-color: $data_table_dark;
1.807     droeschl 8587: }
                   8588: 
1.847     tempelho 8589: ul.LC_TabContent {
1.911     bisitz   8590:   display:block;
                   8591:   background: $sidebg;
                   8592:   border-bottom: solid 1px $lg_border_color;
                   8593:   list-style:none;
1.1020    raeburn  8594:   margin: -1px -10px 0 -10px;
1.911     bisitz   8595:   padding: 0;
1.693     droeschl 8596: }
                   8597: 
1.795     www      8598: ul.LC_TabContent li,
                   8599: ul.LC_TabContentBigger li {
1.911     bisitz   8600:   float:left;
1.741     harmsja  8601: }
1.795     www      8602: 
1.897     wenzelju 8603: ul#LC_secondary_menu li a {
1.911     bisitz   8604:   color: $fontmenu;
                   8605:   text-decoration: none;
1.693     droeschl 8606: }
1.795     www      8607: 
1.721     harmsja  8608: ul.LC_TabContent {
1.952     onken    8609:   min-height:20px;
1.721     harmsja  8610: }
1.795     www      8611: 
                   8612: ul.LC_TabContent li {
1.911     bisitz   8613:   vertical-align:middle;
1.959     onken    8614:   padding: 0 16px 0 10px;
1.911     bisitz   8615:   background-color:$tabbg;
                   8616:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  8617:   border-left: solid 1px $font;
1.721     harmsja  8618: }
1.795     www      8619: 
1.847     tempelho 8620: ul.LC_TabContent .right {
1.911     bisitz   8621:   float:right;
1.847     tempelho 8622: }
                   8623: 
1.911     bisitz   8624: ul.LC_TabContent li a,
                   8625: ul.LC_TabContent li {
                   8626:   color:rgb(47,47,47);
                   8627:   text-decoration:none;
                   8628:   font-size:95%;
                   8629:   font-weight:bold;
1.952     onken    8630:   min-height:20px;
                   8631: }
                   8632: 
1.959     onken    8633: ul.LC_TabContent li a:hover,
                   8634: ul.LC_TabContent li a:focus {
1.952     onken    8635:   color: $button_hover;
1.959     onken    8636:   background:none;
                   8637:   outline:none;
1.952     onken    8638: }
                   8639: 
                   8640: ul.LC_TabContent li:hover {
                   8641:   color: $button_hover;
                   8642:   cursor:pointer;
1.721     harmsja  8643: }
1.795     www      8644: 
1.911     bisitz   8645: ul.LC_TabContent li.active {
1.952     onken    8646:   color: $font;
1.911     bisitz   8647:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    8648:   border-bottom:solid 1px #FFFFFF;
                   8649:   cursor: default;
1.744     ehlerst  8650: }
1.795     www      8651: 
1.959     onken    8652: ul.LC_TabContent li.active a {
                   8653:   color:$font;
                   8654:   background:#FFFFFF;
                   8655:   outline: none;
                   8656: }
1.1047    raeburn  8657: 
                   8658: ul.LC_TabContent li.goback {
                   8659:   float: left;
                   8660:   border-left: none;
                   8661: }
                   8662: 
1.870     tempelho 8663: #maincoursedoc {
1.911     bisitz   8664:   clear:both;
1.870     tempelho 8665: }
                   8666: 
                   8667: ul.LC_TabContentBigger {
1.911     bisitz   8668:   display:block;
                   8669:   list-style:none;
                   8670:   padding: 0;
1.870     tempelho 8671: }
                   8672: 
1.795     www      8673: ul.LC_TabContentBigger li {
1.911     bisitz   8674:   vertical-align:bottom;
                   8675:   height: 30px;
                   8676:   font-size:110%;
                   8677:   font-weight:bold;
                   8678:   color: #737373;
1.841     tempelho 8679: }
                   8680: 
1.957     onken    8681: ul.LC_TabContentBigger li.active {
                   8682:   position: relative;
                   8683:   top: 1px;
                   8684: }
                   8685: 
1.870     tempelho 8686: ul.LC_TabContentBigger li a {
1.911     bisitz   8687:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   8688:   height: 30px;
                   8689:   line-height: 30px;
                   8690:   text-align: center;
                   8691:   display: block;
                   8692:   text-decoration: none;
1.958     onken    8693:   outline: none;  
1.741     harmsja  8694: }
1.795     www      8695: 
1.870     tempelho 8696: ul.LC_TabContentBigger li.active a {
1.911     bisitz   8697:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   8698:   color:$font;
1.744     ehlerst  8699: }
1.795     www      8700: 
1.870     tempelho 8701: ul.LC_TabContentBigger li b {
1.911     bisitz   8702:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   8703:   display: block;
                   8704:   float: left;
                   8705:   padding: 0 30px;
1.957     onken    8706:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 8707: }
                   8708: 
1.956     onken    8709: ul.LC_TabContentBigger li:hover b {
                   8710:   color:$button_hover;
                   8711: }
                   8712: 
1.870     tempelho 8713: ul.LC_TabContentBigger li.active b {
1.911     bisitz   8714:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   8715:   color:$font;
1.957     onken    8716:   border: 0;
1.741     harmsja  8717: }
1.693     droeschl 8718: 
1.870     tempelho 8719: 
1.862     bisitz   8720: ul.LC_CourseBreadcrumbs {
                   8721:   background: $sidebg;
1.1020    raeburn  8722:   height: 2em;
1.862     bisitz   8723:   padding-left: 10px;
1.1020    raeburn  8724:   margin: 0;
1.862     bisitz   8725:   list-style-position: inside;
                   8726: }
                   8727: 
1.911     bisitz   8728: ol#LC_MenuBreadcrumbs,
1.862     bisitz   8729: ol#LC_PathBreadcrumbs {
1.911     bisitz   8730:   padding-left: 10px;
                   8731:   margin: 0;
1.933     droeschl 8732:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 8733: }
                   8734: 
1.911     bisitz   8735: ol#LC_MenuBreadcrumbs li,
                   8736: ol#LC_PathBreadcrumbs li,
1.862     bisitz   8737: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   8738:   display: inline;
1.933     droeschl 8739:   white-space: normal;  
1.693     droeschl 8740: }
                   8741: 
1.823     bisitz   8742: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   8743: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   8744:   text-decoration: none;
                   8745:   font-size:90%;
1.693     droeschl 8746: }
1.795     www      8747: 
1.969     droeschl 8748: ol#LC_MenuBreadcrumbs h1 {
                   8749:   display: inline;
                   8750:   font-size: 90%;
                   8751:   line-height: 2.5em;
                   8752:   margin: 0;
                   8753:   padding: 0;
                   8754: }
                   8755: 
1.795     www      8756: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   8757:   text-decoration:none;
                   8758:   font-size:100%;
                   8759:   font-weight:bold;
1.693     droeschl 8760: }
1.795     www      8761: 
1.840     bisitz   8762: .LC_Box {
1.911     bisitz   8763:   border: solid 1px $lg_border_color;
                   8764:   padding: 0 10px 10px 10px;
1.746     neumanie 8765: }
1.795     www      8766: 
1.1020    raeburn  8767: .LC_DocsBox {
                   8768:   border: solid 1px $lg_border_color;
                   8769:   padding: 0 0 10px 10px;
                   8770: }
                   8771: 
1.795     www      8772: .LC_AboutMe_Image {
1.911     bisitz   8773:   float:left;
                   8774:   margin-right:10px;
1.747     neumanie 8775: }
1.795     www      8776: 
                   8777: .LC_Clear_AboutMe_Image {
1.911     bisitz   8778:   clear:left;
1.747     neumanie 8779: }
1.795     www      8780: 
1.721     harmsja  8781: dl.LC_ListStyleClean dt {
1.911     bisitz   8782:   padding-right: 5px;
                   8783:   display: table-header-group;
1.693     droeschl 8784: }
                   8785: 
1.721     harmsja  8786: dl.LC_ListStyleClean dd {
1.911     bisitz   8787:   display: table-row;
1.693     droeschl 8788: }
                   8789: 
1.721     harmsja  8790: .LC_ListStyleClean,
                   8791: .LC_ListStyleSimple,
                   8792: .LC_ListStyleNormal,
1.795     www      8793: .LC_ListStyleSpecial {
1.911     bisitz   8794:   /* display:block; */
                   8795:   list-style-position: inside;
                   8796:   list-style-type: none;
                   8797:   overflow: hidden;
                   8798:   padding: 0;
1.693     droeschl 8799: }
                   8800: 
1.721     harmsja  8801: .LC_ListStyleSimple li,
                   8802: .LC_ListStyleSimple dd,
                   8803: .LC_ListStyleNormal li,
                   8804: .LC_ListStyleNormal dd,
                   8805: .LC_ListStyleSpecial li,
1.795     www      8806: .LC_ListStyleSpecial dd {
1.911     bisitz   8807:   margin: 0;
                   8808:   padding: 5px 5px 5px 10px;
                   8809:   clear: both;
1.693     droeschl 8810: }
                   8811: 
1.721     harmsja  8812: .LC_ListStyleClean li,
                   8813: .LC_ListStyleClean dd {
1.911     bisitz   8814:   padding-top: 0;
                   8815:   padding-bottom: 0;
1.693     droeschl 8816: }
                   8817: 
1.721     harmsja  8818: .LC_ListStyleSimple dd,
1.795     www      8819: .LC_ListStyleSimple li {
1.911     bisitz   8820:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 8821: }
                   8822: 
1.721     harmsja  8823: .LC_ListStyleSpecial li,
                   8824: .LC_ListStyleSpecial dd {
1.911     bisitz   8825:   list-style-type: none;
                   8826:   background-color: RGB(220, 220, 220);
                   8827:   margin-bottom: 4px;
1.693     droeschl 8828: }
                   8829: 
1.721     harmsja  8830: table.LC_SimpleTable {
1.911     bisitz   8831:   margin:5px;
                   8832:   border:solid 1px $lg_border_color;
1.795     www      8833: }
1.693     droeschl 8834: 
1.721     harmsja  8835: table.LC_SimpleTable tr {
1.911     bisitz   8836:   padding: 0;
                   8837:   border:solid 1px $lg_border_color;
1.693     droeschl 8838: }
1.795     www      8839: 
                   8840: table.LC_SimpleTable thead {
1.911     bisitz   8841:   background:rgb(220,220,220);
1.693     droeschl 8842: }
                   8843: 
1.721     harmsja  8844: div.LC_columnSection {
1.911     bisitz   8845:   display: block;
                   8846:   clear: both;
                   8847:   overflow: hidden;
                   8848:   margin: 0;
1.693     droeschl 8849: }
                   8850: 
1.721     harmsja  8851: div.LC_columnSection>* {
1.911     bisitz   8852:   float: left;
                   8853:   margin: 10px 20px 10px 0;
                   8854:   overflow:hidden;
1.693     droeschl 8855: }
1.721     harmsja  8856: 
1.795     www      8857: table em {
1.911     bisitz   8858:   font-weight: bold;
                   8859:   font-style: normal;
1.748     schulted 8860: }
1.795     www      8861: 
1.779     bisitz   8862: table.LC_tableBrowseRes,
1.795     www      8863: table.LC_tableOfContent {
1.911     bisitz   8864:   border:none;
                   8865:   border-spacing: 1px;
                   8866:   padding: 3px;
                   8867:   background-color: #FFFFFF;
                   8868:   font-size: 90%;
1.753     droeschl 8869: }
1.789     droeschl 8870: 
1.911     bisitz   8871: table.LC_tableOfContent {
                   8872:   border-collapse: collapse;
1.789     droeschl 8873: }
                   8874: 
1.771     droeschl 8875: table.LC_tableBrowseRes a,
1.768     schulted 8876: table.LC_tableOfContent a {
1.911     bisitz   8877:   background-color: transparent;
                   8878:   text-decoration: none;
1.753     droeschl 8879: }
                   8880: 
1.795     www      8881: table.LC_tableOfContent img {
1.911     bisitz   8882:   border: none;
                   8883:   height: 1.3em;
                   8884:   vertical-align: text-bottom;
                   8885:   margin-right: 0.3em;
1.753     droeschl 8886: }
1.757     schulted 8887: 
1.795     www      8888: a#LC_content_toolbar_firsthomework {
1.911     bisitz   8889:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  8890: }
                   8891: 
1.795     www      8892: a#LC_content_toolbar_everything {
1.911     bisitz   8893:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  8894: }
                   8895: 
1.795     www      8896: a#LC_content_toolbar_uncompleted {
1.911     bisitz   8897:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  8898: }
                   8899: 
1.795     www      8900: #LC_content_toolbar_clearbubbles {
1.911     bisitz   8901:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  8902: }
                   8903: 
1.795     www      8904: a#LC_content_toolbar_changefolder {
1.911     bisitz   8905:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 8906: }
                   8907: 
1.795     www      8908: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   8909:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 8910: }
                   8911: 
1.1043    raeburn  8912: a#LC_content_toolbar_edittoplevel {
                   8913:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   8914: }
                   8915: 
1.1384    raeburn  8916: a#LC_content_toolbar_printout {
                   8917:   background-image:url(/res/adm/pages/printout.gif);
                   8918: }
                   8919: 
1.795     www      8920: ul#LC_toolbar li a:hover {
1.911     bisitz   8921:   background-position: bottom center;
1.757     schulted 8922: }
                   8923: 
1.795     www      8924: ul#LC_toolbar {
1.911     bisitz   8925:   padding: 0;
                   8926:   margin: 2px;
                   8927:   list-style:none;
                   8928:   position:relative;
                   8929:   background-color:white;
1.1082    raeburn  8930:   overflow: auto;
1.757     schulted 8931: }
                   8932: 
1.795     www      8933: ul#LC_toolbar li {
1.911     bisitz   8934:   border:1px solid white;
                   8935:   padding: 0;
                   8936:   margin: 0;
                   8937:   float: left;
                   8938:   display:inline;
                   8939:   vertical-align:middle;
1.1082    raeburn  8940:   white-space: nowrap;
1.911     bisitz   8941: }
1.757     schulted 8942: 
1.783     amueller 8943: 
1.795     www      8944: a.LC_toolbarItem {
1.911     bisitz   8945:   display:block;
                   8946:   padding: 0;
                   8947:   margin: 0;
                   8948:   height: 32px;
                   8949:   width: 32px;
                   8950:   color:white;
                   8951:   border: none;
                   8952:   background-repeat:no-repeat;
                   8953:   background-color:transparent;
1.757     schulted 8954: }
                   8955: 
1.915     droeschl 8956: ul.LC_funclist {
                   8957:     margin: 0;
                   8958:     padding: 0.5em 1em 0.5em 0;
                   8959: }
                   8960: 
1.933     droeschl 8961: ul.LC_funclist > li:first-child {
                   8962:     font-weight:bold; 
                   8963:     margin-left:0.8em;
                   8964: }
                   8965: 
1.915     droeschl 8966: ul.LC_funclist + ul.LC_funclist {
                   8967:     /* 
                   8968:        left border as a seperator if we have more than
                   8969:        one list 
                   8970:     */
                   8971:     border-left: 1px solid $sidebg;
                   8972:     /* 
                   8973:        this hides the left border behind the border of the 
                   8974:        outer box if element is wrapped to the next 'line' 
                   8975:     */
                   8976:     margin-left: -1px;
                   8977: }
                   8978: 
1.843     bisitz   8979: ul.LC_funclist li {
1.915     droeschl 8980:   display: inline;
1.782     bisitz   8981:   white-space: nowrap;
1.915     droeschl 8982:   margin: 0 0 0 25px;
                   8983:   line-height: 150%;
1.782     bisitz   8984: }
                   8985: 
1.974     wenzelju 8986: .LC_hidden {
                   8987:   display: none;
                   8988: }
                   8989: 
1.1030    www      8990: .LCmodal-overlay {
                   8991: 		position:fixed;
                   8992: 		top:0;
                   8993: 		right:0;
                   8994: 		bottom:0;
                   8995: 		left:0;
                   8996: 		height:100%;
                   8997: 		width:100%;
                   8998: 		margin:0;
                   8999: 		padding:0;
                   9000: 		background:#999;
                   9001: 		opacity:.75;
                   9002: 		filter: alpha(opacity=75);
                   9003: 		-moz-opacity: 0.75;
                   9004: 		z-index:101;
                   9005: }
                   9006: 
                   9007: * html .LCmodal-overlay {   
                   9008: 		position: absolute;
                   9009: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   9010: }
                   9011: 
                   9012: .LCmodal-window {
                   9013: 		position:fixed;
                   9014: 		top:50%;
                   9015: 		left:50%;
                   9016: 		margin:0;
                   9017: 		padding:0;
                   9018: 		z-index:102;
                   9019: 	}
                   9020: 
                   9021: * html .LCmodal-window {
                   9022: 		position:absolute;
                   9023: }
                   9024: 
                   9025: .LCclose-window {
                   9026: 		position:absolute;
                   9027: 		width:32px;
                   9028: 		height:32px;
                   9029: 		right:8px;
                   9030: 		top:8px;
                   9031: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   9032: 		text-indent:-99999px;
                   9033: 		overflow:hidden;
                   9034: 		cursor:pointer;
                   9035: }
                   9036: 
1.1369    raeburn  9037: .LCisDisabled {
                   9038:   cursor: not-allowed;
                   9039:   opacity: 0.5;
                   9040: }
                   9041: 
                   9042: a[aria-disabled="true"] {
                   9043:   color: currentColor;
                   9044:   display: inline-block;  /* For IE11/ MS Edge bug */
                   9045:   pointer-events: none;
                   9046:   text-decoration: none;
                   9047: }
                   9048: 
1.1335    raeburn  9049: pre.LC_wordwrap {
                   9050:   white-space: pre-wrap;
                   9051:   white-space: -moz-pre-wrap;
                   9052:   white-space: -pre-wrap;
                   9053:   white-space: -o-pre-wrap;
                   9054:   word-wrap: break-word;
                   9055: }
                   9056: 
1.1100    raeburn  9057: /*
1.1231    damieng  9058:   styles used for response display
                   9059: */
                   9060: div.LC_radiofoil, div.LC_rankfoil {
                   9061:   margin: .5em 0em .5em 0em;
                   9062: }
                   9063: table.LC_itemgroup {
                   9064:   margin-top: 1em;
                   9065: }
                   9066: 
                   9067: /*
1.1100    raeburn  9068:   styles used by TTH when "Default set of options to pass to tth/m
                   9069:   when converting TeX" in course settings has been set
                   9070: 
                   9071:   option passed: -t
                   9072: 
                   9073: */
                   9074: 
                   9075: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   9076: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   9077: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   9078: td div.norm {line-height:normal;}
                   9079: 
                   9080: /*
                   9081:   option passed -y3
                   9082: */
                   9083: 
                   9084: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   9085: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   9086: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   9087: 
1.1230    damieng  9088: /*
                   9089:   sections with roles, for content only
                   9090: */
                   9091: section[class^="role-"] {
                   9092:   padding-left: 10px;
                   9093:   padding-right: 5px;
                   9094:   margin-top: 8px;
                   9095:   margin-bottom: 8px;
                   9096:   border: 1px solid #2A4;
                   9097:   border-radius: 5px;
                   9098:   box-shadow: 0px 1px 1px #BBB;
                   9099: }
                   9100: section[class^="role-"]>h1 {
                   9101:   position: relative;
                   9102:   margin: 0px;
                   9103:   padding-top: 10px;
                   9104:   padding-left: 40px;
                   9105: }
                   9106: section[class^="role-"]>h1:before {
                   9107:   position: absolute;
                   9108:   left: -5px;
                   9109:   top: 5px;
                   9110: }
                   9111: section.role-activity>h1:before {
                   9112:   content:url('/adm/daxe/images/section_icons/activity.png');
                   9113: }
                   9114: section.role-advice>h1:before {
                   9115:   content:url('/adm/daxe/images/section_icons/advice.png');
                   9116: }
                   9117: section.role-bibliography>h1:before {
                   9118:   content:url('/adm/daxe/images/section_icons/bibliography.png');
                   9119: }
                   9120: section.role-citation>h1:before {
                   9121:   content:url('/adm/daxe/images/section_icons/citation.png');
                   9122: }
                   9123: section.role-conclusion>h1:before {
                   9124:   content:url('/adm/daxe/images/section_icons/conclusion.png');
                   9125: }
                   9126: section.role-definition>h1:before {
                   9127:   content:url('/adm/daxe/images/section_icons/definition.png');
                   9128: }
                   9129: section.role-demonstration>h1:before {
                   9130:   content:url('/adm/daxe/images/section_icons/demonstration.png');
                   9131: }
                   9132: section.role-example>h1:before {
                   9133:   content:url('/adm/daxe/images/section_icons/example.png');
                   9134: }
                   9135: section.role-explanation>h1:before {
                   9136:   content:url('/adm/daxe/images/section_icons/explanation.png');
                   9137: }
                   9138: section.role-introduction>h1:before {
                   9139:   content:url('/adm/daxe/images/section_icons/introduction.png');
                   9140: }
                   9141: section.role-method>h1:before {
                   9142:   content:url('/adm/daxe/images/section_icons/method.png');
                   9143: }
                   9144: section.role-more_information>h1:before {
                   9145:   content:url('/adm/daxe/images/section_icons/more_information.png');
                   9146: }
                   9147: section.role-objectives>h1:before {
                   9148:   content:url('/adm/daxe/images/section_icons/objectives.png');
                   9149: }
                   9150: section.role-prerequisites>h1:before {
                   9151:   content:url('/adm/daxe/images/section_icons/prerequisites.png');
                   9152: }
                   9153: section.role-remark>h1:before {
                   9154:   content:url('/adm/daxe/images/section_icons/remark.png');
                   9155: }
                   9156: section.role-reminder>h1:before {
                   9157:   content:url('/adm/daxe/images/section_icons/reminder.png');
                   9158: }
                   9159: section.role-summary>h1:before {
                   9160:   content:url('/adm/daxe/images/section_icons/summary.png');
                   9161: }
                   9162: section.role-syntax>h1:before {
                   9163:   content:url('/adm/daxe/images/section_icons/syntax.png');
                   9164: }
                   9165: section.role-warning>h1:before {
                   9166:   content:url('/adm/daxe/images/section_icons/warning.png');
                   9167: }
                   9168: 
1.1269    raeburn  9169: #LC_minitab_header {
                   9170:   float:left;
                   9171:   width:100%;
                   9172:   background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
                   9173:   font-size:93%;
                   9174:   line-height:normal;
                   9175:   margin: 0.5em 0 0.5em 0;
                   9176: }
                   9177: #LC_minitab_header ul {
                   9178:   margin:0;
                   9179:   padding:10px 10px 0;
                   9180:   list-style:none;
                   9181: }
                   9182: #LC_minitab_header li {
                   9183:   float:left;
                   9184:   background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
                   9185:   margin:0;
                   9186:   padding:0 0 0 9px;
                   9187: }
                   9188: #LC_minitab_header a {
                   9189:   display:block;
                   9190:   background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
                   9191:   padding:5px 15px 4px 6px;
                   9192: }
                   9193: #LC_minitab_header #LC_current_minitab {
                   9194:   background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
                   9195: }
                   9196: #LC_minitab_header #LC_current_minitab a {
                   9197:   background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
                   9198:   padding-bottom:5px;
                   9199: }
                   9200: 
                   9201: 
1.343     albertel 9202: END
                   9203: }
                   9204: 
1.306     albertel 9205: =pod
                   9206: 
                   9207: =item * &headtag()
                   9208: 
                   9209: Returns a uniform footer for LON-CAPA web pages.
                   9210: 
1.307     albertel 9211: Inputs: $title - optional title for the head
                   9212:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 9213:         $args - optional arguments
1.319     albertel 9214:             force_register - if is true call registerurl so the remote is 
                   9215:                              informed
1.415     albertel 9216:             redirect       -> array ref of
                   9217:                                    1- seconds before redirect occurs
                   9218:                                    2- url to redirect to
                   9219:                                    3- whether the side effect should occur
1.315     albertel 9220:                            (side effect of setting 
                   9221:                                $env{'internal.head.redirect'} to the url 
1.1386    raeburn  9222:                                redirected to)
                   9223:                                    4- whether the redirect target should be
                   9224:                                       the opener of the current (pop-up)
                   9225:                                       window (side effect of setting
                   9226:                                       $env{'internal.head.to_opener'} to
                   9227:                                       1, if true.
1.1388    raeburn  9228:                                    5- whether encrypt check should be skipped
1.352     albertel 9229:             domain         -> force to color decorate a page for a specific
                   9230:                                domain
                   9231:             function       -> force usage of a specific rolish color scheme
                   9232:             bgcolor        -> override the default page bgcolor
1.460     albertel 9233:             no_auto_mt_title
                   9234:                            -> prevent &mt()ing the title arg
1.464     albertel 9235: 
1.306     albertel 9236: =cut
                   9237: 
                   9238: sub headtag {
1.313     albertel 9239:     my ($title,$head_extra,$args) = @_;
1.306     albertel 9240:     
1.363     albertel 9241:     my $function = $args->{'function'} || &get_users_function();
                   9242:     my $domain   = $args->{'domain'}   || &determinedomain();
                   9243:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1154    raeburn  9244:     my $httphost = $args->{'use_absolute'};
1.418     albertel 9245:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 9246: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 9247: 		   #time(),
1.418     albertel 9248: 		   $env{'environment.color.timestamp'},
1.363     albertel 9249: 		   $function,$domain,$bgcolor);
                   9250: 
1.369     www      9251:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 9252: 
1.308     albertel 9253:     my $result =
                   9254: 	'<head>'.
1.1160    raeburn  9255: 	&font_settings($args);
1.319     albertel 9256: 
1.1188    raeburn  9257:     my $inhibitprint;
                   9258:     if ($args->{'print_suppress'}) {
                   9259:         $inhibitprint = &print_suppression();
                   9260:     }
1.1064    raeburn  9261: 
1.461     albertel 9262:     if (!$args->{'frameset'}) {
                   9263: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   9264:     }
1.962     droeschl 9265:     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
                   9266:         $result .= Apache::lonxml::display_title();
1.319     albertel 9267:     }
1.436     albertel 9268:     if (!$args->{'no_nav_bar'} 
                   9269: 	&& !$args->{'only_body'}
                   9270: 	&& !$args->{'frameset'}) {
1.1154    raeburn  9271: 	$result .= &help_menu_js($httphost);
1.1032    www      9272:         $result.=&modal_window();
1.1038    www      9273:         $result.=&togglebox_script();
1.1034    www      9274:         $result.=&wishlist_window();
1.1041    www      9275:         $result.=&LCprogressbarUpdate_script();
1.1034    www      9276:     } else {
                   9277:         if ($args->{'add_modal'}) {
                   9278:            $result.=&modal_window();
                   9279:         }
                   9280:         if ($args->{'add_wishlist'}) {
                   9281:            $result.=&wishlist_window();
                   9282:         }
1.1038    www      9283:         if ($args->{'add_togglebox'}) {
                   9284:            $result.=&togglebox_script();
                   9285:         }
1.1041    www      9286:         if ($args->{'add_progressbar'}) {
                   9287:            $result.=&LCprogressbarUpdate_script();
                   9288:         }
1.436     albertel 9289:     }
1.314     albertel 9290:     if (ref($args->{'redirect'})) {
1.1388    raeburn  9291: 	my ($time,$url,$inhibit_continue,$to_opener,$skip_enc_check) = @{$args->{'redirect'}};
                   9292:         if (!$skip_enc_check) {
                   9293:             $url = &Apache::lonenc::check_encrypt($url);
                   9294:         }
1.414     albertel 9295: 	if (!$inhibit_continue) {
                   9296: 	    $env{'internal.head.redirect'} = $url;
                   9297: 	}
1.1386    raeburn  9298: 	$result.=<<"ADDMETA";
1.313     albertel 9299: <meta http-equiv="pragma" content="no-cache" />
1.1386    raeburn  9300: ADDMETA
                   9301:         if ($to_opener) {
                   9302:             $env{'internal.head.to_opener'} = 1;
                   9303:             my $dest = &js_escape($url);
                   9304:             my $timeout = int($time * 1000);
                   9305:             $result .=<<"ENDJS";
                   9306: <script type="text/javascript">
                   9307: // <![CDATA[
                   9308: function LC_To_Opener() {
                   9309:     var dest = '$dest';
                   9310:     if (dest != '') {
                   9311:         if (window.opener != null && !window.opener.closed) {
                   9312:             window.opener.location.href=dest;
                   9313:             window.close();
                   9314:         } else {
                   9315:             window.location.href=dest;
                   9316:         }
                   9317:     }
                   9318: }
                   9319: \$(document).ready(function () {
                   9320:     setTimeout('LC_To_Opener()',$timeout);
                   9321: });
                   9322: // ]]>
                   9323: </script>
                   9324: ENDJS
                   9325:         } else {
                   9326:             $result.=<<"ADDMETA";
1.344     albertel 9327: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 9328: ADDMETA
1.1386    raeburn  9329:         }
1.1210    raeburn  9330:     } else {
                   9331:         unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
                   9332:             my $requrl = $env{'request.uri'};
                   9333:             if ($requrl eq '') {
                   9334:                 $requrl = $ENV{'REQUEST_URI'};
                   9335:                 $requrl =~ s/\?.+$//;
                   9336:             }
                   9337:             unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
                   9338:                     (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
                   9339:                      ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
                   9340:                 my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                   9341:                 unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                   9342:                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
1.1340    raeburn  9343:                     my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
1.1352    raeburn  9344:                     my ($offload,$offloadoth);
1.1210    raeburn  9345:                     if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                   9346:                         if ($domdefs{'offloadnow'}{$lonhost}) {
1.1340    raeburn  9347:                             $offload = 1;
1.1353    raeburn  9348:                             if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
                   9349:                                 (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
                   9350:                                 unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
                   9351:                                     $offloadoth = 1;
                   9352:                                     $dom_in_use = $env{'user.domain'};
                   9353:                                 }
                   9354:                             }
1.1340    raeburn  9355:                         }
                   9356:                     }
                   9357:                     unless ($offload) {
                   9358:                         if (ref($domdefs{'offloadoth'}) eq 'HASH') {
                   9359:                             if ($domdefs{'offloadoth'}{$lonhost}) {
                   9360:                                 if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
                   9361:                                     (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
                   9362:                                     unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
                   9363:                                         $offload = 1;
1.1352    raeburn  9364:                                         $offloadoth = 1;
1.1340    raeburn  9365:                                         $dom_in_use = $env{'user.domain'};
                   9366:                                     }
1.1210    raeburn  9367:                                 }
1.1340    raeburn  9368:                             }
                   9369:                         }
                   9370:                     }
                   9371:                     if ($offload) {
1.1358    raeburn  9372:                         my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
1.1352    raeburn  9373:                         if (($newserver eq '') && ($offloadoth)) {
                   9374:                             my @domains = &Apache::lonnet::current_machine_domains();
                   9375:                             if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) { 
                   9376:                                 ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
                   9377:                             }
                   9378:                         }
1.1340    raeburn  9379:                         if (($newserver) && ($newserver ne $lonhost)) {
                   9380:                             my $numsec = 5;
                   9381:                             my $timeout = $numsec * 1000;
                   9382:                             my ($newurl,$locknum,%locks,$msg);
                   9383:                             if ($env{'request.role.adv'}) {
                   9384:                                 ($locknum,%locks) = &Apache::lonnet::get_locks();
                   9385:                             }
                   9386:                             my $disable_submit = 0;
                   9387:                             if ($requrl =~ /$LONCAPA::assess_re/) {
                   9388:                                 $disable_submit = 1;
                   9389:                             }
                   9390:                             if ($locknum) {
                   9391:                                 my @lockinfo = sort(values(%locks));
1.1354    raeburn  9392:                                 $msg = &mt('Once the following tasks are complete:')." \n".
1.1340    raeburn  9393:                                        join(", ",sort(values(%locks)))."\n";
                   9394:                                 if (&show_course()) {
                   9395:                                     $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
                   9396:                                 } else {
                   9397:                                     $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
1.1210    raeburn  9398:                                 }
1.1340    raeburn  9399:                             } else {
                   9400:                                 if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                   9401:                                     $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
                   9402:                                 }
                   9403:                                 $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                   9404:                                 $newurl = '/adm/switchserver?otherserver='.$newserver;
                   9405:                                 if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
                   9406:                                     $newurl .= '&role='.$env{'request.role'};
                   9407:                                 }
                   9408:                                 if ($env{'request.symb'}) {
                   9409:                                     my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
                   9410:                                     if ($shownsymb =~ m{^/enc/}) {
                   9411:                                         my $reqdmajor = 2;
                   9412:                                         my $reqdminor = 11;
                   9413:                                         my $reqdsubminor = 3;
                   9414:                                         my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
                   9415:                                         my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
                   9416:                                         my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
                   9417:                                         if (($major eq '' && $minor eq '') ||
                   9418:                                             (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
                   9419:                                             (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
                   9420:                                              ($reqdsubminor > $subminor))))) {
                   9421:                                             undef($shownsymb);
                   9422:                                         }
1.1210    raeburn  9423:                                     }
1.1340    raeburn  9424:                                     if ($shownsymb) {
                   9425:                                         &js_escape(\$shownsymb);
                   9426:                                         $newurl .= '&symb='.$shownsymb;
1.1210    raeburn  9427:                                     }
1.1340    raeburn  9428:                                 } else {
                   9429:                                     my $shownurl = &Apache::lonenc::check_encrypt($requrl);
                   9430:                                     &js_escape(\$shownurl);
                   9431:                                     $newurl .= '&origurl='.$shownurl;
1.1210    raeburn  9432:                                 }
1.1340    raeburn  9433:                             }
                   9434:                             &js_escape(\$msg);
                   9435:                             $result.=<<OFFLOAD
1.1210    raeburn  9436: <meta http-equiv="pragma" content="no-cache" />
                   9437: <script type="text/javascript">
1.1215    raeburn  9438: // <![CDATA[
1.1210    raeburn  9439: function LC_Offload_Now() {
                   9440:     var dest = "$newurl";
                   9441:     if (dest != '') {
                   9442:         window.location.href="$newurl";
                   9443:     }
                   9444: }
1.1214    raeburn  9445: \$(document).ready(function () {
                   9446:     window.alert('$msg');
                   9447:     if ($disable_submit) {
1.1210    raeburn  9448:         \$(".LC_hwk_submit").prop("disabled", true);
                   9449:         \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214    raeburn  9450:     }
                   9451:     setTimeout('LC_Offload_Now()', $timeout);
                   9452: });
1.1215    raeburn  9453: // ]]>
1.1210    raeburn  9454: </script>
                   9455: OFFLOAD
                   9456:                         }
                   9457:                     }
                   9458:                 }
                   9459:             }
                   9460:         }
1.313     albertel 9461:     }
1.306     albertel 9462:     if (!defined($title)) {
                   9463: 	$title = 'The LearningOnline Network with CAPA';
                   9464:     }
1.460     albertel 9465:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   9466:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168    raeburn  9467: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'"';
                   9468:     if (!$args->{'frameset'}) {
                   9469:         $result .= ' /';
                   9470:     }
                   9471:     $result .= '>' 
1.1064    raeburn  9472:         .$inhibitprint
1.414     albertel 9473: 	.$head_extra;
1.1242    raeburn  9474:     my $clientmobile;
                   9475:     if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   9476:         (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
                   9477:     } else {
                   9478:         $clientmobile = $env{'browser.mobile'};
                   9479:     }
                   9480:     if ($clientmobile) {
1.1137    raeburn  9481:         $result .= '
                   9482: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   9483: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   9484:     }
1.1278    raeburn  9485:     $result .= '<meta name="google" content="notranslate" />'."\n";
1.962     droeschl 9486:     return $result.'</head>';
1.306     albertel 9487: }
                   9488: 
                   9489: =pod
                   9490: 
1.340     albertel 9491: =item * &font_settings()
                   9492: 
                   9493: Returns neccessary <meta> to set the proper encoding
                   9494: 
1.1160    raeburn  9495: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340     albertel 9496: 
                   9497: =cut
                   9498: 
                   9499: sub font_settings {
1.1160    raeburn  9500:     my ($args) = @_;
1.340     albertel 9501:     my $headerstring='';
1.1160    raeburn  9502:     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
                   9503:         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168    raeburn  9504:         $headerstring.=
                   9505:             '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
                   9506:         if (!$args->{'frameset'}) {
                   9507: 	    $headerstring.= ' /';
                   9508:         }
                   9509: 	$headerstring .= '>'."\n";
1.340     albertel 9510:     }
                   9511:     return $headerstring;
                   9512: }
                   9513: 
1.341     albertel 9514: =pod
                   9515: 
1.1064    raeburn  9516: =item * &print_suppression()
                   9517: 
                   9518: In course context returns css which causes the body to be blank when media="print",
                   9519: if printout generation is unavailable for the current resource.
                   9520: 
                   9521: This could be because:
                   9522: 
                   9523: (a) printstartdate is in the future
                   9524: 
                   9525: (b) printenddate is in the past
                   9526: 
                   9527: (c) there is an active exam block with "printout"
                   9528: functionality blocked
                   9529: 
                   9530: Users with pav, pfo or evb privileges are exempt.
                   9531: 
                   9532: Inputs: none
                   9533: 
                   9534: =cut
                   9535: 
                   9536: 
                   9537: sub print_suppression {
                   9538:     my $noprint;
                   9539:     if ($env{'request.course.id'}) {
                   9540:         my $scope = $env{'request.course.id'};
                   9541:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   9542:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   9543:             return;
                   9544:         }
                   9545:         if ($env{'request.course.sec'} ne '') {
                   9546:             $scope .= "/$env{'request.course.sec'}";
                   9547:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   9548:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  9549:                 return;
1.1064    raeburn  9550:             }
                   9551:         }
                   9552:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9553:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1372    raeburn  9554:         my $clientip = &Apache::lonnet::get_requestor_ip();
                   9555:         my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
1.1064    raeburn  9556:         if ($blocked) {
                   9557:             my $checkrole = "cm./$cdom/$cnum";
                   9558:             if ($env{'request.course.sec'} ne '') {
                   9559:                 $checkrole .= "/$env{'request.course.sec'}";
                   9560:             }
                   9561:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   9562:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   9563:                 $noprint = 1;
                   9564:             }
                   9565:         }
                   9566:         unless ($noprint) {
                   9567:             my $symb = &Apache::lonnet::symbread();
                   9568:             if ($symb ne '') {
                   9569:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   9570:                 if (ref($navmap)) {
                   9571:                     my $res = $navmap->getBySymb($symb);
                   9572:                     if (ref($res)) {
                   9573:                         if (!$res->resprintable()) {
                   9574:                             $noprint = 1;
                   9575:                         }
                   9576:                     }
                   9577:                 }
                   9578:             }
                   9579:         }
                   9580:         if ($noprint) {
                   9581:             return <<"ENDSTYLE";
                   9582: <style type="text/css" media="print">
                   9583:     body { display:none }
                   9584: </style>
                   9585: ENDSTYLE
                   9586:         }
                   9587:     }
                   9588:     return;
                   9589: }
                   9590: 
                   9591: =pod
                   9592: 
1.341     albertel 9593: =item * &xml_begin()
                   9594: 
                   9595: Returns the needed doctype and <html>
                   9596: 
                   9597: Inputs: none
                   9598: 
                   9599: =cut
                   9600: 
                   9601: sub xml_begin {
1.1168    raeburn  9602:     my ($is_frameset) = @_;
1.341     albertel 9603:     my $output='';
                   9604: 
                   9605:     if ($env{'browser.mathml'}) {
                   9606: 	$output='<?xml version="1.0"?>'
                   9607:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   9608: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   9609:             
                   9610: #	    .'<!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">] >'
                   9611: 	    .'<!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">'
                   9612:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   9613: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168    raeburn  9614:     } elsif ($is_frameset) {
                   9615:         $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   9616:                 '<html>'."\n";
1.341     albertel 9617:     } else {
1.1168    raeburn  9618: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
                   9619:                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341     albertel 9620:     }
                   9621:     return $output;
                   9622: }
1.340     albertel 9623: 
                   9624: =pod
                   9625: 
1.306     albertel 9626: =item * &start_page()
                   9627: 
                   9628: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   9629: 
1.648     raeburn  9630: Inputs:
                   9631: 
                   9632: =over 4
                   9633: 
                   9634: $title - optional title for the page
                   9635: 
                   9636: $head_extra - optional extra HTML to incude inside the <head>
                   9637: 
                   9638: $args - additional optional args supported are:
                   9639: 
                   9640: =over 8
                   9641: 
                   9642:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 9643:                                     arg on
1.814     bisitz   9644:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  9645:              add_entries    -> additional attributes to add to the  <body>
                   9646:              domain         -> force to color decorate a page for a 
1.317     albertel 9647:                                     specific domain
1.648     raeburn  9648:              function       -> force usage of a specific rolish color
1.317     albertel 9649:                                     scheme
1.648     raeburn  9650:              redirect       -> see &headtag()
                   9651:              bgcolor        -> override the default page bg color
                   9652:              js_ready       -> return a string ready for being used in 
1.317     albertel 9653:                                     a javascript writeln
1.648     raeburn  9654:              html_encode    -> return a string ready for being used in 
1.320     albertel 9655:                                     a html attribute
1.648     raeburn  9656:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 9657:                                     $forcereg arg
1.648     raeburn  9658:              frameset       -> if true will start with a <frameset>
1.330     albertel 9659:                                     rather than <body>
1.648     raeburn  9660:              skip_phases    -> hash ref of 
1.338     albertel 9661:                                     head -> skip the <html><head> generation
                   9662:                                     body -> skip all <body> generation
1.648     raeburn  9663:              no_auto_mt_title -> prevent &mt()ing the title arg
1.867     kalberla 9664:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  9665:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1272    raeburn  9666:              bread_crumbs_nomenu -> if true will pass false as the value of $menulink
                   9667:                                     to lonhtmlcommon::breadcrumbs
1.1096    raeburn  9668:              group          -> includes the current group, if page is for a 
1.1274    raeburn  9669:                                specific group
                   9670:              use_absolute   -> for request for external resource or syllabus, this
                   9671:                                will contain https://<hostname> if server uses
                   9672:                                https (as per hosts.tab), but request is for http
                   9673:              hostname       -> hostname, originally from $r->hostname(), (optional).
1.1369    raeburn  9674:              links_disabled -> Links in primary and secondary menus are disabled
                   9675:                                (Can enable them once page has loaded - see lonroles.pm
                   9676:                                for an example).
1.1380    raeburn  9677:              links_target   -> Target for links, e.g., _parent (optional).
1.361     albertel 9678: 
1.648     raeburn  9679: =back
1.460     albertel 9680: 
1.648     raeburn  9681: =back
1.562     albertel 9682: 
1.306     albertel 9683: =cut
                   9684: 
                   9685: sub start_page {
1.309     albertel 9686:     my ($title,$head_extra,$args) = @_;
1.318     albertel 9687:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 9688: 
1.315     albertel 9689:     $env{'internal.start_page'}++;
1.1359    raeburn  9690:     my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu);
1.964     droeschl 9691: 
1.338     albertel 9692:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168    raeburn  9693:         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338     albertel 9694:     }
1.1316    raeburn  9695: 
                   9696:     if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
1.1318    raeburn  9697:         if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
                   9698:             unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
                   9699:                 $args->{'no_primary_menu'} = 1;
                   9700:             }
                   9701:             unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
                   9702:                 $args->{'no_inline_menu'} = 1;
                   9703:             }
                   9704:             if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
                   9705:                 map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
                   9706:             }
                   9707:         } else {
                   9708:             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9709:             my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
                   9710:             if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
                   9711:                 unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
                   9712:                     $args->{'no_primary_menu'} = 1;
                   9713:                 }
                   9714:                 unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
                   9715:                     $args->{'no_inline_menu'} = 1;
                   9716:                 }
                   9717:                 if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
                   9718:                     map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
                   9719:                 }
                   9720:             }
                   9721:         }
1.1316    raeburn  9722:         ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
                   9723:                                   $env{'course.'.$env{'request.course.id'}.'.domain'},
                   9724:                                   $env{'course.'.$env{'request.course.id'}.'.num'});
1.1359    raeburn  9725:     } elsif ($env{'request.course.id'}) {
                   9726:         my $expiretime=600;
                   9727:         if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) {
                   9728:             &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1});
                   9729:         }
                   9730:         my ($deeplinkmenu,$menuref);
                   9731:         ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect();
                   9732:         if ($menucoll) {
                   9733:             if (ref($menuref) eq 'HASH') {
                   9734:                 %menu = %{$menuref};
                   9735:             }
                   9736:             if ($menu{'top'} eq 'n') {
                   9737:                 $args->{'no_primary_menu'} = 1;
                   9738:             }
                   9739:             if ($menu{'inline'} eq 'n') {
                   9740:                 unless (&Apache::lonnet::allowed('opa')) {
                   9741:                     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9742:                     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   9743:                     my $crstype = &course_type();
                   9744:                     my $now = time;
                   9745:                     my $ccrole;
                   9746:                     if ($crstype eq 'Community') {
                   9747:                         $ccrole = 'co';
                   9748:                     } else {
                   9749:                         $ccrole = 'cc';
                   9750:                     }
                   9751:                     if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {
                   9752:                         my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});
                   9753:                         if ((($start) && ($start<0)) ||
                   9754:                             (($end) && ($end<$now))  ||
                   9755:                             (($start) && ($now<$start))) {
                   9756:                             $args->{'no_inline_menu'} = 1;
                   9757:                         }
                   9758:                     } else {
                   9759:                         $args->{'no_inline_menu'} = 1;
                   9760:                     }
                   9761:                 }
                   9762:             }
                   9763:         }
1.1316    raeburn  9764:     }
1.1359    raeburn  9765: 
1.1385    raeburn  9766:     my $showncrumbs;
1.338     albertel 9767:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   9768: 	if ($args->{'frameset'}) {
                   9769: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   9770: 						$args->{'add_entries'});
                   9771: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   9772:         } else {
                   9773:             $result .=
                   9774:                 &bodytag($title, 
                   9775:                          $args->{'function'},       $args->{'add_entries'},
                   9776:                          $args->{'only_body'},      $args->{'domain'},
                   9777:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096    raeburn  9778:                          $args->{'bgcolor'},        $args,
1.1385    raeburn  9779:                          \@advtools,$ltiscope,$ltiuri,\%ltimenu,$menucoll,
                   9780:                          \%menu,\$showncrumbs);
1.831     bisitz   9781:         }
1.330     albertel 9782:     }
1.338     albertel 9783: 
1.315     albertel 9784:     if ($args->{'js_ready'}) {
1.713     kaisler  9785: 		$result = &js_ready($result);
1.315     albertel 9786:     }
1.320     albertel 9787:     if ($args->{'html_encode'}) {
1.713     kaisler  9788: 		$result = &html_encode($result);
                   9789:     }
                   9790: 
1.813     bisitz   9791:     # Preparation for new and consistent functionlist at top of screen
                   9792:     # if ($args->{'functionlist'}) {
                   9793:     #            $result .= &build_functionlist();
                   9794:     #}
                   9795: 
1.964     droeschl 9796:     # Don't add anything more if only_body wanted or in const space
                   9797:     return $result if    $args->{'only_body'} 
                   9798:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   9799: 
                   9800:     #Breadcrumbs
1.758     kaisler  9801:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
1.1385    raeburn  9802:         unless ($showncrumbs) {
1.758     kaisler  9803: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   9804: 		#if any br links exists, add them to the breadcrumbs
                   9805: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   9806: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   9807: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   9808: 			}
                   9809: 		}
1.1096    raeburn  9810:                 # if @advtools array contains items add then to the breadcrumbs
                   9811:                 if (@advtools > 0) {
                   9812:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   9813:                 }
1.1272    raeburn  9814:                 my $menulink;
                   9815:                 # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
                   9816:                 if ((exists($args->{'bread_crumbs_nomenu'})) ||
1.1312    raeburn  9817:                      ($ltiscope eq 'map') || ($ltiscope eq 'resource') ||
1.1272    raeburn  9818:                      ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
                   9819:                      ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
                   9820:                      (!$env{'request.role.adv'}))) {
                   9821:                     $menulink = 0;
                   9822:                 } else {
                   9823:                     undef($menulink);
                   9824:                 }
1.1385    raeburn  9825:                 my $linkprotout;
                   9826:                 if ($env{'request.deeplink.login'}) {
                   9827:                     my $linkprotout = &Apache::lonmenu::linkprot_exit();
                   9828:                     if ($linkprotout) {
                   9829:                         &Apache::lonhtmlcommon::add_breadcrumb_tool('tools',$linkprotout);
                   9830:                     }
                   9831:                 }
1.758     kaisler  9832: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   9833: 		if(exists($args->{'bread_crumbs_component'})){
1.1272    raeburn  9834: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
1.1237    raeburn  9835:                 } else {
1.1272    raeburn  9836: 			$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
1.758     kaisler  9837: 		}
1.1385    raeburn  9838:         }
1.320     albertel 9839:     }
1.315     albertel 9840:     return $result;
1.306     albertel 9841: }
                   9842: 
                   9843: sub end_page {
1.315     albertel 9844:     my ($args) = @_;
                   9845:     $env{'internal.end_page'}++;
1.330     albertel 9846:     my $result;
1.335     albertel 9847:     if ($args->{'discussion'}) {
                   9848: 	my ($target,$parser);
                   9849: 	if (ref($args->{'discussion'})) {
                   9850: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   9851: 				$args->{'discussion'}{'parser'});
                   9852: 	}
                   9853: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   9854:     }
1.330     albertel 9855:     if ($args->{'frameset'}) {
                   9856: 	$result .= '</frameset>';
                   9857:     } else {
1.635     raeburn  9858: 	$result .= &endbodytag($args);
1.330     albertel 9859:     }
1.1080    raeburn  9860:     unless ($args->{'notbody'}) {
                   9861:         $result .= "\n</html>";
                   9862:     }
1.330     albertel 9863: 
1.315     albertel 9864:     if ($args->{'js_ready'}) {
1.317     albertel 9865: 	$result = &js_ready($result);
1.315     albertel 9866:     }
1.335     albertel 9867: 
1.320     albertel 9868:     if ($args->{'html_encode'}) {
                   9869: 	$result = &html_encode($result);
                   9870:     }
1.335     albertel 9871: 
1.315     albertel 9872:     return $result;
                   9873: }
                   9874: 
1.1359    raeburn  9875: sub menucoll_in_effect {
                   9876:     my ($menucoll,$deeplinkmenu,%menu);
                   9877:     if ($env{'request.course.id'}) {
                   9878:         $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'};
1.1362    raeburn  9879:         if ($env{'request.deeplink.login'}) {
1.1370    raeburn  9880:             my ($deeplink_symb,$deeplink,$check_login_symb);
1.1362    raeburn  9881:             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   9882:             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9883:             if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) {
                   9884:                 if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) {
                   9885:                     my $navmap = Apache::lonnavmaps::navmap->new();
                   9886:                     if (ref($navmap)) {
                   9887:                         $deeplink = $navmap->get_mapparam(undef,
                   9888:                                                           &Apache::lonnet::declutter($env{'request.noversionuri'}),
                   9889:                                                           '0.deeplink');
1.1370    raeburn  9890:                     } else {
                   9891:                         $check_login_symb = 1;
1.1362    raeburn  9892:                     }
                   9893:                 } else {
1.1370    raeburn  9894:                     my $symb = &Apache::lonnet::symbread();
                   9895:                     if ($symb) {
                   9896:                         $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
                   9897:                     } else {
                   9898:                         $check_login_symb = 1;
                   9899:                     }
1.1362    raeburn  9900:                 }
                   9901:             } else {
1.1370    raeburn  9902:                 $check_login_symb = 1;
                   9903:             }
                   9904:             if ($check_login_symb) {
1.1362    raeburn  9905:                 $deeplink_symb = &deeplink_login_symb($cnum,$cdom);
                   9906:                 if ($deeplink_symb =~ /\.(page|sequence)$/) {
                   9907:                     my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);
                   9908:                     my $navmap = Apache::lonnavmaps::navmap->new();
                   9909:                     if (ref($navmap)) {
                   9910:                         $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
                   9911:                     }
                   9912:                 } else {
                   9913:                     $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);
                   9914:                 }
                   9915:             }
1.1359    raeburn  9916:             if ($deeplink ne '') {
1.1378    raeburn  9917:                 my ($state,$others,$listed,$scope,$protect,$display,$target) = split(/,/,$deeplink);
1.1359    raeburn  9918:                 if ($display =~ /^\d+$/) {
                   9919:                     $deeplinkmenu = 1;
                   9920:                     $menucoll = $display;
                   9921:                 }
                   9922:             }
                   9923:         }
                   9924:         if ($menucoll) {
                   9925:             %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll);
                   9926:         }
                   9927:     }
                   9928:     return ($menucoll,$deeplinkmenu,\%menu);
                   9929: }
                   9930: 
1.1362    raeburn  9931: sub deeplink_login_symb {
                   9932:     my ($cnum,$cdom) = @_;
                   9933:     my $login_symb;
                   9934:     if ($env{'request.deeplink.login'}) {
1.1364    raeburn  9935:         $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom);
                   9936:     }
                   9937:     return $login_symb;
                   9938: }
                   9939: 
                   9940: sub symb_from_tinyurl {
                   9941:     my ($url,$cnum,$cdom) = @_;
                   9942:     if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {
                   9943:         my $key = $1;
                   9944:         my ($tinyurl,$login);
                   9945:         my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
                   9946:         if (defined($cached)) {
                   9947:             $tinyurl = $result;
                   9948:         } else {
                   9949:             my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
                   9950:             my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
                   9951:             if ($currtiny{$key} ne '') {
                   9952:                 $tinyurl = $currtiny{$key};
                   9953:                 &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
1.1362    raeburn  9954:             }
1.1364    raeburn  9955:         }
                   9956:         if ($tinyurl ne '') {
                   9957:             my ($cnumreq,$symb) = split(/\&/,$tinyurl);
                   9958:             if (wantarray) {
                   9959:                 return ($cnumreq,$symb);
                   9960:             } elsif ($cnumreq eq $cnum) {
                   9961:                 return $symb;
1.1362    raeburn  9962:             }
                   9963:         }
                   9964:     }
1.1364    raeburn  9965:     if (wantarray) {
                   9966:         return ();
                   9967:     } else {
                   9968:         return;
                   9969:     }
1.1362    raeburn  9970: }
                   9971: 
1.1405    raeburn  9972: sub usable_exttools {
                   9973:     my %tooltypes;
                   9974:     if ($env{'request.course.id'}) {
                   9975:         if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'}) {
                   9976:            if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'both') {
                   9977:                %tooltypes = (
                   9978:                              crs => 1,
                   9979:                              dom => 1,
                   9980:                             );
                   9981:            } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'crs') {
                   9982:                $tooltypes{'crs'} = 1;
                   9983:            } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'dom') {
                   9984:                $tooltypes{'dom'} = 1;
                   9985:            }
                   9986:         } else {
                   9987:             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9988:             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   9989:             my $crstype = lc($env{'course.'.$env{'request.course.id'}.'.type'});
                   9990:             if ($crstype eq '') {
                   9991:                 $crstype = 'course';
                   9992:             }
                   9993:             if ($crstype eq 'course') {
                   9994:                 if ($env{'course.'.$env{'request.course.id'}.'internal.coursecode'}) {
                   9995:                     $crstype = 'official';
                   9996:                 } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.textbook'}) {
                   9997:                     $crstype = 'textbook';
                   9998:                 } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.lti'}) {
                   9999:                     $crstype = 'lti';
                   10000:                 } else {
                   10001:                     $crstype = 'unofficial';
                   10002:                 }
                   10003:             }
                   10004:             my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
                   10005:             if ($domdefaults{$crstype.'domexttool'}) {
                   10006:                 $tooltypes{'dom'} = 1;
                   10007:             }
                   10008:             if ($domdefaults{$crstype.'exttool'}) {
                   10009:                 $tooltypes{'crs'} = 1;
                   10010:             }
                   10011:         }
                   10012:     }
                   10013:     return %tooltypes;
                   10014: }
                   10015: 
1.1034    www      10016: sub wishlist_window {
                   10017:     return(<<'ENDWISHLIST');
1.1046    raeburn  10018: <script type="text/javascript">
1.1034    www      10019: // <![CDATA[
                   10020: // <!-- BEGIN LON-CAPA Internal
                   10021: function set_wishlistlink(title, path) {
                   10022:     if (!title) {
                   10023:         title = document.title;
                   10024:         title = title.replace(/^LON-CAPA /,'');
                   10025:     }
1.1175    raeburn  10026:     title = encodeURIComponent(title);
1.1203    raeburn  10027:     title = title.replace("'","\\\'");
1.1034    www      10028:     if (!path) {
                   10029:         path = location.pathname;
                   10030:     }
1.1175    raeburn  10031:     path = encodeURIComponent(path);
1.1203    raeburn  10032:     path = path.replace("'","\\\'");
1.1034    www      10033:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   10034:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   10035: }
                   10036: // END LON-CAPA Internal -->
                   10037: // ]]>
                   10038: </script>
                   10039: ENDWISHLIST
                   10040: }
                   10041: 
1.1030    www      10042: sub modal_window {
                   10043:     return(<<'ENDMODAL');
1.1046    raeburn  10044: <script type="text/javascript">
1.1030    www      10045: // <![CDATA[
                   10046: // <!-- BEGIN LON-CAPA Internal
                   10047: var modalWindow = {
                   10048: 	parent:"body",
                   10049: 	windowId:null,
                   10050: 	content:null,
                   10051: 	width:null,
                   10052: 	height:null,
                   10053: 	close:function()
                   10054: 	{
                   10055: 	        $(".LCmodal-window").remove();
                   10056: 	        $(".LCmodal-overlay").remove();
                   10057: 	},
                   10058: 	open:function()
                   10059: 	{
                   10060: 		var modal = "";
                   10061: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   10062: 		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;\">";
                   10063: 		modal += this.content;
                   10064: 		modal += "</div>";	
                   10065: 
                   10066: 		$(this.parent).append(modal);
                   10067: 
                   10068: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   10069: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   10070: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   10071: 	}
                   10072: };
1.1140    raeburn  10073: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      10074: 	{
1.1266    raeburn  10075:                 source = source.replace(/'/g,"&#39;");
1.1030    www      10076: 		modalWindow.windowId = "myModal";
                   10077: 		modalWindow.width = width;
                   10078: 		modalWindow.height = height;
1.1196    raeburn  10079: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030    www      10080: 		modalWindow.open();
1.1208    raeburn  10081: 	};
1.1030    www      10082: // END LON-CAPA Internal -->
                   10083: // ]]>
                   10084: </script>
                   10085: ENDMODAL
                   10086: }
                   10087: 
                   10088: sub modal_link {
1.1140    raeburn  10089:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      10090:     unless ($width) { $width=480; }
                   10091:     unless ($height) { $height=400; }
1.1031    www      10092:     unless ($scrolling) { $scrolling='yes'; }
1.1140    raeburn  10093:     unless ($transparency) { $transparency='true'; }
                   10094: 
1.1074    raeburn  10095:     my $target_attr;
                   10096:     if (defined($target)) {
                   10097:         $target_attr = 'target="'.$target.'"';
                   10098:     }
                   10099:     return <<"ENDLINK";
1.1336    raeburn  10100: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
1.1074    raeburn  10101: ENDLINK
1.1030    www      10102: }
                   10103: 
1.1032    www      10104: sub modal_adhoc_script {
1.1365    raeburn  10105:     my ($funcname,$width,$height,$content,$possmathjax)=@_;
                   10106:     my $mathjax;
                   10107:     if ($possmathjax) {
                   10108:         $mathjax = <<'ENDJAX';
                   10109:                if (typeof MathJax == 'object') {
                   10110:                    MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
                   10111:                }
                   10112: ENDJAX
                   10113:     }
1.1032    www      10114:     return (<<ENDADHOC);
1.1046    raeburn  10115: <script type="text/javascript">
1.1032    www      10116: // <![CDATA[
                   10117:         var $funcname = function()
                   10118:         {
                   10119:                 modalWindow.windowId = "myModal";
                   10120:                 modalWindow.width = $width;
                   10121:                 modalWindow.height = $height;
                   10122:                 modalWindow.content = '$content';
                   10123:                 modalWindow.open();
1.1365    raeburn  10124:                 $mathjax
1.1032    www      10125:         };  
                   10126: // ]]>
                   10127: </script>
                   10128: ENDADHOC
                   10129: }
                   10130: 
1.1041    www      10131: sub modal_adhoc_inner {
1.1365    raeburn  10132:     my ($funcname,$width,$height,$content,$possmathjax)=@_;
1.1041    www      10133:     my $innerwidth=$width-20;
                   10134:     $content=&js_ready(
1.1140    raeburn  10135:                  &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
                   10136:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   10137:                  $content.
1.1041    www      10138:                  &end_scrollbox().
1.1140    raeburn  10139:                  &end_page()
1.1041    www      10140:              );
1.1365    raeburn  10141:     return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);
1.1041    www      10142: }
                   10143: 
                   10144: sub modal_adhoc_window {
1.1365    raeburn  10145:     my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;
                   10146:     return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).
1.1041    www      10147:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   10148: }
                   10149: 
                   10150: sub modal_adhoc_launch {
                   10151:     my ($funcname,$width,$height,$content)=@_;
                   10152:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   10153: <script type="text/javascript">
                   10154: // <![CDATA[
                   10155: $funcname();
                   10156: // ]]>
                   10157: </script>
                   10158: ENDLAUNCH
                   10159: }
                   10160: 
                   10161: sub modal_adhoc_close {
                   10162:     return (<<ENDCLOSE);
                   10163: <script type="text/javascript">
                   10164: // <![CDATA[
                   10165: modalWindow.close();
                   10166: // ]]>
                   10167: </script>
                   10168: ENDCLOSE
                   10169: }
                   10170: 
1.1038    www      10171: sub togglebox_script {
                   10172:    return(<<ENDTOGGLE);
                   10173: <script type="text/javascript"> 
                   10174: // <![CDATA[
                   10175: function LCtoggleDisplay(id,hidetext,showtext) {
                   10176:    link = document.getElementById(id + "link").childNodes[0];
                   10177:    with (document.getElementById(id).style) {
                   10178:       if (display == "none" ) {
                   10179:           display = "inline";
                   10180:           link.nodeValue = hidetext;
                   10181:         } else {
                   10182:           display = "none";
                   10183:           link.nodeValue = showtext;
                   10184:        }
                   10185:    }
                   10186: }
                   10187: // ]]>
                   10188: </script>
                   10189: ENDTOGGLE
                   10190: }
                   10191: 
1.1039    www      10192: sub start_togglebox {
                   10193:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   10194:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   10195:     unless ($showtext) { $showtext=&mt('show'); }
                   10196:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   10197:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   10198:     return &start_data_table().
                   10199:            &start_data_table_header_row().
                   10200:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   10201:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   10202:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   10203:            &end_data_table_header_row().
                   10204:            '<tr id="'.$id.'" style="display:none""><td>';
                   10205: }
                   10206: 
                   10207: sub end_togglebox {
                   10208:     return '</td></tr>'.&end_data_table();
                   10209: }
                   10210: 
1.1041    www      10211: sub LCprogressbar_script {
1.1302    raeburn  10212:    my ($id,$number_to_do)=@_;
                   10213:    if ($number_to_do) {
                   10214:        return(<<ENDPROGRESS);
1.1041    www      10215: <script type="text/javascript">
                   10216: // <![CDATA[
1.1045    www      10217: \$('#progressbar$id').progressbar({
1.1041    www      10218:   value: 0,
                   10219:   change: function(event, ui) {
                   10220:     var newVal = \$(this).progressbar('option', 'value');
                   10221:     \$('.pblabel', this).text(LCprogressTxt);
                   10222:   }
                   10223: });
                   10224: // ]]>
                   10225: </script>
                   10226: ENDPROGRESS
1.1302    raeburn  10227:    } else {
                   10228:        return(<<ENDPROGRESS);
                   10229: <script type="text/javascript">
                   10230: // <![CDATA[
                   10231: \$('#progressbar$id').progressbar({
                   10232:   value: false,
                   10233:   create: function(event, ui) {
                   10234:     \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
                   10235:     \$('.ui-progressbar-overlay', this).css({'margin':'0'});
                   10236:   }
                   10237: });
                   10238: // ]]>
                   10239: </script>
                   10240: ENDPROGRESS
                   10241:    }
1.1041    www      10242: }
                   10243: 
                   10244: sub LCprogressbarUpdate_script {
                   10245:    return(<<ENDPROGRESSUPDATE);
                   10246: <style type="text/css">
                   10247: .ui-progressbar { position:relative; }
1.1302    raeburn  10248: .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      10249: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   10250: </style>
                   10251: <script type="text/javascript">
                   10252: // <![CDATA[
1.1045    www      10253: var LCprogressTxt='---';
                   10254: 
1.1302    raeburn  10255: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041    www      10256:    LCprogressTxt=progresstext;
1.1302    raeburn  10257:    if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
                   10258:        \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
                   10259:    } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
1.1301    raeburn  10260:        \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
                   10261:    } else {
                   10262:        \$('#progressbar'+id).progressbar('value',percent);
                   10263:    }
1.1041    www      10264: }
                   10265: // ]]>
                   10266: </script>
                   10267: ENDPROGRESSUPDATE
                   10268: }
                   10269: 
1.1042    www      10270: my $LClastpercent;
1.1045    www      10271: my $LCidcnt;
                   10272: my $LCcurrentid;
1.1042    www      10273: 
1.1041    www      10274: sub LCprogressbar {
1.1302    raeburn  10275:     my ($r,$number_to_do,$preamble)=@_;
1.1042    www      10276:     $LClastpercent=0;
1.1045    www      10277:     $LCidcnt++;
                   10278:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1302    raeburn  10279:     my ($starting,$content);
                   10280:     if ($number_to_do) {
                   10281:         $starting=&mt('Starting');
                   10282:         $content=(<<ENDPROGBAR);
                   10283: $preamble
1.1045    www      10284:   <div id="progressbar$LCcurrentid">
1.1041    www      10285:     <span class="pblabel">$starting</span>
                   10286:   </div>
                   10287: ENDPROGBAR
1.1302    raeburn  10288:     } else {
                   10289:         $starting=&mt('Loading...');
                   10290:         $LClastpercent='false';
                   10291:         $content=(<<ENDPROGBAR);
                   10292: $preamble
                   10293:   <div id="progressbar$LCcurrentid">
                   10294:       <div class="progress-label">$starting</div>
                   10295:   </div>
                   10296: ENDPROGBAR
                   10297:     }
                   10298:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041    www      10299: }
                   10300: 
                   10301: sub LCprogressbarUpdate {
1.1302    raeburn  10302:     my ($r,$val,$text,$number_to_do)=@_;
                   10303:     if ($number_to_do) {
                   10304:         unless ($val) { 
                   10305:             if ($LClastpercent) {
                   10306:                 $val=$LClastpercent;
                   10307:             } else {
                   10308:                 $val=0;
                   10309:             }
                   10310:         }
                   10311:         if ($val<0) { $val=0; }
                   10312:         if ($val>100) { $val=0; }
                   10313:         $LClastpercent=$val;
                   10314:         unless ($text) { $text=$val.'%'; }
                   10315:     } else {
                   10316:         $val = 'false';
1.1042    www      10317:     }
1.1041    www      10318:     $text=&js_ready($text);
1.1044    www      10319:     &r_print($r,<<ENDUPDATE);
1.1041    www      10320: <script type="text/javascript">
                   10321: // <![CDATA[
1.1302    raeburn  10322: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041    www      10323: // ]]>
                   10324: </script>
                   10325: ENDUPDATE
1.1035    www      10326: }
                   10327: 
1.1042    www      10328: sub LCprogressbarClose {
                   10329:     my ($r)=@_;
                   10330:     $LClastpercent=0;
1.1044    www      10331:     &r_print($r,<<ENDCLOSE);
1.1042    www      10332: <script type="text/javascript">
                   10333: // <![CDATA[
1.1045    www      10334: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      10335: // ]]>
                   10336: </script>
                   10337: ENDCLOSE
1.1044    www      10338: }
                   10339: 
                   10340: sub r_print {
                   10341:     my ($r,$to_print)=@_;
                   10342:     if ($r) {
                   10343:       $r->print($to_print);
                   10344:       $r->rflush();
                   10345:     } else {
                   10346:       print($to_print);
                   10347:     }
1.1042    www      10348: }
                   10349: 
1.320     albertel 10350: sub html_encode {
                   10351:     my ($result) = @_;
                   10352: 
1.322     albertel 10353:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 10354:     
                   10355:     return $result;
                   10356: }
1.1044    www      10357: 
1.317     albertel 10358: sub js_ready {
                   10359:     my ($result) = @_;
                   10360: 
1.323     albertel 10361:     $result =~ s/[\n\r]/ /xmsg;
                   10362:     $result =~ s/\\/\\\\/xmsg;
                   10363:     $result =~ s/'/\\'/xmsg;
1.372     albertel 10364:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 10365:     
                   10366:     return $result;
                   10367: }
                   10368: 
1.315     albertel 10369: sub validate_page {
                   10370:     if (  exists($env{'internal.start_page'})
1.316     albertel 10371: 	  &&     $env{'internal.start_page'} > 1) {
                   10372: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 10373: 				 $env{'internal.start_page'}.' '.
1.316     albertel 10374: 				 $ENV{'request.filename'});
1.315     albertel 10375:     }
                   10376:     if (  exists($env{'internal.end_page'})
1.316     albertel 10377: 	  &&     $env{'internal.end_page'} > 1) {
                   10378: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 10379: 				 $env{'internal.end_page'}.' '.
1.316     albertel 10380: 				 $env{'request.filename'});
1.315     albertel 10381:     }
                   10382:     if (     exists($env{'internal.start_page'})
                   10383: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 10384: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   10385: 				 $env{'request.filename'});
1.315     albertel 10386:     }
                   10387:     if (   ! exists($env{'internal.start_page'})
                   10388: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 10389: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   10390: 				 $env{'request.filename'});
1.315     albertel 10391:     }
1.306     albertel 10392: }
1.315     albertel 10393: 
1.996     www      10394: 
                   10395: sub start_scrollbox {
1.1140    raeburn  10396:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  10397:     unless ($outerwidth) { $outerwidth='520px'; }
                   10398:     unless ($width) { $width='500px'; }
                   10399:     unless ($height) { $height='200px'; }
1.1075    raeburn  10400:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  10401:     if ($id ne '') {
1.1140    raeburn  10402:         $table_id = ' id="table_'.$id.'"';
1.1137    raeburn  10403:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  10404:     }
1.1075    raeburn  10405:     if ($bgcolor ne '') {
                   10406:         $tdcol = "background-color: $bgcolor;";
                   10407:     }
1.1137    raeburn  10408:     my $nicescroll_js;
                   10409:     if ($env{'browser.mobile'}) {
1.1140    raeburn  10410:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   10411:     }
                   10412:     return <<"END";
                   10413: $nicescroll_js
                   10414: 
                   10415: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
                   10416: <div style="overflow:auto; width:$width; height:$height;"$div_id>
                   10417: END
                   10418: }
                   10419: 
                   10420: sub end_scrollbox {
                   10421:     return '</div></td></tr></table>';
                   10422: }
                   10423: 
                   10424: sub nicescroll_javascript {
                   10425:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   10426:     my %options;
                   10427:     if (ref($cursor) eq 'HASH') {
                   10428:         %options = %{$cursor};
                   10429:     }
                   10430:     unless ($options{'railalign'} =~ /^left|right$/) {
                   10431:         $options{'railalign'} = 'left';
                   10432:     }
                   10433:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   10434:         my $function  = &get_users_function();
                   10435:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138    raeburn  10436:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140    raeburn  10437:             $options{'cursorcolor'} = '#00F';
1.1138    raeburn  10438:         }
1.1140    raeburn  10439:     }
                   10440:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   10441:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138    raeburn  10442:             $options{'cursoropacity'}='1.0';
                   10443:         }
1.1140    raeburn  10444:     } else {
                   10445:         $options{'cursoropacity'}='1.0';
                   10446:     }
                   10447:     if ($options{'cursorfixedheight'} eq 'none') {
                   10448:         delete($options{'cursorfixedheight'});
                   10449:     } else {
                   10450:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   10451:     }
                   10452:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   10453:         delete($options{'railoffset'});
                   10454:     }
                   10455:     my @niceoptions;
                   10456:     while (my($key,$value) = each(%options)) {
                   10457:         if ($value =~ /^\{.+\}$/) {
                   10458:             push(@niceoptions,$key.':'.$value);
1.1138    raeburn  10459:         } else {
1.1140    raeburn  10460:             push(@niceoptions,$key.':"'.$value.'"');
1.1138    raeburn  10461:         }
1.1140    raeburn  10462:     }
                   10463:     my $nicescroll_js = '
1.1137    raeburn  10464: $(document).ready(
1.1140    raeburn  10465:       function() {
                   10466:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   10467:       }
1.1137    raeburn  10468: );
                   10469: ';
1.1140    raeburn  10470:     if ($framecheck) {
                   10471:         $nicescroll_js .= '
                   10472: function expand_div(caller) {
                   10473:     if (top === self) {
                   10474:         document.getElementById("'.$id.'").style.width = "auto";
                   10475:         document.getElementById("'.$id.'").style.height = "auto";
                   10476:     } else {
                   10477:         try {
                   10478:             if (parent.frames) {
                   10479:                 if (parent.frames.length > 1) {
                   10480:                     var framesrc = parent.frames[1].location.href;
                   10481:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   10482:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   10483:                         document.getElementById("'.$id.'").style.width = "auto";
                   10484:                         document.getElementById("'.$id.'").style.height = "auto";
                   10485:                     }
                   10486:                 }
                   10487:             }
                   10488:         } catch (e) {
                   10489:             return;
                   10490:         }
1.1137    raeburn  10491:     }
1.1140    raeburn  10492:     return;
1.996     www      10493: }
1.1140    raeburn  10494: ';
                   10495:     }
                   10496:     if ($needjsready) {
                   10497:         $nicescroll_js = '
                   10498: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   10499:     } else {
                   10500:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   10501:     }
                   10502:     return $nicescroll_js;
1.996     www      10503: }
                   10504: 
1.318     albertel 10505: sub simple_error_page {
1.1150    bisitz   10506:     my ($r,$title,$msg,$args) = @_;
1.1304    raeburn  10507:     my %displayargs;
1.1151    raeburn  10508:     if (ref($args) eq 'HASH') {
                   10509:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
1.1304    raeburn  10510:         if ($args->{'only_body'}) {
                   10511:             $displayargs{'only_body'} = 1;
                   10512:         }
                   10513:         if ($args->{'no_nav_bar'}) {
                   10514:             $displayargs{'no_nav_bar'} = 1;
                   10515:         }
1.1151    raeburn  10516:     } else {
                   10517:         $msg = &mt($msg);
                   10518:     }
1.1150    bisitz   10519: 
1.318     albertel 10520:     my $page =
1.1304    raeburn  10521: 	&Apache::loncommon::start_page($title,'',\%displayargs).
1.1150    bisitz   10522: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 10523: 	&Apache::loncommon::end_page();
                   10524:     if (ref($r)) {
                   10525: 	$r->print($page);
1.327     albertel 10526: 	return;
1.318     albertel 10527:     }
                   10528:     return $page;
                   10529: }
1.347     albertel 10530: 
                   10531: {
1.610     albertel 10532:     my @row_count;
1.961     onken    10533: 
                   10534:     sub start_data_table_count {
                   10535:         unshift(@row_count, 0);
                   10536:         return;
                   10537:     }
                   10538: 
                   10539:     sub end_data_table_count {
                   10540:         shift(@row_count);
                   10541:         return;
                   10542:     }
                   10543: 
1.347     albertel 10544:     sub start_data_table {
1.1018    raeburn  10545: 	my ($add_class,$id) = @_;
1.422     albertel 10546: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  10547:         my $table_id;
                   10548:         if (defined($id)) {
                   10549:             $table_id = ' id="'.$id.'"';
                   10550:         }
1.961     onken    10551: 	&start_data_table_count();
1.1018    raeburn  10552: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 10553:     }
                   10554: 
                   10555:     sub end_data_table {
1.961     onken    10556: 	&end_data_table_count();
1.389     albertel 10557: 	return '</table>'."\n";;
1.347     albertel 10558:     }
                   10559: 
                   10560:     sub start_data_table_row {
1.974     wenzelju 10561: 	my ($add_class, $id) = @_;
1.610     albertel 10562: 	$row_count[0]++;
                   10563: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   10564: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 10565:         $id = (' id="'.$id.'"') unless ($id eq '');
                   10566:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 10567:     }
1.471     banghart 10568:     
                   10569:     sub continue_data_table_row {
1.974     wenzelju 10570: 	my ($add_class, $id) = @_;
1.610     albertel 10571: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 10572: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   10573:         $id = (' id="'.$id.'"') unless ($id eq '');
                   10574:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 10575:     }
1.347     albertel 10576: 
                   10577:     sub end_data_table_row {
1.389     albertel 10578: 	return '</tr>'."\n";;
1.347     albertel 10579:     }
1.367     www      10580: 
1.421     albertel 10581:     sub start_data_table_empty_row {
1.707     bisitz   10582: #	$row_count[0]++;
1.421     albertel 10583: 	return  '<tr class="LC_empty_row" >'."\n";;
                   10584:     }
                   10585: 
                   10586:     sub end_data_table_empty_row {
                   10587: 	return '</tr>'."\n";;
                   10588:     }
                   10589: 
1.367     www      10590:     sub start_data_table_header_row {
1.389     albertel 10591: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      10592:     }
                   10593: 
                   10594:     sub end_data_table_header_row {
1.389     albertel 10595: 	return '</tr>'."\n";;
1.367     www      10596:     }
1.890     droeschl 10597: 
                   10598:     sub data_table_caption {
                   10599:         my $caption = shift;
                   10600:         return "<caption class=\"LC_caption\">$caption</caption>";
                   10601:     }
1.347     albertel 10602: }
                   10603: 
1.548     albertel 10604: =pod
                   10605: 
                   10606: =item * &inhibit_menu_check($arg)
                   10607: 
                   10608: Checks for a inhibitmenu state and generates output to preserve it
                   10609: 
                   10610: Inputs:         $arg - can be any of
                   10611:                      - undef - in which case the return value is a string 
                   10612:                                to add  into arguments list of a uri
                   10613:                      - 'input' - in which case the return value is a HTML
                   10614:                                  <form> <input> field of type hidden to
                   10615:                                  preserve the value
                   10616:                      - a url - in which case the return value is the url with
                   10617:                                the neccesary cgi args added to preserve the
                   10618:                                inhibitmenu state
                   10619:                      - a ref to a url - no return value, but the string is
                   10620:                                         updated to include the neccessary cgi
                   10621:                                         args to preserve the inhibitmenu state
                   10622: 
                   10623: =cut
                   10624: 
                   10625: sub inhibit_menu_check {
                   10626:     my ($arg) = @_;
                   10627:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   10628:     if ($arg eq 'input') {
                   10629: 	if ($env{'form.inhibitmenu'}) {
                   10630: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   10631: 	} else {
                   10632: 	    return
                   10633: 	}
                   10634:     }
                   10635:     if ($env{'form.inhibitmenu'}) {
                   10636: 	if (ref($arg)) {
                   10637: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   10638: 	} elsif ($arg eq '') {
                   10639: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   10640: 	} else {
                   10641: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   10642: 	}
                   10643:     }
                   10644:     if (!ref($arg)) {
                   10645: 	return $arg;
                   10646:     }
                   10647: }
                   10648: 
1.251     albertel 10649: ###############################################
1.182     matthew  10650: 
                   10651: =pod
                   10652: 
1.549     albertel 10653: =back
                   10654: 
                   10655: =head1 User Information Routines
                   10656: 
                   10657: =over 4
                   10658: 
1.405     albertel 10659: =item * &get_users_function()
1.182     matthew  10660: 
                   10661: Used by &bodytag to determine the current users primary role.
                   10662: Returns either 'student','coordinator','admin', or 'author'.
                   10663: 
                   10664: =cut
                   10665: 
                   10666: ###############################################
                   10667: sub get_users_function {
1.815     tempelho 10668:     my $function = 'norole';
1.818     tempelho 10669:     if ($env{'request.role'}=~/^(st)/) {
                   10670:         $function='student';
                   10671:     }
1.907     raeburn  10672:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  10673:         $function='coordinator';
                   10674:     }
1.258     albertel 10675:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  10676:         $function='admin';
                   10677:     }
1.826     bisitz   10678:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  10679:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  10680:         $function='author';
                   10681:     }
                   10682:     return $function;
1.54      www      10683: }
1.99      www      10684: 
                   10685: ###############################################
                   10686: 
1.233     raeburn  10687: =pod
                   10688: 
1.821     raeburn  10689: =item * &show_course()
                   10690: 
                   10691: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   10692: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   10693: 
                   10694: Inputs:
                   10695: None
                   10696: 
                   10697: Outputs:
                   10698: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   10699: 
                   10700: =cut
                   10701: 
                   10702: ###############################################
                   10703: sub show_course {
1.1408    raeburn  10704:     my ($udom,$uname) = @_;
                   10705:     if (($udom ne '') && ($uname ne '')) {
                   10706:         if (($udom ne $env{'user.domain'}) || ($uname ne $env{'user.name'})) {
1.1410    raeburn  10707:             if (&Apache::lonnet::is_advanced_user($udom,$uname)) {
1.1408    raeburn  10708:                 return 0;
                   10709:             } else {
                   10710:                 return 1;
                   10711:             }
                   10712:         }
                   10713:     }
1.821     raeburn  10714:     my $course = !$env{'user.adv'};
                   10715:     if (!$env{'user.adv'}) {
                   10716:         foreach my $env (keys(%env)) {
                   10717:             next if ($env !~ m/^user\.priv\./);
                   10718:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   10719:                 $course = 0;
                   10720:                 last;
                   10721:             }
                   10722:         }
                   10723:     }
                   10724:     return $course;
                   10725: }
                   10726: 
                   10727: ###############################################
                   10728: 
                   10729: =pod
                   10730: 
1.542     raeburn  10731: =item * &check_user_status()
1.274     raeburn  10732: 
                   10733: Determines current status of supplied role for a
                   10734: specific user. Roles can be active, previous or future.
                   10735: 
                   10736: Inputs: 
                   10737: user's domain, user's username, course's domain,
1.375     raeburn  10738: course's number, optional section ID.
1.274     raeburn  10739: 
                   10740: Outputs:
                   10741: role status: active, previous or future. 
                   10742: 
                   10743: =cut
                   10744: 
                   10745: sub check_user_status {
1.412     raeburn  10746:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  10747:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202    raeburn  10748:     my @uroles = keys(%userinfo);
1.274     raeburn  10749:     my $srchstr;
                   10750:     my $active_chk = 'none';
1.412     raeburn  10751:     my $now = time;
1.274     raeburn  10752:     if (@uroles > 0) {
1.908     raeburn  10753:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  10754:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   10755:         } else {
1.412     raeburn  10756:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   10757:         }
                   10758:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  10759:             my $role_end = 0;
                   10760:             my $role_start = 0;
                   10761:             $active_chk = 'active';
1.412     raeburn  10762:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   10763:                 $role_end = $1;
                   10764:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   10765:                     $role_start = $1;
1.274     raeburn  10766:                 }
                   10767:             }
                   10768:             if ($role_start > 0) {
1.412     raeburn  10769:                 if ($now < $role_start) {
1.274     raeburn  10770:                     $active_chk = 'future';
                   10771:                 }
                   10772:             }
                   10773:             if ($role_end > 0) {
1.412     raeburn  10774:                 if ($now > $role_end) {
1.274     raeburn  10775:                     $active_chk = 'previous';
                   10776:                 }
                   10777:             }
                   10778:         }
                   10779:     }
                   10780:     return $active_chk;
                   10781: }
                   10782: 
                   10783: ###############################################
                   10784: 
                   10785: =pod
                   10786: 
1.405     albertel 10787: =item * &get_sections()
1.233     raeburn  10788: 
                   10789: Determines all the sections for a course including
                   10790: sections with students and sections containing other roles.
1.419     raeburn  10791: Incoming parameters: 
                   10792: 
                   10793: 1. domain
                   10794: 2. course number 
                   10795: 3. reference to array containing roles for which sections should 
                   10796: be gathered (optional).
                   10797: 4. reference to array containing status types for which sections 
                   10798: should be gathered (optional).
                   10799: 
                   10800: If the third argument is undefined, sections are gathered for any role. 
                   10801: If the fourth argument is undefined, sections are gathered for any status.
                   10802: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  10803:  
1.374     raeburn  10804: Returns section hash (keys are section IDs, values are
                   10805: number of users in each section), subject to the
1.419     raeburn  10806: optional roles filter, optional status filter 
1.233     raeburn  10807: 
                   10808: =cut
                   10809: 
                   10810: ###############################################
                   10811: sub get_sections {
1.419     raeburn  10812:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 10813:     if (!defined($cdom) || !defined($cnum)) {
                   10814:         my $cid =  $env{'request.course.id'};
                   10815: 
                   10816: 	return if (!defined($cid));
                   10817: 
                   10818:         $cdom = $env{'course.'.$cid.'.domain'};
                   10819:         $cnum = $env{'course.'.$cid.'.num'};
                   10820:     }
                   10821: 
                   10822:     my %sectioncount;
1.419     raeburn  10823:     my $now = time;
1.240     albertel 10824: 
1.1118    raeburn  10825:     my $check_students = 1;
                   10826:     my $only_students = 0;
                   10827:     if (ref($possible_roles) eq 'ARRAY') {
                   10828:         if (grep(/^st$/,@{$possible_roles})) {
                   10829:             if (@{$possible_roles} == 1) {
                   10830:                 $only_students = 1;
                   10831:             }
                   10832:         } else {
                   10833:             $check_students = 0;
                   10834:         }
                   10835:     }
                   10836: 
                   10837:     if ($check_students) { 
1.276     albertel 10838: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 10839: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   10840: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  10841:         my $start_index = &Apache::loncoursedata::CL_START();
                   10842:         my $end_index = &Apache::loncoursedata::CL_END();
                   10843:         my $status;
1.366     albertel 10844: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  10845: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   10846: 				                     $data->[$status_index],
                   10847:                                                      $data->[$start_index],
                   10848:                                                      $data->[$end_index]);
                   10849:             if ($stu_status eq 'Active') {
                   10850:                 $status = 'active';
                   10851:             } elsif ($end < $now) {
                   10852:                 $status = 'previous';
                   10853:             } elsif ($start > $now) {
                   10854:                 $status = 'future';
                   10855:             } 
                   10856: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   10857:                 if ((!defined($possible_status)) || (($status ne '') && 
                   10858:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   10859: 		    $sectioncount{$section}++;
                   10860:                 }
1.240     albertel 10861: 	    }
                   10862: 	}
                   10863:     }
1.1118    raeburn  10864:     if ($only_students) {
                   10865:         return %sectioncount;
                   10866:     }
1.240     albertel 10867:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   10868:     foreach my $user (sort(keys(%courseroles))) {
                   10869: 	if ($user !~ /^(\w{2})/) { next; }
                   10870: 	my ($role) = ($user =~ /^(\w{2})/);
                   10871: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  10872: 	my ($section,$status);
1.240     albertel 10873: 	if ($role eq 'cr' &&
                   10874: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   10875: 	    $section=$1;
                   10876: 	}
                   10877: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   10878: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  10879:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   10880:         if ($end == -1 && $start == -1) {
                   10881:             next; #deleted role
                   10882:         }
                   10883:         if (!defined($possible_status)) { 
                   10884:             $sectioncount{$section}++;
                   10885:         } else {
                   10886:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   10887:                 $status = 'active';
                   10888:             } elsif ($end < $now) {
                   10889:                 $status = 'future';
                   10890:             } elsif ($start > $now) {
                   10891:                 $status = 'previous';
                   10892:             }
                   10893:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   10894:                 $sectioncount{$section}++;
                   10895:             }
                   10896:         }
1.233     raeburn  10897:     }
1.366     albertel 10898:     return %sectioncount;
1.233     raeburn  10899: }
                   10900: 
1.274     raeburn  10901: ###############################################
1.294     raeburn  10902: 
                   10903: =pod
1.405     albertel 10904: 
                   10905: =item * &get_course_users()
                   10906: 
1.275     raeburn  10907: Retrieves usernames:domains for users in the specified course
                   10908: with specific role(s), and access status. 
                   10909: 
                   10910: Incoming parameters:
1.277     albertel 10911: 1. course domain
                   10912: 2. course number
                   10913: 3. access status: users must have - either active, 
1.275     raeburn  10914: previous, future, or all.
1.277     albertel 10915: 4. reference to array of permissible roles
1.288     raeburn  10916: 5. reference to array of section restrictions (optional)
                   10917: 6. reference to results object (hash of hashes).
                   10918: 7. reference to optional userdata hash
1.609     raeburn  10919: 8. reference to optional statushash
1.630     raeburn  10920: 9. flag if privileged users (except those set to unhide in
                   10921:    course settings) should be excluded    
1.609     raeburn  10922: Keys of top level results hash are roles.
1.275     raeburn  10923: Keys of inner hashes are username:domain, with 
                   10924: values set to access type.
1.288     raeburn  10925: Optional userdata hash returns an array with arguments in the 
                   10926: same order as loncoursedata::get_classlist() for student data.
                   10927: 
1.609     raeburn  10928: Optional statushash returns
                   10929: 
1.288     raeburn  10930: Entries for end, start, section and status are blank because
                   10931: of the possibility of multiple values for non-student roles.
                   10932: 
1.275     raeburn  10933: =cut
1.405     albertel 10934: 
1.275     raeburn  10935: ###############################################
1.405     albertel 10936: 
1.275     raeburn  10937: sub get_course_users {
1.630     raeburn  10938:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  10939:     my %idx = ();
1.419     raeburn  10940:     my %seclists;
1.288     raeburn  10941: 
                   10942:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   10943:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   10944:     $idx{end} = &Apache::loncoursedata::CL_END();
                   10945:     $idx{start} = &Apache::loncoursedata::CL_START();
                   10946:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   10947:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   10948:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   10949:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   10950: 
1.290     albertel 10951:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 10952:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  10953:         my $now = time;
1.277     albertel 10954:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  10955:             my $match = 0;
1.412     raeburn  10956:             my $secmatch = 0;
1.419     raeburn  10957:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  10958:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  10959:             if ($section eq '') {
                   10960:                 $section = 'none';
                   10961:             }
1.291     albertel 10962:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 10963:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  10964:                     $secmatch = 1;
                   10965:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 10966:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  10967:                         $secmatch = 1;
                   10968:                     }
                   10969:                 } else {  
1.419     raeburn  10970: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  10971: 		        $secmatch = 1;
                   10972:                     }
1.290     albertel 10973: 		}
1.412     raeburn  10974:                 if (!$secmatch) {
                   10975:                     next;
                   10976:                 }
1.419     raeburn  10977:             }
1.275     raeburn  10978:             if (defined($$types{'active'})) {
1.288     raeburn  10979:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  10980:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  10981:                     $match = 1;
1.275     raeburn  10982:                 }
                   10983:             }
                   10984:             if (defined($$types{'previous'})) {
1.609     raeburn  10985:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  10986:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  10987:                     $match = 1;
1.275     raeburn  10988:                 }
                   10989:             }
                   10990:             if (defined($$types{'future'})) {
1.609     raeburn  10991:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  10992:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  10993:                     $match = 1;
1.275     raeburn  10994:                 }
                   10995:             }
1.609     raeburn  10996:             if ($match) {
                   10997:                 push(@{$seclists{$student}},$section);
                   10998:                 if (ref($userdata) eq 'HASH') {
                   10999:                     $$userdata{$student} = $$classlist{$student};
                   11000:                 }
                   11001:                 if (ref($statushash) eq 'HASH') {
                   11002:                     $statushash->{$student}{'st'}{$section} = $status;
                   11003:                 }
1.288     raeburn  11004:             }
1.275     raeburn  11005:         }
                   11006:     }
1.412     raeburn  11007:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  11008:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   11009:         my $now = time;
1.609     raeburn  11010:         my %displaystatus = ( previous => 'Expired',
                   11011:                               active   => 'Active',
                   11012:                               future   => 'Future',
                   11013:                             );
1.1121    raeburn  11014:         my (%nothide,@possdoms);
1.630     raeburn  11015:         if ($hidepriv) {
                   11016:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   11017:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   11018:                 if ($user !~ /:/) {
                   11019:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   11020:                 } else {
                   11021:                     $nothide{$user} = 1;
                   11022:                 }
                   11023:             }
1.1121    raeburn  11024:             my @possdoms = ($cdom);
                   11025:             if ($coursehash{'checkforpriv'}) {
                   11026:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   11027:             }
1.630     raeburn  11028:         }
1.439     raeburn  11029:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  11030:             my $match = 0;
1.412     raeburn  11031:             my $secmatch = 0;
1.439     raeburn  11032:             my $status;
1.412     raeburn  11033:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  11034:             $user =~ s/:$//;
1.439     raeburn  11035:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   11036:             if ($end == -1 || $start == -1) {
                   11037:                 next;
                   11038:             }
                   11039:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   11040:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  11041:                 my ($uname,$udom) = split(/:/,$user);
                   11042:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 11043:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  11044:                         $secmatch = 1;
                   11045:                     } elsif ($usec eq '') {
1.420     albertel 11046:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  11047:                             $secmatch = 1;
                   11048:                         }
                   11049:                     } else {
                   11050:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   11051:                             $secmatch = 1;
                   11052:                         }
                   11053:                     }
                   11054:                     if (!$secmatch) {
                   11055:                         next;
                   11056:                     }
1.288     raeburn  11057:                 }
1.419     raeburn  11058:                 if ($usec eq '') {
                   11059:                     $usec = 'none';
                   11060:                 }
1.275     raeburn  11061:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  11062:                     if ($hidepriv) {
1.1121    raeburn  11063:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  11064:                             (!$nothide{$uname.':'.$udom})) {
                   11065:                             next;
                   11066:                         }
                   11067:                     }
1.503     raeburn  11068:                     if ($end > 0 && $end < $now) {
1.439     raeburn  11069:                         $status = 'previous';
                   11070:                     } elsif ($start > $now) {
                   11071:                         $status = 'future';
                   11072:                     } else {
                   11073:                         $status = 'active';
                   11074:                     }
1.277     albertel 11075:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  11076:                         if ($status eq $type) {
1.420     albertel 11077:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  11078:                                 push(@{$$users{$role}{$user}},$type);
                   11079:                             }
1.288     raeburn  11080:                             $match = 1;
                   11081:                         }
                   11082:                     }
1.419     raeburn  11083:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   11084:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   11085: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   11086:                         }
1.420     albertel 11087:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  11088:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   11089:                         }
1.609     raeburn  11090:                         if (ref($statushash) eq 'HASH') {
                   11091:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   11092:                         }
1.275     raeburn  11093:                     }
                   11094:                 }
                   11095:             }
                   11096:         }
1.290     albertel 11097:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  11098:             if ((defined($cdom)) && (defined($cnum))) {
                   11099:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   11100:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   11101:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  11102:                     next if ($owner eq '');
                   11103:                     my ($ownername,$ownerdom);
                   11104:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   11105:                         $ownername = $1;
                   11106:                         $ownerdom = $2;
                   11107:                     } else {
                   11108:                         $ownername = $owner;
                   11109:                         $ownerdom = $cdom;
                   11110:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  11111:                     }
                   11112:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 11113:                     if (defined($userdata) && 
1.609     raeburn  11114: 			!exists($$userdata{$owner})) {
                   11115: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   11116:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   11117:                             push(@{$seclists{$owner}},'none');
                   11118:                         }
                   11119:                         if (ref($statushash) eq 'HASH') {
                   11120:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  11121:                         }
1.290     albertel 11122: 		    }
1.279     raeburn  11123:                 }
                   11124:             }
                   11125:         }
1.419     raeburn  11126:         foreach my $user (keys(%seclists)) {
                   11127:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   11128:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   11129:         }
1.275     raeburn  11130:     }
                   11131:     return;
                   11132: }
                   11133: 
1.288     raeburn  11134: sub get_user_info {
                   11135:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 11136:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   11137: 	&plainname($uname,$udom,'lastname');
1.291     albertel 11138:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  11139:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  11140:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   11141:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  11142:     return;
                   11143: }
1.275     raeburn  11144: 
1.472     raeburn  11145: ###############################################
                   11146: 
                   11147: =pod
                   11148: 
                   11149: =item * &get_user_quota()
                   11150: 
1.1134    raeburn  11151: Retrieves quota assigned for storage of user files.
                   11152: Default is to report quota for portfolio files.
1.472     raeburn  11153: 
                   11154: Incoming parameters:
                   11155: 1. user's username
                   11156: 2. user's domain
1.1134    raeburn  11157: 3. quota name - portfolio, author, or course
1.1136    raeburn  11158:    (if no quota name provided, defaults to portfolio).
1.1237    raeburn  11159: 4. crstype - official, unofficial, textbook, placement or community, 
                   11160:    if quota name is course
1.472     raeburn  11161: 
                   11162: Returns:
1.1163    raeburn  11163: 1. Disk quota (in MB) assigned to student.
1.536     raeburn  11164: 2. (Optional) Type of setting: custom or default
                   11165:    (individually assigned or default for user's 
                   11166:    institutional status).
                   11167: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   11168:    or student - types as defined in localenroll::inst_usertypes 
                   11169:    for user's domain, which determines default quota for user.
                   11170: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  11171: 
                   11172: If a value has been stored in the user's environment, 
1.536     raeburn  11173: it will return that, otherwise it returns the maximal default
1.1134    raeburn  11174: defined for the user's institutional status(es) in the domain.
1.472     raeburn  11175: 
                   11176: =cut
                   11177: 
                   11178: ###############################################
                   11179: 
                   11180: 
                   11181: sub get_user_quota {
1.1136    raeburn  11182:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  11183:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  11184:     if (!defined($udom)) {
                   11185:         $udom = $env{'user.domain'};
                   11186:     }
                   11187:     if (!defined($uname)) {
                   11188:         $uname = $env{'user.name'};
                   11189:     }
                   11190:     if (($udom eq '' || $uname eq '') ||
                   11191:         ($udom eq 'public') && ($uname eq 'public')) {
                   11192:         $quota = 0;
1.536     raeburn  11193:         $quotatype = 'default';
                   11194:         $defquota = 0; 
1.472     raeburn  11195:     } else {
1.536     raeburn  11196:         my $inststatus;
1.1134    raeburn  11197:         if ($quotaname eq 'course') {
                   11198:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   11199:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   11200:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   11201:             } else {
                   11202:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   11203:                 $quota = $cenv{'internal.uploadquota'};
                   11204:             }
1.536     raeburn  11205:         } else {
1.1134    raeburn  11206:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   11207:                 if ($quotaname eq 'author') {
                   11208:                     $quota = $env{'environment.authorquota'};
                   11209:                 } else {
                   11210:                     $quota = $env{'environment.portfolioquota'};
                   11211:                 }
                   11212:                 $inststatus = $env{'environment.inststatus'};
                   11213:             } else {
                   11214:                 my %userenv = 
                   11215:                     &Apache::lonnet::get('environment',['portfolioquota',
                   11216:                                          'authorquota','inststatus'],$udom,$uname);
                   11217:                 my ($tmp) = keys(%userenv);
                   11218:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   11219:                     if ($quotaname eq 'author') {
                   11220:                         $quota = $userenv{'authorquota'};
                   11221:                     } else {
                   11222:                         $quota = $userenv{'portfolioquota'};
                   11223:                     }
                   11224:                     $inststatus = $userenv{'inststatus'};
                   11225:                 } else {
                   11226:                     undef(%userenv);
                   11227:                 }
                   11228:             }
                   11229:         }
                   11230:         if ($quota eq '' || wantarray) {
                   11231:             if ($quotaname eq 'course') {
                   11232:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165    raeburn  11233:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') || 
1.1237    raeburn  11234:                     ($crstype eq 'community') || ($crstype eq 'textbook') ||
                   11235:                     ($crstype eq 'placement')) { 
1.1136    raeburn  11236:                     $defquota = $domdefs{$crstype.'quota'};
                   11237:                 }
                   11238:                 if ($defquota eq '') {
                   11239:                     $defquota = 500;
                   11240:                 }
1.1134    raeburn  11241:             } else {
                   11242:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   11243:             }
                   11244:             if ($quota eq '') {
                   11245:                 $quota = $defquota;
                   11246:                 $quotatype = 'default';
                   11247:             } else {
                   11248:                 $quotatype = 'custom';
                   11249:             }
1.472     raeburn  11250:         }
                   11251:     }
1.536     raeburn  11252:     if (wantarray) {
                   11253:         return ($quota,$quotatype,$settingstatus,$defquota);
                   11254:     } else {
                   11255:         return $quota;
                   11256:     }
1.472     raeburn  11257: }
                   11258: 
                   11259: ###############################################
                   11260: 
                   11261: =pod
                   11262: 
                   11263: =item * &default_quota()
                   11264: 
1.536     raeburn  11265: Retrieves default quota assigned for storage of user portfolio files,
                   11266: given an (optional) user's institutional status.
1.472     raeburn  11267: 
                   11268: Incoming parameters:
1.1142    raeburn  11269: 
1.472     raeburn  11270: 1. domain
1.536     raeburn  11271: 2. (Optional) institutional status(es).  This is a : separated list of 
                   11272:    status types (e.g., faculty, staff, student etc.)
                   11273:    which apply to the user for whom the default is being retrieved.
                   11274:    If the institutional status string in undefined, the domain
1.1134    raeburn  11275:    default quota will be returned.
                   11276: 3.  quota name - portfolio, author, or course
                   11277:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  11278: 
                   11279: Returns:
1.1142    raeburn  11280: 
1.1163    raeburn  11281: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536     raeburn  11282: 2. (Optional) institutional type which determined the value of the
                   11283:    default quota.
1.472     raeburn  11284: 
                   11285: If a value has been stored in the domain's configuration db,
                   11286: it will return that, otherwise it returns 20 (for backwards 
                   11287: compatibility with domains which have not set up a configuration
1.1163    raeburn  11288: db file; the original statically defined portfolio quota was 20 MB). 
1.472     raeburn  11289: 
1.536     raeburn  11290: If the user's status includes multiple types (e.g., staff and student),
                   11291: the largest default quota which applies to the user determines the
                   11292: default quota returned.
                   11293: 
1.472     raeburn  11294: =cut
                   11295: 
                   11296: ###############################################
                   11297: 
                   11298: 
                   11299: sub default_quota {
1.1134    raeburn  11300:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  11301:     my ($defquota,$settingstatus);
                   11302:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  11303:                                             ['quotas'],$udom);
1.1134    raeburn  11304:     my $key = 'defaultquota';
                   11305:     if ($quotaname eq 'author') {
                   11306:         $key = 'authorquota';
                   11307:     }
1.622     raeburn  11308:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  11309:         if ($inststatus ne '') {
1.765     raeburn  11310:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  11311:             foreach my $item (@statuses) {
1.1134    raeburn  11312:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   11313:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  11314:                         if ($defquota eq '') {
1.1134    raeburn  11315:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  11316:                             $settingstatus = $item;
1.1134    raeburn  11317:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   11318:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  11319:                             $settingstatus = $item;
                   11320:                         }
                   11321:                     }
1.1134    raeburn  11322:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  11323:                     if ($quotahash{'quotas'}{$item} ne '') {
                   11324:                         if ($defquota eq '') {
                   11325:                             $defquota = $quotahash{'quotas'}{$item};
                   11326:                             $settingstatus = $item;
                   11327:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   11328:                             $defquota = $quotahash{'quotas'}{$item};
                   11329:                             $settingstatus = $item;
                   11330:                         }
1.536     raeburn  11331:                     }
                   11332:                 }
                   11333:             }
                   11334:         }
                   11335:         if ($defquota eq '') {
1.1134    raeburn  11336:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   11337:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   11338:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  11339:                 $defquota = $quotahash{'quotas'}{'default'};
                   11340:             }
1.536     raeburn  11341:             $settingstatus = 'default';
1.1139    raeburn  11342:             if ($defquota eq '') {
                   11343:                 if ($quotaname eq 'author') {
                   11344:                     $defquota = 500;
                   11345:                 }
                   11346:             }
1.536     raeburn  11347:         }
                   11348:     } else {
                   11349:         $settingstatus = 'default';
1.1134    raeburn  11350:         if ($quotaname eq 'author') {
                   11351:             $defquota = 500;
                   11352:         } else {
                   11353:             $defquota = 20;
                   11354:         }
1.536     raeburn  11355:     }
                   11356:     if (wantarray) {
                   11357:         return ($defquota,$settingstatus);
1.472     raeburn  11358:     } else {
1.536     raeburn  11359:         return $defquota;
1.472     raeburn  11360:     }
                   11361: }
                   11362: 
1.1135    raeburn  11363: ###############################################
                   11364: 
                   11365: =pod
                   11366: 
1.1136    raeburn  11367: =item * &excess_filesize_warning()
1.1135    raeburn  11368: 
                   11369: Returns warning message if upload of file to authoring space, or copying
1.1136    raeburn  11370: of existing file within authoring space will cause quota for the authoring
1.1146    raeburn  11371: space to be exceeded.
1.1136    raeburn  11372: 
                   11373: Same, if upload of a file directly to a course/community via Course Editor
1.1137    raeburn  11374: will cause quota for uploaded content for the course to be exceeded.
1.1135    raeburn  11375: 
1.1165    raeburn  11376: Inputs: 7 
1.1136    raeburn  11377: 1. username or coursenum
1.1135    raeburn  11378: 2. domain
1.1136    raeburn  11379: 3. context ('author' or 'course')
1.1135    raeburn  11380: 4. filename of file for which action is being requested
                   11381: 5. filesize (kB) of file
                   11382: 6. action being taken: copy or upload.
1.1237    raeburn  11383: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135    raeburn  11384: 
                   11385: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142    raeburn  11386:          otherwise return null.
                   11387: 
                   11388: =back
1.1135    raeburn  11389: 
                   11390: =cut
                   11391: 
1.1136    raeburn  11392: sub excess_filesize_warning {
1.1165    raeburn  11393:     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136    raeburn  11394:     my $current_disk_usage = 0;
1.1165    raeburn  11395:     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136    raeburn  11396:     if ($context eq 'author') {
                   11397:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   11398:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   11399:     } else {
                   11400:         foreach my $subdir ('docs','supplemental') {
                   11401:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   11402:         }
                   11403:     }
1.1135    raeburn  11404:     $disk_quota = int($disk_quota * 1000);
                   11405:     if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179    bisitz   11406:         return '<p class="LC_warning">'.
1.1135    raeburn  11407:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179    bisitz   11408:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                   11409:                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135    raeburn  11410:                             $disk_quota,$current_disk_usage).
                   11411:                '</p>';
                   11412:     }
                   11413:     return;
                   11414: }
                   11415: 
                   11416: ###############################################
                   11417: 
                   11418: 
1.1136    raeburn  11419: 
                   11420: 
1.384     raeburn  11421: sub get_secgrprole_info {
                   11422:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   11423:     my %sections_count = &get_sections($cdom,$cnum);
                   11424:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   11425:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   11426:     my @groups = sort(keys(%curr_groups));
                   11427:     my $allroles = [];
                   11428:     my $rolehash;
                   11429:     my $accesshash = {
                   11430:                      active => 'Currently has access',
                   11431:                      future => 'Will have future access',
                   11432:                      previous => 'Previously had access',
                   11433:                   };
                   11434:     if ($needroles) {
                   11435:         $rolehash = {'all' => 'all'};
1.385     albertel 11436:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   11437: 	if (&Apache::lonnet::error(%user_roles)) {
                   11438: 	    undef(%user_roles);
                   11439: 	}
                   11440:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  11441:             my ($role)=split(/\:/,$item,2);
                   11442:             if ($role eq 'cr') { next; }
                   11443:             if ($role =~ /^cr/) {
                   11444:                 $$rolehash{$role} = (split('/',$role))[3];
                   11445:             } else {
                   11446:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   11447:             }
                   11448:         }
                   11449:         foreach my $key (sort(keys(%{$rolehash}))) {
                   11450:             push(@{$allroles},$key);
                   11451:         }
                   11452:         push (@{$allroles},'st');
                   11453:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   11454:     }
                   11455:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   11456: }
                   11457: 
1.555     raeburn  11458: sub user_picker {
1.1279    raeburn  11459:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555     raeburn  11460:     my $currdom = $dom;
1.1253    raeburn  11461:     my @alldoms = &Apache::lonnet::all_domains();
                   11462:     if (@alldoms == 1) {
                   11463:         my %domsrch = &Apache::lonnet::get_dom('configuration',
                   11464:                                                ['directorysrch'],$alldoms[0]);
                   11465:         my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
                   11466:         my $showdom = $domdesc;
                   11467:         if ($showdom eq '') {
                   11468:             $showdom = $dom;
                   11469:         }
                   11470:         if (ref($domsrch{'directorysrch'}) eq 'HASH') {
                   11471:             if ((!$domsrch{'directorysrch'}{'available'}) &&
                   11472:                 ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
                   11473:                 return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
                   11474:             }
                   11475:         }
                   11476:     }
1.555     raeburn  11477:     my %curr_selected = (
                   11478:                         srchin => 'dom',
1.580     raeburn  11479:                         srchby => 'lastname',
1.555     raeburn  11480:                       );
                   11481:     my $srchterm;
1.625     raeburn  11482:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  11483:         if ($srch->{'srchby'} ne '') {
                   11484:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   11485:         }
                   11486:         if ($srch->{'srchin'} ne '') {
                   11487:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   11488:         }
                   11489:         if ($srch->{'srchtype'} ne '') {
                   11490:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   11491:         }
                   11492:         if ($srch->{'srchdomain'} ne '') {
                   11493:             $currdom = $srch->{'srchdomain'};
                   11494:         }
                   11495:         $srchterm = $srch->{'srchterm'};
                   11496:     }
1.1222    damieng  11497:     my %html_lt=&Apache::lonlocal::texthash(
1.573     raeburn  11498:                     'usr'       => 'Search criteria',
1.563     raeburn  11499:                     'doma'      => 'Domain/institution to search',
1.558     albertel 11500:                     'uname'     => 'username',
                   11501:                     'lastname'  => 'last name',
1.555     raeburn  11502:                     'lastfirst' => 'last name, first name',
1.558     albertel 11503:                     'crs'       => 'in this course',
1.576     raeburn  11504:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 11505:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  11506:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 11507:                     'exact'     => 'is',
                   11508:                     'contains'  => 'contains',
1.569     raeburn  11509:                     'begins'    => 'begins with',
1.1222    damieng  11510:                                        );
                   11511:     my %js_lt=&Apache::lonlocal::texthash(
1.571     raeburn  11512:                     'youm'      => "You must include some text to search for.",
                   11513:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   11514:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   11515:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   11516:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   11517:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   11518:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   11519:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  11520:                                        );
1.1222    damieng  11521:     &html_escape(\%html_lt);
                   11522:     &js_escape(\%js_lt);
1.1255    raeburn  11523:     my $domform;
1.1277    raeburn  11524:     my $allow_blank = 1;
1.1255    raeburn  11525:     if ($fixeddom) {
1.1277    raeburn  11526:         $allow_blank = 0;
                   11527:         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1255    raeburn  11528:     } else {
1.1287    raeburn  11529:         my $defdom = $env{'request.role.domain'};
1.1288    raeburn  11530:         my ($trusted,$untrusted);
1.1287    raeburn  11531:         if (($context eq 'requestcrs') || ($context eq 'course')) {
1.1288    raeburn  11532:             ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
1.1287    raeburn  11533:         } elsif ($context eq 'author') {
1.1288    raeburn  11534:             ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
1.1287    raeburn  11535:         } elsif ($context eq 'domain') {
1.1288    raeburn  11536:             ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
1.1287    raeburn  11537:         }
1.1288    raeburn  11538:         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
1.1255    raeburn  11539:     }
1.563     raeburn  11540:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  11541: 
                   11542:     my @srchins = ('crs','dom','alc','instd');
                   11543: 
                   11544:     foreach my $option (@srchins) {
                   11545:         # FIXME 'alc' option unavailable until 
                   11546:         #       loncreateuser::print_user_query_page()
                   11547:         #       has been completed.
                   11548:         next if ($option eq 'alc');
1.880     raeburn  11549:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  11550:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.1279    raeburn  11551:         next if (($option eq 'instd') && ($noinstd));
1.563     raeburn  11552:         if ($curr_selected{'srchin'} eq $option) {
                   11553:             $srchinsel .= ' 
1.1222    damieng  11554:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563     raeburn  11555:         } else {
                   11556:             $srchinsel .= '
1.1222    damieng  11557:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563     raeburn  11558:         }
1.555     raeburn  11559:     }
1.563     raeburn  11560:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  11561: 
                   11562:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  11563:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  11564:         if ($curr_selected{'srchby'} eq $option) {
                   11565:             $srchbysel .= '
1.1222    damieng  11566:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  11567:         } else {
                   11568:             $srchbysel .= '
1.1222    damieng  11569:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  11570:          }
                   11571:     }
                   11572:     $srchbysel .= "\n  </select>\n";
                   11573: 
                   11574:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  11575:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  11576:         if ($curr_selected{'srchtype'} eq $option) {
                   11577:             $srchtypesel .= '
1.1222    damieng  11578:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  11579:         } else {
                   11580:             $srchtypesel .= '
1.1222    damieng  11581:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  11582:         }
                   11583:     }
                   11584:     $srchtypesel .= "\n  </select>\n";
                   11585: 
1.558     albertel 11586:     my ($newuserscript,$new_user_create);
1.994     raeburn  11587:     my $context_dom = $env{'request.role.domain'};
                   11588:     if ($context eq 'requestcrs') {
                   11589:         if ($env{'form.coursedom'} ne '') { 
                   11590:             $context_dom = $env{'form.coursedom'};
                   11591:         }
                   11592:     }
1.556     raeburn  11593:     if ($forcenewuser) {
1.576     raeburn  11594:         if (ref($srch) eq 'HASH') {
1.994     raeburn  11595:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  11596:                 if ($cancreate) {
                   11597:                     $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>';
                   11598:                 } else {
1.799     bisitz   11599:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  11600:                     my %usertypetext = (
                   11601:                         official   => 'institutional',
                   11602:                         unofficial => 'non-institutional',
                   11603:                     );
1.799     bisitz   11604:                     $new_user_create = '<p class="LC_warning">'
                   11605:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   11606:                                       .' '
                   11607:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   11608:                                           ,'<a href="'.$helplink.'">','</a>')
                   11609:                                       .'</p><br />';
1.627     raeburn  11610:                 }
1.576     raeburn  11611:             }
                   11612:         }
                   11613: 
1.556     raeburn  11614:         $newuserscript = <<"ENDSCRIPT";
                   11615: 
1.570     raeburn  11616: function setSearch(createnew,callingForm) {
1.556     raeburn  11617:     if (createnew == 1) {
1.570     raeburn  11618:         for (var i=0; i<callingForm.srchby.length; i++) {
                   11619:             if (callingForm.srchby.options[i].value == 'uname') {
                   11620:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  11621:             }
                   11622:         }
1.570     raeburn  11623:         for (var i=0; i<callingForm.srchin.length; i++) {
                   11624:             if ( callingForm.srchin.options[i].value == 'dom') {
                   11625: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  11626:             }
                   11627:         }
1.570     raeburn  11628:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   11629:             if (callingForm.srchtype.options[i].value == 'exact') {
                   11630:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  11631:             }
                   11632:         }
1.570     raeburn  11633:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  11634:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  11635:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  11636:             }
                   11637:         }
                   11638:     }
                   11639: }
                   11640: ENDSCRIPT
1.558     albertel 11641: 
1.556     raeburn  11642:     }
                   11643: 
1.555     raeburn  11644:     my $output = <<"END_BLOCK";
1.556     raeburn  11645: <script type="text/javascript">
1.824     bisitz   11646: // <![CDATA[
1.570     raeburn  11647: function validateEntry(callingForm) {
1.558     albertel 11648: 
1.556     raeburn  11649:     var checkok = 1;
1.558     albertel 11650:     var srchin;
1.570     raeburn  11651:     for (var i=0; i<callingForm.srchin.length; i++) {
                   11652: 	if ( callingForm.srchin[i].checked ) {
                   11653: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 11654: 	}
                   11655:     }
                   11656: 
1.570     raeburn  11657:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   11658:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   11659:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   11660:     var srchterm =  callingForm.srchterm.value;
                   11661:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  11662:     var msg = "";
                   11663: 
                   11664:     if (srchterm == "") {
                   11665:         checkok = 0;
1.1222    damieng  11666:         msg += "$js_lt{'youm'}\\n";
1.556     raeburn  11667:     }
                   11668: 
1.569     raeburn  11669:     if (srchtype== 'begins') {
                   11670:         if (srchterm.length < 2) {
                   11671:             checkok = 0;
1.1222    damieng  11672:             msg += "$js_lt{'thte'}\\n";
1.569     raeburn  11673:         }
                   11674:     }
                   11675: 
1.556     raeburn  11676:     if (srchtype== 'contains') {
                   11677:         if (srchterm.length < 3) {
                   11678:             checkok = 0;
1.1222    damieng  11679:             msg += "$js_lt{'thet'}\\n";
1.556     raeburn  11680:         }
                   11681:     }
                   11682:     if (srchin == 'instd') {
                   11683:         if (srchdomain == '') {
                   11684:             checkok = 0;
1.1222    damieng  11685:             msg += "$js_lt{'yomc'}\\n";
1.556     raeburn  11686:         }
                   11687:     }
                   11688:     if (srchin == 'dom') {
                   11689:         if (srchdomain == '') {
                   11690:             checkok = 0;
1.1222    damieng  11691:             msg += "$js_lt{'ymcd'}\\n";
1.556     raeburn  11692:         }
                   11693:     }
                   11694:     if (srchby == 'lastfirst') {
                   11695:         if (srchterm.indexOf(",") == -1) {
                   11696:             checkok = 0;
1.1222    damieng  11697:             msg += "$js_lt{'whus'}\\n";
1.556     raeburn  11698:         }
                   11699:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   11700:             checkok = 0;
1.1222    damieng  11701:             msg += "$js_lt{'whse'}\\n";
1.556     raeburn  11702:         }
                   11703:     }
                   11704:     if (checkok == 0) {
1.1222    damieng  11705:         alert("$js_lt{'thfo'}\\n"+msg);
1.556     raeburn  11706:         return;
                   11707:     }
                   11708:     if (checkok == 1) {
1.570     raeburn  11709:         callingForm.submit();
1.556     raeburn  11710:     }
                   11711: }
                   11712: 
                   11713: $newuserscript
                   11714: 
1.824     bisitz   11715: // ]]>
1.556     raeburn  11716: </script>
1.558     albertel 11717: 
                   11718: $new_user_create
                   11719: 
1.555     raeburn  11720: END_BLOCK
1.558     albertel 11721: 
1.876     raeburn  11722:     $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222    damieng  11723:                &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876     raeburn  11724:                $domform.
                   11725:                &Apache::lonhtmlcommon::row_closure().
1.1222    damieng  11726:                &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876     raeburn  11727:                $srchbysel.
                   11728:                $srchtypesel. 
                   11729:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   11730:                $srchinsel.
                   11731:                &Apache::lonhtmlcommon::row_closure(1). 
                   11732:                &Apache::lonhtmlcommon::end_pick_box().
                   11733:                '<br />';
1.1253    raeburn  11734:     return ($output,1);
1.555     raeburn  11735: }
                   11736: 
1.612     raeburn  11737: sub user_rule_check {
1.615     raeburn  11738:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226    raeburn  11739:     my ($response,%inst_response);
1.612     raeburn  11740:     if (ref($usershash) eq 'HASH') {
1.1226    raeburn  11741:         if (keys(%{$usershash}) > 1) {
                   11742:             my (%by_username,%by_id,%userdoms);
                   11743:             my $checkid; 
                   11744:             if (ref($checks) eq 'HASH') {
                   11745:                 if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
                   11746:                     $checkid = 1;
                   11747:                 }
                   11748:             }
                   11749:             foreach my $user (keys(%{$usershash})) {
                   11750:                 my ($uname,$udom) = split(/:/,$user);
                   11751:                 if ($checkid) {
                   11752:                     if (ref($usershash->{$user}) eq 'HASH') {
                   11753:                         if ($usershash->{$user}->{'id'} ne '') {
1.1227    raeburn  11754:                             $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname; 
1.1226    raeburn  11755:                             $userdoms{$udom} = 1;
1.1227    raeburn  11756:                             if (ref($inst_results) eq 'HASH') {
                   11757:                                 $inst_results->{$uname.':'.$udom} = {};
                   11758:                             }
1.1226    raeburn  11759:                         }
                   11760:                     }
                   11761:                 } else {
                   11762:                     $by_username{$udom}{$uname} = 1;
                   11763:                     $userdoms{$udom} = 1;
1.1227    raeburn  11764:                     if (ref($inst_results) eq 'HASH') {
                   11765:                         $inst_results->{$uname.':'.$udom} = {};
                   11766:                     }
1.1226    raeburn  11767:                 }
                   11768:             }
                   11769:             foreach my $udom (keys(%userdoms)) {
                   11770:                 if (!$got_rules->{$udom}) {
                   11771:                     my %domconfig = &Apache::lonnet::get_dom('configuration',
                   11772:                                                              ['usercreation'],$udom);
                   11773:                     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   11774:                         foreach my $item ('username','id') {
                   11775:                             if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227    raeburn  11776:                                 $$curr_rules{$udom}{$item} =
                   11777:                                     $domconfig{'usercreation'}{$item.'_rule'};
1.1226    raeburn  11778:                             }
                   11779:                         }
                   11780:                     }
                   11781:                     $got_rules->{$udom} = 1;
                   11782:                 }
1.612     raeburn  11783:             }
1.1226    raeburn  11784:             if ($checkid) {
                   11785:                 foreach my $udom (keys(%by_id)) {
                   11786:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
                   11787:                     if ($outcome eq 'ok') {
1.1227    raeburn  11788:                         foreach my $id (keys(%{$by_id{$udom}})) {
                   11789:                             my $uname = $by_id{$udom}{$id};
                   11790:                             $inst_response{$uname.':'.$udom} = $outcome;
                   11791:                         }
1.1226    raeburn  11792:                         if (ref($results) eq 'HASH') {
                   11793:                             foreach my $uname (keys(%{$results})) {
1.1227    raeburn  11794:                                 if (exists($inst_response{$uname.':'.$udom})) {
                   11795:                                     $inst_response{$uname.':'.$udom} = $outcome;
                   11796:                                     $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   11797:                                 }
1.1226    raeburn  11798:                             }
                   11799:                         }
                   11800:                     }
1.612     raeburn  11801:                 }
1.615     raeburn  11802:             } else {
1.1226    raeburn  11803:                 foreach my $udom (keys(%by_username)) {
                   11804:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
                   11805:                     if ($outcome eq 'ok') {
1.1227    raeburn  11806:                         foreach my $uname (keys(%{$by_username{$udom}})) {
                   11807:                             $inst_response{$uname.':'.$udom} = $outcome;
                   11808:                         }
1.1226    raeburn  11809:                         if (ref($results) eq 'HASH') {
                   11810:                             foreach my $uname (keys(%{$results})) {
                   11811:                                 $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   11812:                             }
                   11813:                         }
                   11814:                     }
                   11815:                 }
1.612     raeburn  11816:             }
1.1226    raeburn  11817:         } elsif (keys(%{$usershash}) == 1) {
                   11818:             my $user = (keys(%{$usershash}))[0];
                   11819:             my ($uname,$udom) = split(/:/,$user);
                   11820:             if (($udom ne '') && ($uname ne '')) {
                   11821:                 if (ref($usershash->{$user}) eq 'HASH') {
                   11822:                     if (ref($checks) eq 'HASH') {
                   11823:                         if (defined($checks->{'username'})) {
                   11824:                             ($inst_response{$user},%{$inst_results->{$user}}) = 
                   11825:                                 &Apache::lonnet::get_instuser($udom,$uname);
                   11826:                         } elsif (defined($checks->{'id'})) {
                   11827:                             if ($usershash->{$user}->{'id'} ne '') {
                   11828:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   11829:                                     &Apache::lonnet::get_instuser($udom,undef,
                   11830:                                                                   $usershash->{$user}->{'id'});
                   11831:                             } else {
                   11832:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   11833:                                     &Apache::lonnet::get_instuser($udom,$uname);
                   11834:                             }
1.585     raeburn  11835:                         }
1.1226    raeburn  11836:                     } else {
                   11837:                        ($inst_response{$user},%{$inst_results->{$user}}) =
                   11838:                             &Apache::lonnet::get_instuser($udom,$uname);
                   11839:                        return;
                   11840:                     }
                   11841:                     if (!$got_rules->{$udom}) {
                   11842:                         my %domconfig = &Apache::lonnet::get_dom('configuration',
                   11843:                                                                  ['usercreation'],$udom);
                   11844:                         if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   11845:                             foreach my $item ('username','id') {
                   11846:                                 if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   11847:                                    $$curr_rules{$udom}{$item} = 
                   11848:                                        $domconfig{'usercreation'}{$item.'_rule'};
                   11849:                                 }
                   11850:                             }
                   11851:                         }
                   11852:                         $got_rules->{$udom} = 1;
1.585     raeburn  11853:                     }
                   11854:                 }
1.1226    raeburn  11855:             } else {
                   11856:                 return;
                   11857:             }
                   11858:         } else {
                   11859:             return;
                   11860:         }
                   11861:         foreach my $user (keys(%{$usershash})) {
                   11862:             my ($uname,$udom) = split(/:/,$user);
                   11863:             next if (($udom eq '') || ($uname eq ''));
                   11864:             my $id;
1.1227    raeburn  11865:             if (ref($inst_results) eq 'HASH') {
                   11866:                 if (ref($inst_results->{$user}) eq 'HASH') {
                   11867:                     $id = $inst_results->{$user}->{'id'};
                   11868:                 }
                   11869:             }
                   11870:             if ($id eq '') { 
                   11871:                 if (ref($usershash->{$user})) {
                   11872:                     $id = $usershash->{$user}->{'id'};
                   11873:                 }
1.585     raeburn  11874:             }
1.612     raeburn  11875:             foreach my $item (keys(%{$checks})) {
                   11876:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   11877:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   11878:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226    raeburn  11879:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
                   11880:                                                                              $$curr_rules{$udom}{$item});
1.612     raeburn  11881:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   11882:                                 if ($rule_check{$rule}) {
                   11883:                                     $$rulematch{$user}{$item} = $rule;
1.1226    raeburn  11884:                                     if ($inst_response{$user} eq 'ok') {
1.615     raeburn  11885:                                         if (ref($inst_results) eq 'HASH') {
                   11886:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   11887:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   11888:                                                     $$alerts{$item}{$udom}{$uname} = 1;
1.1227    raeburn  11889:                                                 } elsif ($item eq 'id') {
                   11890:                                                     if ($inst_results->{$user}->{'id'} eq '') {
                   11891:                                                         $$alerts{$item}{$udom}{$uname} = 1;
                   11892:                                                     }
1.615     raeburn  11893:                                                 }
1.612     raeburn  11894:                                             }
                   11895:                                         }
1.615     raeburn  11896:                                     }
                   11897:                                     last;
1.585     raeburn  11898:                                 }
                   11899:                             }
                   11900:                         }
                   11901:                     }
                   11902:                 }
                   11903:             }
                   11904:         }
                   11905:     }
1.612     raeburn  11906:     return;
                   11907: }
                   11908: 
                   11909: sub user_rule_formats {
                   11910:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   11911:     my %text = ( 
                   11912:                  'username' => 'Usernames',
                   11913:                  'id'       => 'IDs',
                   11914:                );
                   11915:     my $output;
                   11916:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   11917:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   11918:         if (@{$ruleorder} > 0) {
1.1102    raeburn  11919:             $output = '<br />'.
                   11920:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   11921:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   11922:                       ' <ul>';
1.612     raeburn  11923:             foreach my $rule (@{$ruleorder}) {
                   11924:                 if (ref($curr_rules) eq 'ARRAY') {
                   11925:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   11926:                         if (ref($rules->{$rule}) eq 'HASH') {
                   11927:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   11928:                                         $rules->{$rule}{'desc'}.'</li>';
                   11929:                         }
                   11930:                     }
                   11931:                 }
                   11932:             }
                   11933:             $output .= '</ul>';
                   11934:         }
                   11935:     }
                   11936:     return $output;
                   11937: }
                   11938: 
                   11939: sub instrule_disallow_msg {
1.615     raeburn  11940:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  11941:     my $response;
                   11942:     my %text = (
                   11943:                   item   => 'username',
                   11944:                   items  => 'usernames',
                   11945:                   match  => 'matches',
                   11946:                   do     => 'does',
                   11947:                   action => 'a username',
                   11948:                   one    => 'one',
                   11949:                );
                   11950:     if ($count > 1) {
                   11951:         $text{'item'} = 'usernames';
                   11952:         $text{'match'} ='match';
                   11953:         $text{'do'} = 'do';
                   11954:         $text{'action'} = 'usernames',
                   11955:         $text{'one'} = 'ones';
                   11956:     }
                   11957:     if ($checkitem eq 'id') {
                   11958:         $text{'items'} = 'IDs';
                   11959:         $text{'item'} = 'ID';
                   11960:         $text{'action'} = 'an ID';
1.615     raeburn  11961:         if ($count > 1) {
                   11962:             $text{'item'} = 'IDs';
                   11963:             $text{'action'} = 'IDs';
                   11964:         }
1.612     raeburn  11965:     }
1.674     bisitz   11966:     $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  11967:     if ($mode eq 'upload') {
                   11968:         if ($checkitem eq 'username') {
                   11969:             $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'}.");
                   11970:         } elsif ($checkitem eq 'id') {
1.674     bisitz   11971:             $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  11972:         }
1.669     raeburn  11973:     } elsif ($mode eq 'selfcreate') {
                   11974:         if ($checkitem eq 'id') {
                   11975:             $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.");
                   11976:         }
1.615     raeburn  11977:     } else {
                   11978:         if ($checkitem eq 'username') {
                   11979:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   11980:         } elsif ($checkitem eq 'id') {
                   11981:             $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.");
                   11982:         }
1.612     raeburn  11983:     }
                   11984:     return $response;
1.585     raeburn  11985: }
                   11986: 
1.624     raeburn  11987: sub personal_data_fieldtitles {
                   11988:     my %fieldtitles = &Apache::lonlocal::texthash (
                   11989:                         id => 'Student/Employee ID',
                   11990:                         permanentemail => 'E-mail address',
                   11991:                         lastname => 'Last Name',
                   11992:                         firstname => 'First Name',
                   11993:                         middlename => 'Middle Name',
                   11994:                         generation => 'Generation',
                   11995:                         gen => 'Generation',
1.765     raeburn  11996:                         inststatus => 'Affiliation',
1.624     raeburn  11997:                    );
                   11998:     return %fieldtitles;
                   11999: }
                   12000: 
1.642     raeburn  12001: sub sorted_inst_types {
                   12002:     my ($dom) = @_;
1.1185    raeburn  12003:     my ($usertypes,$order);
                   12004:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   12005:     if (ref($domdefaults{'inststatus'}) eq 'HASH') {
                   12006:         $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
                   12007:         $order = $domdefaults{'inststatus'}{'inststatusorder'};
                   12008:     } else {
                   12009:         ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   12010:     }
1.642     raeburn  12011:     my $othertitle = &mt('All users');
                   12012:     if ($env{'request.course.id'}) {
1.668     raeburn  12013:         $othertitle  = &mt('Any users');
1.642     raeburn  12014:     }
                   12015:     my @types;
                   12016:     if (ref($order) eq 'ARRAY') {
                   12017:         @types = @{$order};
                   12018:     }
                   12019:     if (@types == 0) {
                   12020:         if (ref($usertypes) eq 'HASH') {
                   12021:             @types = sort(keys(%{$usertypes}));
                   12022:         }
                   12023:     }
                   12024:     if (keys(%{$usertypes}) > 0) {
                   12025:         $othertitle = &mt('Other users');
                   12026:     }
                   12027:     return ($othertitle,$usertypes,\@types);
                   12028: }
                   12029: 
1.645     raeburn  12030: sub get_institutional_codes {
1.1361    raeburn  12031:     my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_;
1.645     raeburn  12032: # Get complete list of course sections to update
                   12033:     my @currsections = ();
                   12034:     my @currxlists = ();
1.1361    raeburn  12035:     my (%unclutteredsec,%unclutteredlcsec);
1.645     raeburn  12036:     my $coursecode = $$settings{'internal.coursecode'};
1.1361    raeburn  12037:     my $crskey = $crs.':'.$coursecode;
                   12038:     @{$unclutteredsec{$crskey}} = ();
                   12039:     @{$unclutteredlcsec{$crskey}} = ();
1.645     raeburn  12040: 
                   12041:     if ($$settings{'internal.sectionnums'} ne '') {
                   12042:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   12043:     }
                   12044: 
                   12045:     if ($$settings{'internal.crosslistings'} ne '') {
                   12046:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   12047:     }
                   12048: 
                   12049:     if (@currxlists > 0) {
1.1361    raeburn  12050:         foreach my $xl (@currxlists) {
                   12051:             if ($xl =~ /^([^:]+):(\w*)$/) {
1.645     raeburn  12052:                 unless (grep/^$1$/,@{$allcourses}) {
1.1263    raeburn  12053:                     push(@{$allcourses},$1);
1.645     raeburn  12054:                     $$LC_code{$1} = $2;
                   12055:                 }
                   12056:             }
                   12057:         }
                   12058:     }
1.1361    raeburn  12059: 
1.645     raeburn  12060:     if (@currsections > 0) {
1.1361    raeburn  12061:         foreach my $sec (@currsections) {
                   12062:             if ($sec =~ m/^(\w+):(\w*)$/ ) {
                   12063:                 my $instsec = $1;
1.645     raeburn  12064:                 my $lc_sec = $2;
1.1361    raeburn  12065:                 unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) {
                   12066:                     push(@{$unclutteredsec{$crskey}},$instsec);
                   12067:                     push(@{$unclutteredlcsec{$crskey}},$lc_sec);
                   12068:                 }
                   12069:             }
                   12070:         }
                   12071:     }
                   12072: 
                   12073:     if (@{$unclutteredsec{$crskey}} > 0) {
                   12074:         my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);
                   12075:         if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {
                   12076:             for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {
                   12077:                 my $sec = $coursecode.$formattedsec{$crskey}[$i];
                   12078:                 unless (grep/^\Q$sec\E$/,@{$allcourses}) {
1.1263    raeburn  12079:                     push(@{$allcourses},$sec);
1.1361    raeburn  12080:                     $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
1.645     raeburn  12081:                 }
                   12082:             }
                   12083:         }
                   12084:     }
                   12085:     return;
                   12086: }
                   12087: 
1.971     raeburn  12088: sub get_standard_codeitems {
                   12089:     return ('Year','Semester','Department','Number','Section');
                   12090: }
                   12091: 
1.112     bowersj2 12092: =pod
                   12093: 
1.780     raeburn  12094: =head1 Slot Helpers
                   12095: 
                   12096: =over 4
                   12097: 
                   12098: =item * sorted_slots()
                   12099: 
1.1040    raeburn  12100: Sorts an array of slot names in order of an optional sort key,
                   12101: default sort is by slot start time (earliest first). 
1.780     raeburn  12102: 
                   12103: Inputs:
                   12104: 
                   12105: =over 4
                   12106: 
                   12107: slotsarr  - Reference to array of unsorted slot names.
                   12108: 
                   12109: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   12110: 
1.1040    raeburn  12111: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   12112: 
1.549     albertel 12113: =back
                   12114: 
1.780     raeburn  12115: Returns:
                   12116: 
                   12117: =over 4
                   12118: 
1.1040    raeburn  12119: sorted   - An array of slot names sorted by a specified sort key 
                   12120:            (default sort key is start time of the slot).
1.780     raeburn  12121: 
                   12122: =back
                   12123: 
                   12124: =cut
                   12125: 
                   12126: 
                   12127: sub sorted_slots {
1.1040    raeburn  12128:     my ($slotsarr,$slots,$sortkey) = @_;
                   12129:     if ($sortkey eq '') {
                   12130:         $sortkey = 'starttime';
                   12131:     }
1.780     raeburn  12132:     my @sorted;
                   12133:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   12134:         @sorted =
                   12135:             sort {
                   12136:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  12137:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  12138:                      }
                   12139:                      if (ref($slots->{$a})) { return -1;}
                   12140:                      if (ref($slots->{$b})) { return 1;}
                   12141:                      return 0;
                   12142:                  } @{$slotsarr};
                   12143:     }
                   12144:     return @sorted;
                   12145: }
                   12146: 
1.1040    raeburn  12147: =pod
                   12148: 
                   12149: =item * get_future_slots()
                   12150: 
                   12151: Inputs:
                   12152: 
                   12153: =over 4
                   12154: 
                   12155: cnum - course number
                   12156: 
                   12157: cdom - course domain
                   12158: 
                   12159: now - current UNIX time
                   12160: 
                   12161: symb - optional symb
                   12162: 
                   12163: =back
                   12164: 
                   12165: Returns:
                   12166: 
                   12167: =over 4
                   12168: 
                   12169: sorted_reservable - ref to array of student_schedulable slots currently 
                   12170:                     reservable, ordered by end date of reservation period.
                   12171: 
                   12172: reservable_now - ref to hash of student_schedulable slots currently
                   12173:                  reservable.
                   12174: 
                   12175:     Keys in inner hash are:
                   12176:     (a) symb: either blank or symb to which slot use is restricted.
1.1250    raeburn  12177:     (b) endreserve: end date of reservation period.
                   12178:     (c) uniqueperiod: start,end dates when slot is to be uniquely
                   12179:         selected.
1.1040    raeburn  12180: 
                   12181: sorted_future - ref to array of student_schedulable slots reservable in
                   12182:                 the future, ordered by start date of reservation period.
                   12183: 
                   12184: future_reservable - ref to hash of student_schedulable slots reservable
                   12185:                     in the future.
                   12186: 
                   12187:     Keys in inner hash are:
                   12188:     (a) symb: either blank or symb to which slot use is restricted.
1.1250    raeburn  12189:     (b) startreserve: start date of reservation period.
                   12190:     (c) uniqueperiod: start,end dates when slot is to be uniquely
                   12191:         selected.
1.1040    raeburn  12192: 
                   12193: =back
                   12194: 
                   12195: =cut
                   12196: 
                   12197: sub get_future_slots {
                   12198:     my ($cnum,$cdom,$now,$symb) = @_;
1.1229    raeburn  12199:     my $map;
                   12200:     if ($symb) {
                   12201:         ($map) = &Apache::lonnet::decode_symb($symb);
                   12202:     }
1.1040    raeburn  12203:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   12204:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   12205:     foreach my $slot (keys(%slots)) {
                   12206:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   12207:         if ($symb) {
1.1229    raeburn  12208:             if ($slots{$slot}->{'symb'} ne '') {
                   12209:                 my $canuse;
                   12210:                 my %oksymbs;
                   12211:                 my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
                   12212:                 map { $oksymbs{$_} = 1; } @slotsymbs;
                   12213:                 if ($oksymbs{$symb}) {
                   12214:                     $canuse = 1;
                   12215:                 } else {
                   12216:                     foreach my $item (@slotsymbs) {
                   12217:                         if ($item =~ /\.(page|sequence)$/) {
                   12218:                             (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
                   12219:                             if (($map ne '') && ($map eq $sloturl)) {
                   12220:                                 $canuse = 1;
                   12221:                                 last;
                   12222:                             }
                   12223:                         }
                   12224:                     }
                   12225:                 }
                   12226:                 next unless ($canuse);
                   12227:             }
1.1040    raeburn  12228:         }
                   12229:         if (($slots{$slot}->{'starttime'} > $now) &&
                   12230:             ($slots{$slot}->{'endtime'} > $now)) {
                   12231:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   12232:                 my $userallowed = 0;
                   12233:                 if ($slots{$slot}->{'allowedsections'}) {
                   12234:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   12235:                     if (!defined($env{'request.role.sec'})
                   12236:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   12237:                         $userallowed=1;
                   12238:                     } else {
                   12239:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   12240:                             $userallowed=1;
                   12241:                         }
                   12242:                     }
                   12243:                     unless ($userallowed) {
                   12244:                         if (defined($env{'request.course.groups'})) {
                   12245:                             my @groups = split(/:/,$env{'request.course.groups'});
                   12246:                             foreach my $group (@groups) {
                   12247:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   12248:                                     $userallowed=1;
                   12249:                                     last;
                   12250:                                 }
                   12251:                             }
                   12252:                         }
                   12253:                     }
                   12254:                 }
                   12255:                 if ($slots{$slot}->{'allowedusers'}) {
                   12256:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   12257:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   12258:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   12259:                         $userallowed = 1;
                   12260:                     }
                   12261:                 }
                   12262:                 next unless($userallowed);
                   12263:             }
                   12264:             my $startreserve = $slots{$slot}->{'startreserve'};
                   12265:             my $endreserve = $slots{$slot}->{'endreserve'};
                   12266:             my $symb = $slots{$slot}->{'symb'};
1.1250    raeburn  12267:             my $uniqueperiod;
                   12268:             if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
                   12269:                 $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
                   12270:             }
1.1040    raeburn  12271:             if (($startreserve < $now) &&
                   12272:                 (!$endreserve || $endreserve > $now)) {
                   12273:                 my $lastres = $endreserve;
                   12274:                 if (!$lastres) {
                   12275:                     $lastres = $slots{$slot}->{'starttime'};
                   12276:                 }
                   12277:                 $reservable_now{$slot} = {
                   12278:                                            symb       => $symb,
1.1250    raeburn  12279:                                            endreserve => $lastres,
                   12280:                                            uniqueperiod => $uniqueperiod,
1.1040    raeburn  12281:                                          };
                   12282:             } elsif (($startreserve > $now) &&
                   12283:                      (!$endreserve || $endreserve > $startreserve)) {
                   12284:                 $future_reservable{$slot} = {
                   12285:                                               symb         => $symb,
1.1250    raeburn  12286:                                               startreserve => $startreserve,
                   12287:                                               uniqueperiod => $uniqueperiod,
1.1040    raeburn  12288:                                             };
                   12289:             }
                   12290:         }
                   12291:     }
                   12292:     my @unsorted_reservable = keys(%reservable_now);
                   12293:     if (@unsorted_reservable > 0) {
                   12294:         @sorted_reservable = 
                   12295:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   12296:     }
                   12297:     my @unsorted_future = keys(%future_reservable);
                   12298:     if (@unsorted_future > 0) {
                   12299:         @sorted_future =
                   12300:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   12301:     }
                   12302:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   12303: }
1.780     raeburn  12304: 
                   12305: =pod
                   12306: 
1.1057    foxr     12307: =back
                   12308: 
1.549     albertel 12309: =head1 HTTP Helpers
                   12310: 
                   12311: =over 4
                   12312: 
1.648     raeburn  12313: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 12314: 
1.258     albertel 12315: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 12316: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 12317: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 12318: 
                   12319: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   12320: $possible_names is an ref to an array of form element names.  As an example:
                   12321: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 12322: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 12323: 
                   12324: =cut
1.1       albertel 12325: 
1.6       albertel 12326: sub get_unprocessed_cgi {
1.25      albertel 12327:   my ($query,$possible_names)= @_;
1.26      matthew  12328:   # $Apache::lonxml::debug=1;
1.356     albertel 12329:   foreach my $pair (split(/&/,$query)) {
                   12330:     my ($name, $value) = split(/=/,$pair);
1.369     www      12331:     $name = &unescape($name);
1.25      albertel 12332:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   12333:       $value =~ tr/+/ /;
                   12334:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 12335:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 12336:     }
1.16      harris41 12337:   }
1.6       albertel 12338: }
                   12339: 
1.112     bowersj2 12340: =pod
                   12341: 
1.648     raeburn  12342: =item * &cacheheader() 
1.112     bowersj2 12343: 
                   12344: returns cache-controlling header code
                   12345: 
                   12346: =cut
                   12347: 
1.7       albertel 12348: sub cacheheader {
1.258     albertel 12349:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 12350:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   12351:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 12352:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   12353:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 12354:     return $output;
1.7       albertel 12355: }
                   12356: 
1.112     bowersj2 12357: =pod
                   12358: 
1.648     raeburn  12359: =item * &no_cache($r) 
1.112     bowersj2 12360: 
                   12361: specifies header code to not have cache
                   12362: 
                   12363: =cut
                   12364: 
1.9       albertel 12365: sub no_cache {
1.216     albertel 12366:     my ($r) = @_;
                   12367:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 12368: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 12369:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   12370:     $r->no_cache(1);
                   12371:     $r->header_out("Expires" => $date);
                   12372:     $r->header_out("Pragma" => "no-cache");
1.123     www      12373: }
                   12374: 
                   12375: sub content_type {
1.181     albertel 12376:     my ($r,$type,$charset) = @_;
1.299     foxr     12377:     if ($r) {
                   12378: 	#  Note that printout.pl calls this with undef for $r.
                   12379: 	&no_cache($r);
                   12380:     }
1.258     albertel 12381:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 12382:     unless ($charset) {
                   12383: 	$charset=&Apache::lonlocal::current_encoding;
                   12384:     }
                   12385:     if ($charset) { $type.='; charset='.$charset; }
                   12386:     if ($r) {
                   12387: 	$r->content_type($type);
                   12388:     } else {
                   12389: 	print("Content-type: $type\n\n");
                   12390:     }
1.9       albertel 12391: }
1.25      albertel 12392: 
1.112     bowersj2 12393: =pod
                   12394: 
1.648     raeburn  12395: =item * &add_to_env($name,$value) 
1.112     bowersj2 12396: 
1.258     albertel 12397: adds $name to the %env hash with value
1.112     bowersj2 12398: $value, if $name already exists, the entry is converted to an array
                   12399: reference and $value is added to the array.
                   12400: 
                   12401: =cut
                   12402: 
1.25      albertel 12403: sub add_to_env {
                   12404:   my ($name,$value)=@_;
1.258     albertel 12405:   if (defined($env{$name})) {
                   12406:     if (ref($env{$name})) {
1.25      albertel 12407:       #already have multiple values
1.258     albertel 12408:       push(@{ $env{$name} },$value);
1.25      albertel 12409:     } else {
                   12410:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 12411:       my $first=$env{$name};
                   12412:       undef($env{$name});
                   12413:       push(@{ $env{$name} },$first,$value);
1.25      albertel 12414:     }
                   12415:   } else {
1.258     albertel 12416:     $env{$name}=$value;
1.25      albertel 12417:   }
1.31      albertel 12418: }
1.149     albertel 12419: 
                   12420: =pod
                   12421: 
1.648     raeburn  12422: =item * &get_env_multiple($name) 
1.149     albertel 12423: 
1.258     albertel 12424: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 12425: values may be defined and end up as an array ref.
                   12426: 
                   12427: returns an array of values
                   12428: 
                   12429: =cut
                   12430: 
                   12431: sub get_env_multiple {
                   12432:     my ($name) = @_;
                   12433:     my @values;
1.258     albertel 12434:     if (defined($env{$name})) {
1.149     albertel 12435:         # exists is it an array
1.258     albertel 12436:         if (ref($env{$name})) {
                   12437:             @values=@{ $env{$name} };
1.149     albertel 12438:         } else {
1.258     albertel 12439:             $values[0]=$env{$name};
1.149     albertel 12440:         }
                   12441:     }
                   12442:     return(@values);
                   12443: }
                   12444: 
1.1249    damieng  12445: # Looks at given dependencies, and returns something depending on the context.
                   12446: # For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
                   12447: # For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
                   12448: # For all other contexts, returns ($output, $counter, $numpathchg).
                   12449: # $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
                   12450: # $counter: integer with the number of existing dependencies when no HTML output is returned, and the number of missing dependencies when an HTML output is returned.
                   12451: # $numpathchg: integer with the number of cleaned up dependency paths.
                   12452: # \%existing: hash reference clean path -> 1 only for existing dependencies.
                   12453: # \%mapping: hash reference clean path -> original path for all dependencies.
                   12454: # @param {string} actionurl - The path to the handler, indicative of the context.
                   12455: # @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
                   12456: # @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
                   12457: # @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
                   12458: # @param {hash reference} args - More parameters ! Possible keys: error_on_invalid_names (boolean), ignore_remote_references (boolean), current_path (string), docs_url (string), docs_title (string), context (string)
                   12459: # @return {Array} - array depending on the context (not a reference)
1.660     raeburn  12460: sub ask_for_embedded_content {
1.1249    damieng  12461:     # NOTE: documentation was added afterwards, it could be wrong
1.660     raeburn  12462:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  12463:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085    raeburn  12464:         %currsubfile,%unused,$rem);
1.1071    raeburn  12465:     my $counter = 0;
                   12466:     my $numnew = 0;
1.987     raeburn  12467:     my $numremref = 0;
                   12468:     my $numinvalid = 0;
                   12469:     my $numpathchg = 0;
                   12470:     my $numexisting = 0;
1.1071    raeburn  12471:     my $numunused = 0;
                   12472:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156    raeburn  12473:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  12474:     my $heading = &mt('Upload embedded files');
                   12475:     my $buttontext = &mt('Upload');
                   12476: 
1.1249    damieng  12477:     # fills these variables based on the context:
                   12478:     # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
                   12479:     # $path, $fileloc, $title, $rem, $filename
1.1085    raeburn  12480:     if ($env{'request.course.id'}) {
1.1123    raeburn  12481:         if ($actionurl eq '/adm/dependencies') {
                   12482:             $navmap = Apache::lonnavmaps::navmap->new();
                   12483:         }
                   12484:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   12485:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085    raeburn  12486:     }
1.1123    raeburn  12487:     if (($actionurl eq '/adm/portfolio') || 
                   12488:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  12489:         my $current_path='/';
                   12490:         if ($env{'form.currentpath'}) {
                   12491:             $current_path = $env{'form.currentpath'};
                   12492:         }
                   12493:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123    raeburn  12494:             $udom = $cdom;
                   12495:             $uname = $cnum;
1.984     raeburn  12496:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   12497:         } else {
                   12498:             $udom = $env{'user.domain'};
                   12499:             $uname = $env{'user.name'};
                   12500:             $url = '/userfiles/portfolio';
                   12501:         }
1.987     raeburn  12502:         $toplevel = $url.'/';
1.984     raeburn  12503:         $url .= $current_path;
                   12504:         $getpropath = 1;
1.987     raeburn  12505:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   12506:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      12507:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  12508:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  12509:         $toplevel = $url;
1.984     raeburn  12510:         if ($rest ne '') {
1.987     raeburn  12511:             $url .= $rest;
                   12512:         }
                   12513:     } elsif ($actionurl eq '/adm/coursedocs') {
                   12514:         if (ref($args) eq 'HASH') {
1.1071    raeburn  12515:             $url = $args->{'docs_url'};
                   12516:             $toplevel = $url;
1.1084    raeburn  12517:             if ($args->{'context'} eq 'paste') {
                   12518:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   12519:                 ($path) = 
                   12520:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   12521:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   12522:                 $fileloc =~ s{^/}{};
                   12523:             }
1.1071    raeburn  12524:         }
1.1084    raeburn  12525:     } elsif ($actionurl eq '/adm/dependencies')  {
1.1071    raeburn  12526:         if ($env{'request.course.id'} ne '') {
                   12527:             if (ref($args) eq 'HASH') {
                   12528:                 $url = $args->{'docs_url'};
                   12529:                 $title = $args->{'docs_title'};
1.1126    raeburn  12530:                 $toplevel = $url; 
                   12531:                 unless ($toplevel =~ m{^/}) {
                   12532:                     $toplevel = "/$url";
                   12533:                 }
1.1085    raeburn  12534:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126    raeburn  12535:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   12536:                     $path = $1;
                   12537:                 } else {
                   12538:                     ($path) =
                   12539:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   12540:                 }
1.1195    raeburn  12541:                 if ($toplevel=~/^\/*(uploaded|editupload)/) {
                   12542:                     $fileloc = $toplevel;
                   12543:                     $fileloc=~ s/^\s*(\S+)\s*$/$1/;
                   12544:                     my ($udom,$uname,$fname) =
                   12545:                         ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
                   12546:                     $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
                   12547:                 } else {
                   12548:                     $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   12549:                 }
1.1071    raeburn  12550:                 $fileloc =~ s{^/}{};
                   12551:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   12552:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   12553:             }
1.987     raeburn  12554:         }
1.1123    raeburn  12555:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   12556:         $udom = $cdom;
                   12557:         $uname = $cnum;
                   12558:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   12559:         $toplevel = $url;
                   12560:         $path = $url;
                   12561:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   12562:         $fileloc =~ s{^/}{};
1.987     raeburn  12563:     }
1.1249    damieng  12564:     
                   12565:     # parses the dependency paths to get some info
                   12566:     # fills $newfiles, $mapping, $subdependencies, $dependencies
                   12567:     # $newfiles: hash URL -> 1 for new files or external URLs
                   12568:     # (will be completed later)
                   12569:     # $mapping:
                   12570:     #   for external URLs: external URL -> external URL
                   12571:     #   for relative paths: clean path -> original path
                   12572:     # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
                   12573:     # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
1.1126    raeburn  12574:     foreach my $file (keys(%{$allfiles})) {
                   12575:         my $embed_file;
                   12576:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   12577:             $embed_file = $1;
                   12578:         } else {
                   12579:             $embed_file = $file;
                   12580:         }
1.1158    raeburn  12581:         my ($absolutepath,$cleaned_file);
                   12582:         if ($embed_file =~ m{^\w+://}) {
                   12583:             $cleaned_file = $embed_file;
1.1147    raeburn  12584:             $newfiles{$cleaned_file} = 1;
                   12585:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  12586:         } else {
1.1158    raeburn  12587:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  12588:             if ($embed_file =~ m{^/}) {
                   12589:                 $absolutepath = $embed_file;
                   12590:             }
1.1147    raeburn  12591:             if ($cleaned_file =~ m{/}) {
                   12592:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  12593:                 $path = &check_for_traversal($path,$url,$toplevel);
                   12594:                 my $item = $fname;
                   12595:                 if ($path ne '') {
                   12596:                     $item = $path.'/'.$fname;
                   12597:                     $subdependencies{$path}{$fname} = 1;
                   12598:                 } else {
                   12599:                     $dependencies{$item} = 1;
                   12600:                 }
                   12601:                 if ($absolutepath) {
                   12602:                     $mapping{$item} = $absolutepath;
                   12603:                 } else {
                   12604:                     $mapping{$item} = $embed_file;
                   12605:                 }
                   12606:             } else {
                   12607:                 $dependencies{$embed_file} = 1;
                   12608:                 if ($absolutepath) {
1.1147    raeburn  12609:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  12610:                 } else {
1.1147    raeburn  12611:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  12612:                 }
                   12613:             }
1.984     raeburn  12614:         }
                   12615:     }
1.1249    damieng  12616:     
                   12617:     # looks for all existing files in dependency subdirectories (from $subdependencies filled above)
                   12618:     # and lists
                   12619:     # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
                   12620:     # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
                   12621:     # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
                   12622:     #                                    the path had to be cleaned up
                   12623:     # $existing: hash clean path -> 1 if the file exists
                   12624:     # $numexisting: number of keys in $existing
                   12625:     # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
                   12626:     # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
                   12627:     #                                      dependency subdirectories that are
                   12628:     #                                      not listed as dependencies, with some exceptions using $rem
1.1071    raeburn  12629:     my $dirptr = 16384;
1.984     raeburn  12630:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  12631:         $currsubfile{$path} = {};
1.1123    raeburn  12632:         if (($actionurl eq '/adm/portfolio') || 
                   12633:             ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  12634:             my ($sublistref,$listerror) =
                   12635:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   12636:             if (ref($sublistref) eq 'ARRAY') {
                   12637:                 foreach my $line (@{$sublistref}) {
                   12638:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  12639:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  12640:                 }
1.984     raeburn  12641:             }
1.987     raeburn  12642:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  12643:             if (opendir(my $dir,$url.'/'.$path)) {
                   12644:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  12645:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   12646:             }
1.1084    raeburn  12647:         } elsif (($actionurl eq '/adm/dependencies') ||
                   12648:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  12649:                   ($args->{'context'} eq 'paste')) ||
                   12650:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  12651:             if ($env{'request.course.id'} ne '') {
1.1123    raeburn  12652:                 my $dir;
                   12653:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   12654:                     $dir = $fileloc;
                   12655:                 } else {
                   12656:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   12657:                 }
1.1071    raeburn  12658:                 if ($dir ne '') {
                   12659:                     my ($sublistref,$listerror) =
                   12660:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   12661:                     if (ref($sublistref) eq 'ARRAY') {
                   12662:                         foreach my $line (@{$sublistref}) {
                   12663:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   12664:                                 undef,$mtime)=split(/\&/,$line,12);
                   12665:                             unless (($testdir&$dirptr) ||
                   12666:                                     ($file_name =~ /^\.\.?$/)) {
                   12667:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   12668:                             }
                   12669:                         }
                   12670:                     }
                   12671:                 }
1.984     raeburn  12672:             }
                   12673:         }
                   12674:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  12675:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  12676:                 my $item = $path.'/'.$file;
                   12677:                 unless ($mapping{$item} eq $item) {
                   12678:                     $pathchanges{$item} = 1;
                   12679:                 }
                   12680:                 $existing{$item} = 1;
                   12681:                 $numexisting ++;
                   12682:             } else {
                   12683:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  12684:             }
                   12685:         }
1.1071    raeburn  12686:         if ($actionurl eq '/adm/dependencies') {
                   12687:             foreach my $path (keys(%currsubfile)) {
                   12688:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   12689:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   12690:                          unless ($subdependencies{$path}{$file}) {
1.1085    raeburn  12691:                              next if (($rem ne '') &&
                   12692:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   12693:                                        (ref($navmap) &&
                   12694:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   12695:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   12696:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  12697:                              $unused{$path.'/'.$file} = 1; 
                   12698:                          }
                   12699:                     }
                   12700:                 }
                   12701:             }
                   12702:         }
1.984     raeburn  12703:     }
1.1249    damieng  12704:     
                   12705:     # fills $currfile, hash file name -> 1 or [$size,$mtime]
                   12706:     # for files in $url or $fileloc (target directory) in some contexts
1.987     raeburn  12707:     my %currfile;
1.1123    raeburn  12708:     if (($actionurl eq '/adm/portfolio') ||
                   12709:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  12710:         my ($dirlistref,$listerror) =
                   12711:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   12712:         if (ref($dirlistref) eq 'ARRAY') {
                   12713:             foreach my $line (@{$dirlistref}) {
                   12714:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   12715:                 $currfile{$file_name} = 1;
                   12716:             }
1.984     raeburn  12717:         }
1.987     raeburn  12718:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  12719:         if (opendir(my $dir,$url)) {
1.987     raeburn  12720:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  12721:             map {$currfile{$_} = 1;} @dir_list;
                   12722:         }
1.1084    raeburn  12723:     } elsif (($actionurl eq '/adm/dependencies') ||
                   12724:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  12725:               ($args->{'context'} eq 'paste')) ||
                   12726:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  12727:         if ($env{'request.course.id'} ne '') {
                   12728:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   12729:             if ($dir ne '') {
                   12730:                 my ($dirlistref,$listerror) =
                   12731:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   12732:                 if (ref($dirlistref) eq 'ARRAY') {
                   12733:                     foreach my $line (@{$dirlistref}) {
                   12734:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   12735:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   12736:                         unless (($testdir&$dirptr) ||
                   12737:                                 ($file_name =~ /^\.\.?$/)) {
                   12738:                             $currfile{$file_name} = [$size,$mtime];
                   12739:                         }
                   12740:                     }
                   12741:                 }
                   12742:             }
                   12743:         }
1.984     raeburn  12744:     }
1.1249    damieng  12745:     # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
                   12746:     # are not in subdirectories, using $currfile
1.984     raeburn  12747:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  12748:         if (exists($currfile{$file})) {
1.987     raeburn  12749:             unless ($mapping{$file} eq $file) {
                   12750:                 $pathchanges{$file} = 1;
                   12751:             }
                   12752:             $existing{$file} = 1;
                   12753:             $numexisting ++;
                   12754:         } else {
1.984     raeburn  12755:             $newfiles{$file} = 1;
                   12756:         }
                   12757:     }
1.1071    raeburn  12758:     foreach my $file (keys(%currfile)) {
                   12759:         unless (($file eq $filename) ||
                   12760:                 ($file eq $filename.'.bak') ||
                   12761:                 ($dependencies{$file})) {
1.1085    raeburn  12762:             if ($actionurl eq '/adm/dependencies') {
1.1126    raeburn  12763:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   12764:                     next if (($rem ne '') &&
                   12765:                              (($env{"httpref.$rem".$file} ne '') ||
                   12766:                               (ref($navmap) &&
                   12767:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   12768:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   12769:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   12770:                 }
1.1085    raeburn  12771:             }
1.1071    raeburn  12772:             $unused{$file} = 1;
                   12773:         }
                   12774:     }
1.1249    damieng  12775:     
                   12776:     # returns some results for coursedocs paste and syllabus rewrites ($output is undef)
1.1084    raeburn  12777:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   12778:         ($args->{'context'} eq 'paste')) {
                   12779:         $counter = scalar(keys(%existing));
                   12780:         $numpathchg = scalar(keys(%pathchanges));
1.1123    raeburn  12781:         return ($output,$counter,$numpathchg,\%existing);
                   12782:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && 
                   12783:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   12784:         $counter = scalar(keys(%existing));
                   12785:         $numpathchg = scalar(keys(%pathchanges));
                   12786:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084    raeburn  12787:     }
1.1249    damieng  12788:     
                   12789:     # returns HTML otherwise, with dependency results and to ask for more uploads
                   12790:     
                   12791:     # $upload_output: missing dependencies (with upload form)
                   12792:     # $modify_output: uploaded dependencies (in use)
                   12793:     # $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
1.984     raeburn  12794:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  12795:         if ($actionurl eq '/adm/dependencies') {
                   12796:             next if ($embed_file =~ m{^\w+://});
                   12797:         }
1.660     raeburn  12798:         $upload_output .= &start_data_table_row().
1.1123    raeburn  12799:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  12800:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  12801:         unless ($mapping{$embed_file} eq $embed_file) {
1.1123    raeburn  12802:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   12803:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  12804:         }
1.1123    raeburn  12805:         $upload_output .= '</td>';
1.1071    raeburn  12806:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1123    raeburn  12807:             $upload_output.='<td align="right">'.
                   12808:                             '<span class="LC_info LC_fontsize_medium">'.
                   12809:                             &mt("URL points to web address").'</span>';
1.987     raeburn  12810:             $numremref++;
1.660     raeburn  12811:         } elsif ($args->{'error_on_invalid_names'}
                   12812:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123    raeburn  12813:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   12814:                             &mt('Invalid characters').'</span>';
1.987     raeburn  12815:             $numinvalid++;
1.660     raeburn  12816:         } else {
1.1123    raeburn  12817:             $upload_output .= '<td>'.
                   12818:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  12819:                                                      $embed_file,\%mapping,
1.1071    raeburn  12820:                                                      $allfiles,$codebase,'upload');
                   12821:             $counter ++;
                   12822:             $numnew ++;
1.987     raeburn  12823:         }
                   12824:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   12825:     }
                   12826:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  12827:         if ($actionurl eq '/adm/dependencies') {
                   12828:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   12829:             $modify_output .= &start_data_table_row().
                   12830:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   12831:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   12832:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   12833:                               '<td>'.$size.'</td>'.
                   12834:                               '<td>'.$mtime.'</td>'.
                   12835:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   12836:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   12837:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   12838:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   12839:                               &embedded_file_element('upload_embedded',$counter,
                   12840:                                                      $embed_file,\%mapping,
                   12841:                                                      $allfiles,$codebase,'modify').
                   12842:                               '</div></td>'.
                   12843:                               &end_data_table_row()."\n";
                   12844:             $counter ++;
                   12845:         } else {
                   12846:             $upload_output .= &start_data_table_row().
1.1123    raeburn  12847:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   12848:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   12849:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  12850:                               &Apache::loncommon::end_data_table_row()."\n";
                   12851:         }
                   12852:     }
                   12853:     my $delidx = $counter;
                   12854:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   12855:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   12856:         $delete_output .= &start_data_table_row().
                   12857:                           '<td><img src="'.&icon($oldfile).'" />'.
                   12858:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   12859:                           '<td>'.$size.'</td>'.
                   12860:                           '<td>'.$mtime.'</td>'.
                   12861:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   12862:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   12863:                           &embedded_file_element('upload_embedded',$delidx,
                   12864:                                                  $oldfile,\%mapping,$allfiles,
                   12865:                                                  $codebase,'delete').'</td>'.
                   12866:                           &end_data_table_row()."\n"; 
                   12867:         $numunused ++;
                   12868:         $delidx ++;
1.987     raeburn  12869:     }
                   12870:     if ($upload_output) {
                   12871:         $upload_output = &start_data_table().
                   12872:                          $upload_output.
                   12873:                          &end_data_table()."\n";
                   12874:     }
1.1071    raeburn  12875:     if ($modify_output) {
                   12876:         $modify_output = &start_data_table().
                   12877:                          &start_data_table_header_row().
                   12878:                          '<th>'.&mt('File').'</th>'.
                   12879:                          '<th>'.&mt('Size (KB)').'</th>'.
                   12880:                          '<th>'.&mt('Modified').'</th>'.
                   12881:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   12882:                          &end_data_table_header_row().
                   12883:                          $modify_output.
                   12884:                          &end_data_table()."\n";
                   12885:     }
                   12886:     if ($delete_output) {
                   12887:         $delete_output = &start_data_table().
                   12888:                          &start_data_table_header_row().
                   12889:                          '<th>'.&mt('File').'</th>'.
                   12890:                          '<th>'.&mt('Size (KB)').'</th>'.
                   12891:                          '<th>'.&mt('Modified').'</th>'.
                   12892:                          '<th>'.&mt('Delete?').'</th>'.
                   12893:                          &end_data_table_header_row().
                   12894:                          $delete_output.
                   12895:                          &end_data_table()."\n";
                   12896:     }
1.987     raeburn  12897:     my $applies = 0;
                   12898:     if ($numremref) {
                   12899:         $applies ++;
                   12900:     }
                   12901:     if ($numinvalid) {
                   12902:         $applies ++;
                   12903:     }
                   12904:     if ($numexisting) {
                   12905:         $applies ++;
                   12906:     }
1.1071    raeburn  12907:     if ($counter || $numunused) {
1.987     raeburn  12908:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   12909:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  12910:                   $state.'<h3>'.$heading.'</h3>'; 
                   12911:         if ($actionurl eq '/adm/dependencies') {
                   12912:             if ($numnew) {
                   12913:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   12914:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   12915:                            $upload_output.'<br />'."\n";
                   12916:             }
                   12917:             if ($numexisting) {
                   12918:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   12919:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   12920:                            $modify_output.'<br />'."\n";
                   12921:                            $buttontext = &mt('Save changes');
                   12922:             }
                   12923:             if ($numunused) {
                   12924:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   12925:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   12926:                            $delete_output.'<br />'."\n";
                   12927:                            $buttontext = &mt('Save changes');
                   12928:             }
                   12929:         } else {
                   12930:             $output .= $upload_output.'<br />'."\n";
                   12931:         }
                   12932:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   12933:                    $counter.'" />'."\n";
                   12934:         if ($actionurl eq '/adm/dependencies') { 
                   12935:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   12936:                        $numnew.'" />'."\n";
                   12937:         } elsif ($actionurl eq '') {
1.987     raeburn  12938:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   12939:         }
                   12940:     } elsif ($applies) {
                   12941:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   12942:         if ($applies > 1) {
                   12943:             $output .=  
1.1123    raeburn  12944:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  12945:             if ($numremref) {
                   12946:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   12947:             }
                   12948:             if ($numinvalid) {
                   12949:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   12950:             }
                   12951:             if ($numexisting) {
                   12952:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   12953:             }
                   12954:             $output .= '</ul><br />';
                   12955:         } elsif ($numremref) {
                   12956:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   12957:         } elsif ($numinvalid) {
                   12958:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   12959:         } elsif ($numexisting) {
                   12960:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   12961:         }
                   12962:         $output .= $upload_output.'<br />';
                   12963:     }
                   12964:     my ($pathchange_output,$chgcount);
1.1071    raeburn  12965:     $chgcount = $counter;
1.987     raeburn  12966:     if (keys(%pathchanges) > 0) {
                   12967:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  12968:             if ($counter) {
1.987     raeburn  12969:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   12970:                                                   $embed_file,\%mapping,
1.1071    raeburn  12971:                                                   $allfiles,$codebase,'change');
1.987     raeburn  12972:             } else {
                   12973:                 $pathchange_output .= 
                   12974:                     &start_data_table_row().
                   12975:                     '<td><input type ="checkbox" name="namechange" value="'.
                   12976:                     $chgcount.'" checked="checked" /></td>'.
                   12977:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   12978:                     '<td>'.$embed_file.
                   12979:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  12980:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  12981:                     '</td>'.&end_data_table_row();
1.660     raeburn  12982:             }
1.987     raeburn  12983:             $numpathchg ++;
                   12984:             $chgcount ++;
1.660     raeburn  12985:         }
                   12986:     }
1.1127    raeburn  12987:     if (($counter) || ($numunused)) {
1.987     raeburn  12988:         if ($numpathchg) {
                   12989:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   12990:                        $numpathchg.'" />'."\n";
                   12991:         }
                   12992:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   12993:             ($actionurl eq '/adm/imsimport')) {
                   12994:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   12995:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   12996:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  12997:         } elsif ($actionurl eq '/adm/dependencies') {
                   12998:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  12999:         }
1.1123    raeburn  13000:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  13001:     } elsif ($numpathchg) {
                   13002:         my %pathchange = ();
                   13003:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   13004:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   13005:             $output .= '<p>'.&mt('or').'</p>'; 
1.1123    raeburn  13006:         }
1.987     raeburn  13007:     }
1.1071    raeburn  13008:     return ($output,$counter,$numpathchg);
1.987     raeburn  13009: }
                   13010: 
1.1147    raeburn  13011: =pod
                   13012: 
                   13013: =item * clean_path($name)
                   13014: 
                   13015: Performs clean-up of directories, subdirectories and filename in an
                   13016: embedded object, referenced in an HTML file which is being uploaded
                   13017: to a course or portfolio, where 
                   13018: "Upload embedded images/multimedia files if HTML file" checkbox was
                   13019: checked.
                   13020: 
                   13021: Clean-up is similar to replacements in lonnet::clean_filename()
                   13022: except each / between sub-directory and next level is preserved.
                   13023: 
                   13024: =cut
                   13025: 
                   13026: sub clean_path {
                   13027:     my ($embed_file) = @_;
                   13028:     $embed_file =~s{^/+}{};
                   13029:     my @contents;
                   13030:     if ($embed_file =~ m{/}) {
                   13031:         @contents = split(/\//,$embed_file);
                   13032:     } else {
                   13033:         @contents = ($embed_file);
                   13034:     }
                   13035:     my $lastidx = scalar(@contents)-1;
                   13036:     for (my $i=0; $i<=$lastidx; $i++) { 
                   13037:         $contents[$i]=~s{\\}{/}g;
                   13038:         $contents[$i]=~s/\s+/\_/g;
                   13039:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   13040:         if ($i == $lastidx) {
                   13041:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   13042:         }
                   13043:     }
                   13044:     if ($lastidx > 0) {
                   13045:         return join('/',@contents);
                   13046:     } else {
                   13047:         return $contents[0];
                   13048:     }
                   13049: }
                   13050: 
1.987     raeburn  13051: sub embedded_file_element {
1.1071    raeburn  13052:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  13053:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   13054:                    (ref($codebase) eq 'HASH'));
                   13055:     my $output;
1.1071    raeburn  13056:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  13057:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   13058:     }
                   13059:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   13060:                &escape($embed_file).'" />';
                   13061:     unless (($context eq 'upload_embedded') && 
                   13062:             ($mapping->{$embed_file} eq $embed_file)) {
                   13063:         $output .='
                   13064:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   13065:     }
                   13066:     my $attrib;
                   13067:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   13068:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   13069:     }
                   13070:     $output .=
                   13071:         "\n\t\t".
                   13072:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   13073:         $attrib.'" />';
                   13074:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   13075:         $output .=
                   13076:             "\n\t\t".
                   13077:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   13078:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  13079:     }
1.987     raeburn  13080:     return $output;
1.660     raeburn  13081: }
                   13082: 
1.1071    raeburn  13083: sub get_dependency_details {
                   13084:     my ($currfile,$currsubfile,$embed_file) = @_;
                   13085:     my ($size,$mtime,$showsize,$showmtime);
                   13086:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   13087:         if ($embed_file =~ m{/}) {
                   13088:             my ($path,$fname) = split(/\//,$embed_file);
                   13089:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   13090:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   13091:             }
                   13092:         } else {
                   13093:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   13094:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   13095:             }
                   13096:         }
                   13097:         $showsize = $size/1024.0;
                   13098:         $showsize = sprintf("%.1f",$showsize);
                   13099:         if ($mtime > 0) {
                   13100:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   13101:         }
                   13102:     }
                   13103:     return ($showsize,$showmtime);
                   13104: }
                   13105: 
                   13106: sub ask_embedded_js {
                   13107:     return <<"END";
                   13108: <script type="text/javascript"">
                   13109: // <![CDATA[
                   13110: function toggleBrowse(counter) {
                   13111:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   13112:     var fileid = document.getElementById('embedded_item_'+counter);
                   13113:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   13114:     if (chkboxid.checked == true) {
                   13115:         uploaddivid.style.display='block';
                   13116:     } else {
                   13117:         uploaddivid.style.display='none';
                   13118:         fileid.value = '';
                   13119:     }
                   13120: }
                   13121: // ]]>
                   13122: </script>
                   13123: 
                   13124: END
                   13125: }
                   13126: 
1.661     raeburn  13127: sub upload_embedded {
                   13128:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  13129:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   13130:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  13131:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   13132:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   13133:         my $orig_uploaded_filename =
                   13134:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  13135:         foreach my $type ('orig','ref','attrib','codebase') {
                   13136:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   13137:                 $env{'form.embedded_'.$type.'_'.$i} =
                   13138:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   13139:             }
                   13140:         }
1.661     raeburn  13141:         my ($path,$fname) =
                   13142:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   13143:         # no path, whole string is fname
                   13144:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   13145:         $fname = &Apache::lonnet::clean_filename($fname);
                   13146:         # See if there is anything left
                   13147:         next if ($fname eq '');
                   13148: 
                   13149:         # Check if file already exists as a file or directory.
                   13150:         my ($state,$msg);
                   13151:         if ($context eq 'portfolio') {
                   13152:             my $port_path = $dirpath;
                   13153:             if ($group ne '') {
                   13154:                 $port_path = "groups/$group/$port_path";
                   13155:             }
1.987     raeburn  13156:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   13157:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  13158:                                               $dir_root,$port_path,$disk_quota,
                   13159:                                               $current_disk_usage,$uname,$udom);
                   13160:             if ($state eq 'will_exceed_quota'
1.984     raeburn  13161:                 || $state eq 'file_locked') {
1.661     raeburn  13162:                 $output .= $msg;
                   13163:                 next;
                   13164:             }
                   13165:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   13166:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   13167:             if ($state eq 'exists') {
                   13168:                 $output .= $msg;
                   13169:                 next;
                   13170:             }
                   13171:         }
                   13172:         # Check if extension is valid
                   13173:         if (($fname =~ /\.(\w+)$/) &&
                   13174:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155    bisitz   13175:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   13176:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  13177:             next;
                   13178:         } elsif (($fname =~ /\.(\w+)$/) &&
                   13179:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  13180:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  13181:             next;
                   13182:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120    bisitz   13183:             $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  13184:             next;
                   13185:         }
                   13186:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123    raeburn  13187:         my $subdir = $path;
                   13188:         $subdir =~ s{/+$}{};
1.661     raeburn  13189:         if ($context eq 'portfolio') {
1.984     raeburn  13190:             my $result;
                   13191:             if ($state eq 'existingfile') {
                   13192:                 $result=
                   13193:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123    raeburn  13194:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  13195:             } else {
1.984     raeburn  13196:                 $result=
                   13197:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  13198:                                                     $dirpath.
1.1123    raeburn  13199:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  13200:                 if ($result !~ m|^/uploaded/|) {
                   13201:                     $output .= '<span class="LC_error">'
                   13202:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   13203:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   13204:                                .'</span><br />';
                   13205:                     next;
                   13206:                 } else {
1.987     raeburn  13207:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   13208:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  13209:                 }
1.661     raeburn  13210:             }
1.1123    raeburn  13211:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126    raeburn  13212:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   13213:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  13214:             my $result =
1.1126    raeburn  13215:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  13216:             if ($result !~ m|^/uploaded/|) {
                   13217:                 $output .= '<span class="LC_error">'
                   13218:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   13219:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   13220:                            .'</span><br />';
                   13221:                     next;
                   13222:             } else {
                   13223:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   13224:                            $path.$fname.'</span>').'<br />';
1.1125    raeburn  13225:                 if ($context eq 'syllabus') {
                   13226:                     &Apache::lonnet::make_public_indefinitely($result);
                   13227:                 }
1.987     raeburn  13228:             }
1.661     raeburn  13229:         } else {
                   13230: # Save the file
                   13231:             my $target = $env{'form.embedded_item_'.$i};
                   13232:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   13233:             my $dest = $fullpath.$fname;
                   13234:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  13235:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  13236:             my $count;
                   13237:             my $filepath = $dir_root;
1.1027    raeburn  13238:             foreach my $subdir (@parts) {
                   13239:                 $filepath .= "/$subdir";
                   13240:                 if (!-e $filepath) {
1.661     raeburn  13241:                     mkdir($filepath,0770);
                   13242:                 }
                   13243:             }
                   13244:             my $fh;
                   13245:             if (!open($fh,'>'.$dest)) {
                   13246:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   13247:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  13248:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   13249:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  13250:                            '</span><br />';
                   13251:             } else {
                   13252:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   13253:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   13254:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  13255:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   13256:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  13257:                               '</span><br />';
                   13258:                 } else {
1.987     raeburn  13259:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   13260:                                $url.'</span>').'<br />';
                   13261:                     unless ($context eq 'testbank') {
                   13262:                         $footer .= &mt('View embedded file: [_1]',
                   13263:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   13264:                     }
                   13265:                 }
                   13266:                 close($fh);
                   13267:             }
                   13268:         }
                   13269:         if ($env{'form.embedded_ref_'.$i}) {
                   13270:             $pathchange{$i} = 1;
                   13271:         }
                   13272:     }
                   13273:     if ($output) {
                   13274:         $output = '<p>'.$output.'</p>';
                   13275:     }
                   13276:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   13277:     $returnflag = 'ok';
1.1071    raeburn  13278:     my $numpathchgs = scalar(keys(%pathchange));
                   13279:     if ($numpathchgs > 0) {
1.987     raeburn  13280:         if ($context eq 'portfolio') {
                   13281:             $output .= '<p>'.&mt('or').'</p>';
                   13282:         } elsif ($context eq 'testbank') {
1.1071    raeburn  13283:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   13284:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  13285:             $returnflag = 'modify_orightml';
                   13286:         }
                   13287:     }
1.1071    raeburn  13288:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  13289: }
                   13290: 
                   13291: sub modify_html_form {
                   13292:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   13293:     my $end = 0;
                   13294:     my $modifyform;
                   13295:     if ($context eq 'upload_embedded') {
                   13296:         return unless (ref($pathchange) eq 'HASH');
                   13297:         if ($env{'form.number_embedded_items'}) {
                   13298:             $end += $env{'form.number_embedded_items'};
                   13299:         }
                   13300:         if ($env{'form.number_pathchange_items'}) {
                   13301:             $end += $env{'form.number_pathchange_items'};
                   13302:         }
                   13303:         if ($end) {
                   13304:             for (my $i=0; $i<$end; $i++) {
                   13305:                 if ($i < $env{'form.number_embedded_items'}) {
                   13306:                     next unless($pathchange->{$i});
                   13307:                 }
                   13308:                 $modifyform .=
                   13309:                     &start_data_table_row().
                   13310:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   13311:                     'checked="checked" /></td>'.
                   13312:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   13313:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   13314:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   13315:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   13316:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   13317:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   13318:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   13319:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   13320:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   13321:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   13322:                     &end_data_table_row();
1.1071    raeburn  13323:             }
1.987     raeburn  13324:         }
                   13325:     } else {
                   13326:         $modifyform = $pathchgtable;
                   13327:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   13328:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   13329:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   13330:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   13331:         }
                   13332:     }
                   13333:     if ($modifyform) {
1.1071    raeburn  13334:         if ($actionurl eq '/adm/dependencies') {
                   13335:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   13336:         }
1.987     raeburn  13337:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   13338:                '<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".
                   13339:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   13340:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   13341:                '</ol></p>'."\n".'<p>'.
                   13342:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   13343:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   13344:                &start_data_table()."\n".
                   13345:                &start_data_table_header_row().
                   13346:                '<th>'.&mt('Change?').'</th>'.
                   13347:                '<th>'.&mt('Current reference').'</th>'.
                   13348:                '<th>'.&mt('Required reference').'</th>'.
                   13349:                &end_data_table_header_row()."\n".
                   13350:                $modifyform.
                   13351:                &end_data_table().'<br />'."\n".$hiddenstate.
                   13352:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   13353:                '</form>'."\n";
                   13354:     }
                   13355:     return;
                   13356: }
                   13357: 
                   13358: sub modify_html_refs {
1.1123    raeburn  13359:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  13360:     my $container;
                   13361:     if ($context eq 'portfolio') {
                   13362:         $container = $env{'form.container'};
                   13363:     } elsif ($context eq 'coursedoc') {
                   13364:         $container = $env{'form.primaryurl'};
1.1071    raeburn  13365:     } elsif ($context eq 'manage_dependencies') {
                   13366:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   13367:         $container = "/$container";
1.1123    raeburn  13368:     } elsif ($context eq 'syllabus') {
                   13369:         $container = $url;
1.987     raeburn  13370:     } else {
1.1027    raeburn  13371:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  13372:     }
                   13373:     my (%allfiles,%codebase,$output,$content);
                   13374:     my @changes = &get_env_multiple('form.namechange');
1.1126    raeburn  13375:     unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071    raeburn  13376:         if (wantarray) {
                   13377:             return ('',0,0); 
                   13378:         } else {
                   13379:             return;
                   13380:         }
                   13381:     }
                   13382:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  13383:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  13384:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   13385:             if (wantarray) {
                   13386:                 return ('',0,0);
                   13387:             } else {
                   13388:                 return;
                   13389:             }
                   13390:         } 
1.987     raeburn  13391:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  13392:         if ($content eq '-1') {
                   13393:             if (wantarray) {
                   13394:                 return ('',0,0);
                   13395:             } else {
                   13396:                 return;
                   13397:             }
                   13398:         }
1.987     raeburn  13399:     } else {
1.1071    raeburn  13400:         unless ($container =~ /^\Q$dir_root\E/) {
                   13401:             if (wantarray) {
                   13402:                 return ('',0,0);
                   13403:             } else {
                   13404:                 return;
                   13405:             }
                   13406:         } 
1.1317    raeburn  13407:         if (open(my $fh,'<',$container)) {
1.987     raeburn  13408:             $content = join('', <$fh>);
                   13409:             close($fh);
                   13410:         } else {
1.1071    raeburn  13411:             if (wantarray) {
                   13412:                 return ('',0,0);
                   13413:             } else {
                   13414:                 return;
                   13415:             }
1.987     raeburn  13416:         }
                   13417:     }
                   13418:     my ($count,$codebasecount) = (0,0);
                   13419:     my $mm = new File::MMagic;
                   13420:     my $mime_type = $mm->checktype_contents($content);
                   13421:     if ($mime_type eq 'text/html') {
                   13422:         my $parse_result = 
                   13423:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   13424:                                                     \%codebase,\$content);
                   13425:         if ($parse_result eq 'ok') {
                   13426:             foreach my $i (@changes) {
                   13427:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   13428:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   13429:                 if ($allfiles{$ref}) {
                   13430:                     my $newname =  $orig;
                   13431:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  13432:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  13433:                     if ($attrib_regexp =~ /:/) {
                   13434:                         $attrib_regexp =~ s/\:/|/g;
                   13435:                     }
                   13436:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   13437:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   13438:                         $count += $numchg;
1.1123    raeburn  13439:                         $allfiles{$newname} = $allfiles{$ref};
1.1148    raeburn  13440:                         delete($allfiles{$ref});
1.987     raeburn  13441:                     }
                   13442:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  13443:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  13444:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   13445:                         $codebasecount ++;
                   13446:                     }
                   13447:                 }
                   13448:             }
1.1123    raeburn  13449:             my $skiprewrites;
1.987     raeburn  13450:             if ($count || $codebasecount) {
                   13451:                 my $saveresult;
1.1071    raeburn  13452:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  13453:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  13454:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   13455:                     if ($url eq $container) {
                   13456:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   13457:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   13458:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  13459:                                             $fname.'</span>').'</p>';
1.987     raeburn  13460:                     } else {
                   13461:                          $output = '<p class="LC_error">'.
                   13462:                                    &mt('Error: update failed for: [_1].',
                   13463:                                    '<span class="LC_filename">'.
                   13464:                                    $container.'</span>').'</p>';
                   13465:                     }
1.1123    raeburn  13466:                     if ($context eq 'syllabus') {
                   13467:                         unless ($saveresult eq 'ok') {
                   13468:                             $skiprewrites = 1;
                   13469:                         }
                   13470:                     }
1.987     raeburn  13471:                 } else {
1.1317    raeburn  13472:                     if (open(my $fh,'>',$container)) {
1.987     raeburn  13473:                         print $fh $content;
                   13474:                         close($fh);
                   13475:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   13476:                                   $count,'<span class="LC_filename">'.
                   13477:                                   $container.'</span>').'</p>';
1.661     raeburn  13478:                     } else {
1.987     raeburn  13479:                          $output = '<p class="LC_error">'.
                   13480:                                    &mt('Error: could not update [_1].',
                   13481:                                    '<span class="LC_filename">'.
                   13482:                                    $container.'</span>').'</p>';
1.661     raeburn  13483:                     }
                   13484:                 }
                   13485:             }
1.1123    raeburn  13486:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   13487:                 my ($actionurl,$state);
                   13488:                 $actionurl = "/public/$udom/$uname/syllabus";
                   13489:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   13490:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   13491:                                               \%codebase,
                   13492:                                               {'context' => 'rewrites',
                   13493:                                                'ignore_remote_references' => 1,});
                   13494:                 if (ref($mapping) eq 'HASH') {
                   13495:                     my $rewrites = 0;
                   13496:                     foreach my $key (keys(%{$mapping})) {
                   13497:                         next if ($key =~ m{^https?://});
                   13498:                         my $ref = $mapping->{$key};
                   13499:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   13500:                         my $attrib;
                   13501:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   13502:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   13503:                         }
                   13504:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   13505:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   13506:                             $rewrites += $numchg;
                   13507:                         }
                   13508:                     }
                   13509:                     if ($rewrites) {
                   13510:                         my $saveresult; 
                   13511:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   13512:                         if ($url eq $container) {
                   13513:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   13514:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   13515:                                             $count,'<span class="LC_filename">'.
                   13516:                                             $fname.'</span>').'</p>';
                   13517:                         } else {
                   13518:                             $output .= '<p class="LC_error">'.
                   13519:                                        &mt('Error: could not update links in [_1].',
                   13520:                                        '<span class="LC_filename">'.
                   13521:                                        $container.'</span>').'</p>';
                   13522: 
                   13523:                         }
                   13524:                     }
                   13525:                 }
                   13526:             }
1.987     raeburn  13527:         } else {
                   13528:             &logthis('Failed to parse '.$container.
                   13529:                      ' to modify references: '.$parse_result);
1.661     raeburn  13530:         }
                   13531:     }
1.1071    raeburn  13532:     if (wantarray) {
                   13533:         return ($output,$count,$codebasecount);
                   13534:     } else {
                   13535:         return $output;
                   13536:     }
1.661     raeburn  13537: }
                   13538: 
                   13539: sub check_for_existing {
                   13540:     my ($path,$fname,$element) = @_;
                   13541:     my ($state,$msg);
                   13542:     if (-d $path.'/'.$fname) {
                   13543:         $state = 'exists';
                   13544:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   13545:     } elsif (-e $path.'/'.$fname) {
                   13546:         $state = 'exists';
                   13547:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   13548:     }
                   13549:     if ($state eq 'exists') {
                   13550:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   13551:     }
                   13552:     return ($state,$msg);
                   13553: }
                   13554: 
                   13555: sub check_for_upload {
                   13556:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   13557:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  13558:     my $filesize = length($env{'form.'.$element});
                   13559:     if (!$filesize) {
                   13560:         my $msg = '<span class="LC_error">'.
                   13561:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   13562:                       '<span class="LC_filename">'.$fname.'</span>',
                   13563:                       $filesize).'<br />'.
1.1007    raeburn  13564:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  13565:                   '</span>';
                   13566:         return ('zero_bytes',$msg);
                   13567:     }
                   13568:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  13569:     my $getpropath = 1;
1.1021    raeburn  13570:     my ($dirlistref,$listerror) =
                   13571:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  13572:     my $found_file = 0;
                   13573:     my $locked_file = 0;
1.991     raeburn  13574:     my @lockers;
                   13575:     my $navmap;
                   13576:     if ($env{'request.course.id'}) {
                   13577:         $navmap = Apache::lonnavmaps::navmap->new();
                   13578:     }
1.1021    raeburn  13579:     if (ref($dirlistref) eq 'ARRAY') {
                   13580:         foreach my $line (@{$dirlistref}) {
                   13581:             my ($file_name,$rest)=split(/\&/,$line,2);
                   13582:             if ($file_name eq $fname){
                   13583:                 $file_name = $path.$file_name;
                   13584:                 if ($group ne '') {
                   13585:                     $file_name = $group.$file_name;
                   13586:                 }
                   13587:                 $found_file = 1;
                   13588:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   13589:                     foreach my $lock (@lockers) {
                   13590:                         if (ref($lock) eq 'ARRAY') {
                   13591:                             my ($symb,$crsid) = @{$lock};
                   13592:                             if ($crsid eq $env{'request.course.id'}) {
                   13593:                                 if (ref($navmap)) {
                   13594:                                     my $res = $navmap->getBySymb($symb);
                   13595:                                     foreach my $part (@{$res->parts()}) { 
                   13596:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   13597:                                         unless (($slot_status == $res->RESERVED) ||
                   13598:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   13599:                                             $locked_file = 1;
                   13600:                                         }
1.991     raeburn  13601:                                     }
1.1021    raeburn  13602:                                 } else {
                   13603:                                     $locked_file = 1;
1.991     raeburn  13604:                                 }
                   13605:                             } else {
                   13606:                                 $locked_file = 1;
                   13607:                             }
                   13608:                         }
1.1021    raeburn  13609:                    }
                   13610:                 } else {
                   13611:                     my @info = split(/\&/,$rest);
                   13612:                     my $currsize = $info[6]/1000;
                   13613:                     if ($currsize < $filesize) {
                   13614:                         my $extra = $filesize - $currsize;
                   13615:                         if (($current_disk_usage + $extra) > $disk_quota) {
1.1179    bisitz   13616:                             my $msg = '<p class="LC_warning">'.
1.1021    raeburn  13617:                                       &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',
1.1179    bisitz   13618:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                   13619:                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   13620:                                                    $disk_quota,$current_disk_usage).'</p>';
1.1021    raeburn  13621:                             return ('will_exceed_quota',$msg);
                   13622:                         }
1.984     raeburn  13623:                     }
                   13624:                 }
1.661     raeburn  13625:             }
                   13626:         }
                   13627:     }
                   13628:     if (($current_disk_usage + $filesize) > $disk_quota){
1.1179    bisitz   13629:         my $msg = '<p class="LC_warning">'.
                   13630:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184    raeburn  13631:                   '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661     raeburn  13632:         return ('will_exceed_quota',$msg);
                   13633:     } elsif ($found_file) {
                   13634:         if ($locked_file) {
1.1179    bisitz   13635:             my $msg = '<p class="LC_warning">';
1.661     raeburn  13636:             $msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>','<span class="LC_filename">'.$port_path.$env{'form.currentpath'}.'</span>');
1.1179    bisitz   13637:             $msg .= '</p>';
1.661     raeburn  13638:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   13639:             return ('file_locked',$msg);
                   13640:         } else {
1.1179    bisitz   13641:             my $msg = '<p class="LC_error">';
1.984     raeburn  13642:             $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.1179    bisitz   13643:             $msg .= '</p>';
1.984     raeburn  13644:             return ('existingfile',$msg);
1.661     raeburn  13645:         }
                   13646:     }
                   13647: }
                   13648: 
1.987     raeburn  13649: sub check_for_traversal {
                   13650:     my ($path,$url,$toplevel) = @_;
                   13651:     my @parts=split(/\//,$path);
                   13652:     my $cleanpath;
                   13653:     my $fullpath = $url;
                   13654:     for (my $i=0;$i<@parts;$i++) {
                   13655:         next if ($parts[$i] eq '.');
                   13656:         if ($parts[$i] eq '..') {
                   13657:             $fullpath =~ s{([^/]+/)$}{};
                   13658:         } else {
                   13659:             $fullpath .= $parts[$i].'/';
                   13660:         }
                   13661:     }
                   13662:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   13663:         $cleanpath = $1;
                   13664:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   13665:         my $curr_toprel = $1;
                   13666:         my @parts = split(/\//,$curr_toprel);
                   13667:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   13668:         my @urlparts = split(/\//,$url_toprel);
                   13669:         my $doubledots;
                   13670:         my $startdiff = -1;
                   13671:         for (my $i=0; $i<@urlparts; $i++) {
                   13672:             if ($startdiff == -1) {
                   13673:                 unless ($urlparts[$i] eq $parts[$i]) {
                   13674:                     $startdiff = $i;
                   13675:                     $doubledots .= '../';
                   13676:                 }
                   13677:             } else {
                   13678:                 $doubledots .= '../';
                   13679:             }
                   13680:         }
                   13681:         if ($startdiff > -1) {
                   13682:             $cleanpath = $doubledots;
                   13683:             for (my $i=$startdiff; $i<@parts; $i++) {
                   13684:                 $cleanpath .= $parts[$i].'/';
                   13685:             }
                   13686:         }
                   13687:     }
                   13688:     $cleanpath =~ s{(/)$}{};
                   13689:     return $cleanpath;
                   13690: }
1.31      albertel 13691: 
1.1053    raeburn  13692: sub is_archive_file {
                   13693:     my ($mimetype) = @_;
                   13694:     if (($mimetype eq 'application/octet-stream') ||
                   13695:         ($mimetype eq 'application/x-stuffit') ||
                   13696:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   13697:         return 1;
                   13698:     }
                   13699:     return;
                   13700: }
                   13701: 
                   13702: sub decompress_form {
1.1065    raeburn  13703:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  13704:     my %lt = &Apache::lonlocal::texthash (
                   13705:         this => 'This file is an archive file.',
1.1067    raeburn  13706:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  13707:         itsc => 'Its contents are as follows:',
1.1053    raeburn  13708:         youm => 'You may wish to extract its contents.',
                   13709:         extr => 'Extract contents',
1.1067    raeburn  13710:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   13711:         proa => 'Process automatically?',
1.1053    raeburn  13712:         yes  => 'Yes',
                   13713:         no   => 'No',
1.1067    raeburn  13714:         fold => 'Title for folder containing movie',
                   13715:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  13716:     );
1.1065    raeburn  13717:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  13718:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  13719:     my $info = &list_archive_contents($fileloc,\@paths);
                   13720:     if (@paths) {
                   13721:         foreach my $path (@paths) {
                   13722:             $path =~ s{^/}{};
1.1067    raeburn  13723:             if ($path =~ m{^([^/]+)/$}) {
                   13724:                 $topdir = $1;
                   13725:             }
1.1065    raeburn  13726:             if ($path =~ m{^([^/]+)/}) {
                   13727:                 $toplevel{$1} = $path;
                   13728:             } else {
                   13729:                 $toplevel{$path} = $path;
                   13730:             }
                   13731:         }
                   13732:     }
1.1067    raeburn  13733:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164    raeburn  13734:         my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067    raeburn  13735:                         "$topdir/media/",
                   13736:                         "$topdir/media/$topdir.mp4",
                   13737:                         "$topdir/media/FirstFrame.png",
                   13738:                         "$topdir/media/player.swf",
                   13739:                         "$topdir/media/swfobject.js",
                   13740:                         "$topdir/media/expressInstall.swf");
1.1197    raeburn  13741:         my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164    raeburn  13742:                          "$topdir/$topdir.mp4",
                   13743:                          "$topdir/$topdir\_config.xml",
                   13744:                          "$topdir/$topdir\_controller.swf",
                   13745:                          "$topdir/$topdir\_embed.css",
                   13746:                          "$topdir/$topdir\_First_Frame.png",
                   13747:                          "$topdir/$topdir\_player.html",
                   13748:                          "$topdir/$topdir\_Thumbnails.png",
                   13749:                          "$topdir/playerProductInstall.swf",
                   13750:                          "$topdir/scripts/",
                   13751:                          "$topdir/scripts/config_xml.js",
                   13752:                          "$topdir/scripts/handlebars.js",
                   13753:                          "$topdir/scripts/jquery-1.7.1.min.js",
                   13754:                          "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                   13755:                          "$topdir/scripts/modernizr.js",
                   13756:                          "$topdir/scripts/player-min.js",
                   13757:                          "$topdir/scripts/swfobject.js",
                   13758:                          "$topdir/skins/",
                   13759:                          "$topdir/skins/configuration_express.xml",
                   13760:                          "$topdir/skins/express_show/",
                   13761:                          "$topdir/skins/express_show/player-min.css",
                   13762:                          "$topdir/skins/express_show/spritesheet.png");
1.1197    raeburn  13763:         my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
                   13764:                          "$topdir/$topdir.mp4",
                   13765:                          "$topdir/$topdir\_config.xml",
                   13766:                          "$topdir/$topdir\_controller.swf",
                   13767:                          "$topdir/$topdir\_embed.css",
                   13768:                          "$topdir/$topdir\_First_Frame.png",
                   13769:                          "$topdir/$topdir\_player.html",
                   13770:                          "$topdir/$topdir\_Thumbnails.png",
                   13771:                          "$topdir/playerProductInstall.swf",
                   13772:                          "$topdir/scripts/",
                   13773:                          "$topdir/scripts/config_xml.js",
                   13774:                          "$topdir/scripts/techsmith-smart-player.min.js",
                   13775:                          "$topdir/skins/",
                   13776:                          "$topdir/skins/configuration_express.xml",
                   13777:                          "$topdir/skins/express_show/",
                   13778:                          "$topdir/skins/express_show/spritesheet.min.css",
                   13779:                          "$topdir/skins/express_show/spritesheet.png",
                   13780:                          "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164    raeburn  13781:         my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067    raeburn  13782:         if (@diffs == 0) {
1.1164    raeburn  13783:             $is_camtasia = 6;
                   13784:         } else {
1.1197    raeburn  13785:             @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164    raeburn  13786:             if (@diffs == 0) {
                   13787:                 $is_camtasia = 8;
1.1197    raeburn  13788:             } else {
                   13789:                 @diffs = &compare_arrays(\@paths,\@camtasia8_4);
                   13790:                 if (@diffs == 0) {
                   13791:                     $is_camtasia = 8;
                   13792:                 }
1.1164    raeburn  13793:             }
1.1067    raeburn  13794:         }
                   13795:     }
                   13796:     my $output;
                   13797:     if ($is_camtasia) {
                   13798:         $output = <<"ENDCAM";
                   13799: <script type="text/javascript" language="Javascript">
                   13800: // <![CDATA[
                   13801: 
                   13802: function camtasiaToggle() {
                   13803:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   13804:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164    raeburn  13805:             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067    raeburn  13806:                 document.getElementById('camtasia_titles').style.display='block';
                   13807:             } else {
                   13808:                 document.getElementById('camtasia_titles').style.display='none';
                   13809:             }
                   13810:         }
                   13811:     }
                   13812:     return;
                   13813: }
                   13814: 
                   13815: // ]]>
                   13816: </script>
                   13817: <p>$lt{'camt'}</p>
                   13818: ENDCAM
1.1065    raeburn  13819:     } else {
1.1067    raeburn  13820:         $output = '<p>'.$lt{'this'};
                   13821:         if ($info eq '') {
                   13822:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   13823:         } else {
                   13824:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   13825:                        '<div><pre>'.$info.'</pre></div>';
                   13826:         }
1.1065    raeburn  13827:     }
1.1067    raeburn  13828:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  13829:     my $duplicates;
                   13830:     my $num = 0;
                   13831:     if (ref($dirlist) eq 'ARRAY') {
                   13832:         foreach my $item (@{$dirlist}) {
                   13833:             if (ref($item) eq 'ARRAY') {
                   13834:                 if (exists($toplevel{$item->[0]})) {
                   13835:                     $duplicates .= 
                   13836:                         &start_data_table_row().
                   13837:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   13838:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   13839:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   13840:                         'value="1" />'.&mt('Yes').'</label>'.
                   13841:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   13842:                         '<td>'.$item->[0].'</td>';
                   13843:                     if ($item->[2]) {
                   13844:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   13845:                     } else {
                   13846:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   13847:                     }
                   13848:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   13849:                                    '<td>'.
                   13850:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   13851:                                    '</td>'.
                   13852:                                    &end_data_table_row();
                   13853:                     $num ++;
                   13854:                 }
                   13855:             }
                   13856:         }
                   13857:     }
                   13858:     my $itemcount;
                   13859:     if (@paths > 0) {
                   13860:         $itemcount = scalar(@paths);
                   13861:     } else {
                   13862:         $itemcount = 1;
                   13863:     }
1.1067    raeburn  13864:     if ($is_camtasia) {
                   13865:         $output .= $lt{'auto'}.'<br />'.
                   13866:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164    raeburn  13867:                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067    raeburn  13868:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   13869:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   13870:                    $lt{'no'}.'</label></span><br />'.
                   13871:                    '<div id="camtasia_titles" style="display:block">'.
                   13872:                    &Apache::lonhtmlcommon::start_pick_box().
                   13873:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   13874:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   13875:                    &Apache::lonhtmlcommon::row_closure().
                   13876:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   13877:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   13878:                    &Apache::lonhtmlcommon::row_closure(1).
                   13879:                    &Apache::lonhtmlcommon::end_pick_box().
                   13880:                    '</div>';
                   13881:     }
1.1065    raeburn  13882:     $output .= 
                   13883:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  13884:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   13885:         "\n";
1.1065    raeburn  13886:     if ($duplicates ne '') {
                   13887:         $output .= '<p><span class="LC_warning">'.
                   13888:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   13889:                    &start_data_table().
                   13890:                    &start_data_table_header_row().
                   13891:                    '<th>'.&mt('Overwrite?').'</th>'.
                   13892:                    '<th>'.&mt('Name').'</th>'.
                   13893:                    '<th>'.&mt('Type').'</th>'.
                   13894:                    '<th>'.&mt('Size').'</th>'.
                   13895:                    '<th>'.&mt('Last modified').'</th>'.
                   13896:                    &end_data_table_header_row().
                   13897:                    $duplicates.
                   13898:                    &end_data_table().
                   13899:                    '</p>';
                   13900:     }
1.1067    raeburn  13901:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  13902:     if (ref($hiddenelements) eq 'HASH') {
                   13903:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   13904:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   13905:         }
                   13906:     }
                   13907:     $output .= <<"END";
1.1067    raeburn  13908: <br />
1.1053    raeburn  13909: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   13910: </form>
                   13911: $noextract
                   13912: END
                   13913:     return $output;
                   13914: }
                   13915: 
1.1065    raeburn  13916: sub decompression_utility {
                   13917:     my ($program) = @_;
                   13918:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   13919:     my $location;
                   13920:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   13921:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   13922:                          '/usr/sbin/') {
                   13923:             if (-x $dir.$program) {
                   13924:                 $location = $dir.$program;
                   13925:                 last;
                   13926:             }
                   13927:         }
                   13928:     }
                   13929:     return $location;
                   13930: }
                   13931: 
                   13932: sub list_archive_contents {
                   13933:     my ($file,$pathsref) = @_;
                   13934:     my (@cmd,$output);
                   13935:     my $needsregexp;
                   13936:     if ($file =~ /\.zip$/) {
                   13937:         @cmd = (&decompression_utility('unzip'),"-l");
                   13938:         $needsregexp = 1;
                   13939:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   13940:              ($file =~ /\.tgz$/)) {
                   13941:         @cmd = (&decompression_utility('tar'),"-ztf");
                   13942:     } elsif ($file =~ /\.tar\.bz2$/) {
                   13943:         @cmd = (&decompression_utility('tar'),"-jtf");
                   13944:     } elsif ($file =~ m|\.tar$|) {
                   13945:         @cmd = (&decompression_utility('tar'),"-tf");
                   13946:     }
                   13947:     if (@cmd) {
                   13948:         undef($!);
                   13949:         undef($@);
                   13950:         if (open(my $fh,"-|", @cmd, $file)) {
                   13951:             while (my $line = <$fh>) {
                   13952:                 $output .= $line;
                   13953:                 chomp($line);
                   13954:                 my $item;
                   13955:                 if ($needsregexp) {
                   13956:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   13957:                 } else {
                   13958:                     $item = $line;
                   13959:                 }
                   13960:                 if ($item ne '') {
                   13961:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   13962:                         push(@{$pathsref},$item);
                   13963:                     } 
                   13964:                 }
                   13965:             }
                   13966:             close($fh);
                   13967:         }
                   13968:     }
                   13969:     return $output;
                   13970: }
                   13971: 
1.1053    raeburn  13972: sub decompress_uploaded_file {
                   13973:     my ($file,$dir) = @_;
                   13974:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   13975:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   13976:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   13977:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   13978:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   13979:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   13980:     my $decompressed = $env{'cgi.decompressed'};
                   13981:     &Apache::lonnet::delenv('cgi.file');
                   13982:     &Apache::lonnet::delenv('cgi.dir');
                   13983:     &Apache::lonnet::delenv('cgi.decompressed');
                   13984:     return ($decompressed,$result);
                   13985: }
                   13986: 
1.1055    raeburn  13987: sub process_decompression {
                   13988:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1292    raeburn  13989:     unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
                   13990:         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   13991:                &mt('Unexpected file path.').'</p>'."\n";
                   13992:     }
                   13993:     unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
                   13994:         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   13995:                &mt('Unexpected course context.').'</p>'."\n";
                   13996:     }
1.1293    raeburn  13997:     unless ($file eq &Apache::lonnet::clean_filename($file)) {
1.1292    raeburn  13998:         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   13999:                &mt('Filename contained unexpected characters.').'</p>'."\n";
                   14000:     }
1.1055    raeburn  14001:     my ($dir,$error,$warning,$output);
1.1180    raeburn  14002:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120    bisitz   14003:         $error = &mt('Filename not a supported archive file type.').
                   14004:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  14005:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   14006:     } else {
                   14007:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   14008:         if ($docuhome eq 'no_host') {
                   14009:             $error = &mt('Could not determine home server for course.');
                   14010:         } else {
                   14011:             my @ids=&Apache::lonnet::current_machine_ids();
                   14012:             my $currdir = "$dir_root/$destination";
                   14013:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   14014:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   14015:                        "$dir_root/$destination";
                   14016:             } else {
                   14017:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   14018:                        "$dir_root/$docudom/$docuname/$destination";
                   14019:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   14020:                     $error = &mt('Archive file not found.');
                   14021:                 }
                   14022:             }
1.1065    raeburn  14023:             my (@to_overwrite,@to_skip);
                   14024:             if ($env{'form.archive_overwrite_total'} > 0) {
                   14025:                 my $total = $env{'form.archive_overwrite_total'};
                   14026:                 for (my $i=0; $i<$total; $i++) {
                   14027:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   14028:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   14029:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   14030:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   14031:                     }
                   14032:                 }
                   14033:             }
                   14034:             my $numskip = scalar(@to_skip);
1.1292    raeburn  14035:             my $numoverwrite = scalar(@to_overwrite);
                   14036:             if (($numskip) && (!$numoverwrite)) { 
1.1065    raeburn  14037:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   14038:             } elsif ($dir eq '') {
1.1055    raeburn  14039:                 $error = &mt('Directory containing archive file unavailable.');
                   14040:             } elsif (!$error) {
1.1065    raeburn  14041:                 my ($decompressed,$display);
1.1292    raeburn  14042:                 if (($numskip) || ($numoverwrite)) {
1.1065    raeburn  14043:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   14044:                     mkdir("$dir/$tempdir",0755);
1.1292    raeburn  14045:                     if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
                   14046:                         ($decompressed,$display) = 
                   14047:                             &decompress_uploaded_file($file,"$dir/$tempdir");
                   14048:                         foreach my $item (@to_skip) {
                   14049:                             if (($item ne '') && ($item !~ /\.\./)) {
                   14050:                                 if (-f "$dir/$tempdir/$item") { 
                   14051:                                     unlink("$dir/$tempdir/$item");
                   14052:                                 } elsif (-d "$dir/$tempdir/$item") {
1.1300    raeburn  14053:                                     &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
1.1292    raeburn  14054:                                 }
                   14055:                             }
                   14056:                         }
                   14057:                         foreach my $item (@to_overwrite) {
                   14058:                             if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
                   14059:                                 if (($item ne '') && ($item !~ /\.\./)) {
                   14060:                                     if (-f "$dir/$item") {
                   14061:                                         unlink("$dir/$item");
                   14062:                                     } elsif (-d "$dir/$item") {
1.1300    raeburn  14063:                                         &File::Path::remove_tree("$dir/$item",{ safe => 1 });
1.1292    raeburn  14064:                                     }
                   14065:                                     &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
                   14066:                                 }
1.1065    raeburn  14067:                             }
                   14068:                         }
1.1292    raeburn  14069:                         if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
1.1300    raeburn  14070:                             &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
1.1292    raeburn  14071:                         }
1.1065    raeburn  14072:                     }
                   14073:                 } else {
                   14074:                     ($decompressed,$display) = 
                   14075:                         &decompress_uploaded_file($file,$dir);
                   14076:                 }
1.1055    raeburn  14077:                 if ($decompressed eq 'ok') {
1.1065    raeburn  14078:                     $output = '<p class="LC_info">'.
                   14079:                               &mt('Files extracted successfully from archive.').
                   14080:                               '</p>'."\n";
1.1055    raeburn  14081:                     my ($warning,$result,@contents);
                   14082:                     my ($newdirlistref,$newlisterror) =
                   14083:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   14084:                                                  $docuname,1);
                   14085:                     my (%is_dir,%changes,@newitems);
                   14086:                     my $dirptr = 16384;
1.1065    raeburn  14087:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  14088:                         foreach my $dir_line (@{$newdirlistref}) {
                   14089:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1292    raeburn  14090:                             unless (($item =~ /^\.+$/) || ($item eq $file)) {
1.1055    raeburn  14091:                                 push(@newitems,$item);
                   14092:                                 if ($dirptr&$testdir) {
                   14093:                                     $is_dir{$item} = 1;
                   14094:                                 }
                   14095:                                 $changes{$item} = 1;
                   14096:                             }
                   14097:                         }
                   14098:                     }
                   14099:                     if (keys(%changes) > 0) {
                   14100:                         foreach my $item (sort(@newitems)) {
                   14101:                             if ($changes{$item}) {
                   14102:                                 push(@contents,$item);
                   14103:                             }
                   14104:                         }
                   14105:                     }
                   14106:                     if (@contents > 0) {
1.1067    raeburn  14107:                         my $wantform;
                   14108:                         unless ($env{'form.autoextract_camtasia'}) {
                   14109:                             $wantform = 1;
                   14110:                         }
1.1056    raeburn  14111:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  14112:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   14113:                                                                 $currdir,\%is_dir,
                   14114:                                                                 \%children,\%parent,
1.1056    raeburn  14115:                                                                 \@contents,\%dirorder,
                   14116:                                                                 \%titles,$wantform);
1.1055    raeburn  14117:                         if ($datatable ne '') {
                   14118:                             $output .= &archive_options_form('decompressed',$datatable,
                   14119:                                                              $count,$hiddenelem);
1.1065    raeburn  14120:                             my $startcount = 6;
1.1055    raeburn  14121:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  14122:                                                            \%titles,\%children);
1.1055    raeburn  14123:                         }
1.1067    raeburn  14124:                         if ($env{'form.autoextract_camtasia'}) {
1.1164    raeburn  14125:                             my $version = $env{'form.autoextract_camtasia'};
1.1067    raeburn  14126:                             my %displayed;
                   14127:                             my $total = 1;
                   14128:                             $env{'form.archive_directory'} = [];
                   14129:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   14130:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   14131:                                 $path =~ s{/$}{};
                   14132:                                 my $item;
                   14133:                                 if ($path ne '') {
                   14134:                                     $item = "$path/$titles{$i}";
                   14135:                                 } else {
                   14136:                                     $item = $titles{$i};
                   14137:                                 }
                   14138:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   14139:                                 if ($item eq $contents[0]) {
                   14140:                                     push(@{$env{'form.archive_directory'}},$i);
                   14141:                                     $env{'form.archive_'.$i} = 'display';
                   14142:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   14143:                                     $displayed{'folder'} = $i;
1.1164    raeburn  14144:                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                   14145:                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { 
1.1067    raeburn  14146:                                     $env{'form.archive_'.$i} = 'display';
                   14147:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   14148:                                     $displayed{'web'} = $i;
                   14149:                                 } else {
1.1164    raeburn  14150:                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                   14151:                                         ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                   14152:                                              ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067    raeburn  14153:                                         push(@{$env{'form.archive_directory'}},$i);
                   14154:                                     }
                   14155:                                     $env{'form.archive_'.$i} = 'dependency';
                   14156:                                 }
                   14157:                                 $total ++;
                   14158:                             }
                   14159:                             for (my $i=1; $i<$total; $i++) {
                   14160:                                 next if ($i == $displayed{'web'});
                   14161:                                 next if ($i == $displayed{'folder'});
                   14162:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   14163:                             }
                   14164:                             $env{'form.phase'} = 'decompress_cleanup';
                   14165:                             $env{'form.archivedelete'} = 1;
                   14166:                             $env{'form.archive_count'} = $total-1;
                   14167:                             $output .=
                   14168:                                 &process_extracted_files('coursedocs',$docudom,
                   14169:                                                          $docuname,$destination,
                   14170:                                                          $dir_root,$hiddenelem);
                   14171:                         }
1.1055    raeburn  14172:                     } else {
                   14173:                         $warning = &mt('No new items extracted from archive file.');
                   14174:                     }
                   14175:                 } else {
                   14176:                     $output = $display;
                   14177:                     $error = &mt('An error occurred during extraction from the archive file.');
                   14178:                 }
                   14179:             }
                   14180:         }
                   14181:     }
                   14182:     if ($error) {
                   14183:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   14184:                    $error.'</p>'."\n";
                   14185:     }
                   14186:     if ($warning) {
                   14187:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   14188:     }
                   14189:     return $output;
                   14190: }
                   14191: 
                   14192: sub get_extracted {
1.1056    raeburn  14193:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   14194:         $titles,$wantform) = @_;
1.1055    raeburn  14195:     my $count = 0;
                   14196:     my $depth = 0;
                   14197:     my $datatable;
1.1056    raeburn  14198:     my @hierarchy;
1.1055    raeburn  14199:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  14200:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   14201:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  14202:     foreach my $item (@{$contents}) {
                   14203:         $count ++;
1.1056    raeburn  14204:         @{$dirorder->{$count}} = @hierarchy;
                   14205:         $titles->{$count} = $item;
1.1055    raeburn  14206:         &archive_hierarchy($depth,$count,$parent,$children);
                   14207:         if ($wantform) {
                   14208:             $datatable .= &archive_row($is_dir->{$item},$item,
                   14209:                                        $currdir,$depth,$count);
                   14210:         }
                   14211:         if ($is_dir->{$item}) {
                   14212:             $depth ++;
1.1056    raeburn  14213:             push(@hierarchy,$count);
                   14214:             $parent->{$depth} = $count;
1.1055    raeburn  14215:             $datatable .=
                   14216:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  14217:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   14218:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  14219:             $depth --;
1.1056    raeburn  14220:             pop(@hierarchy);
1.1055    raeburn  14221:         }
                   14222:     }
                   14223:     return ($count,$datatable);
                   14224: }
                   14225: 
                   14226: sub recurse_extracted_archive {
1.1056    raeburn  14227:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   14228:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  14229:     my $result='';
1.1056    raeburn  14230:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   14231:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   14232:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  14233:         return $result;
                   14234:     }
                   14235:     my $dirptr = 16384;
                   14236:     my ($newdirlistref,$newlisterror) =
                   14237:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   14238:     if (ref($newdirlistref) eq 'ARRAY') {
                   14239:         foreach my $dir_line (@{$newdirlistref}) {
                   14240:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   14241:             unless ($item =~ /^\.+$/) {
                   14242:                 $$count ++;
1.1056    raeburn  14243:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   14244:                 $titles->{$$count} = $item;
1.1055    raeburn  14245:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  14246: 
1.1055    raeburn  14247:                 my $is_dir;
                   14248:                 if ($dirptr&$testdir) {
                   14249:                     $is_dir = 1;
                   14250:                 }
                   14251:                 if ($wantform) {
                   14252:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   14253:                 }
                   14254:                 if ($is_dir) {
                   14255:                     $$depth ++;
1.1056    raeburn  14256:                     push(@{$hierarchy},$$count);
                   14257:                     $parent->{$$depth} = $$count;
1.1055    raeburn  14258:                     $result .=
                   14259:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   14260:                                                    $docuname,$depth,$count,
1.1056    raeburn  14261:                                                    $hierarchy,$dirorder,$children,
                   14262:                                                    $parent,$titles,$wantform);
1.1055    raeburn  14263:                     $$depth --;
1.1056    raeburn  14264:                     pop(@{$hierarchy});
1.1055    raeburn  14265:                 }
                   14266:             }
                   14267:         }
                   14268:     }
                   14269:     return $result;
                   14270: }
                   14271: 
                   14272: sub archive_hierarchy {
                   14273:     my ($depth,$count,$parent,$children) =@_;
                   14274:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   14275:         if (exists($parent->{$depth})) {
                   14276:              $children->{$parent->{$depth}} .= $count.':';
                   14277:         }
                   14278:     }
                   14279:     return;
                   14280: }
                   14281: 
                   14282: sub archive_row {
                   14283:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   14284:     my ($name) = ($item =~ m{([^/]+)$});
                   14285:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  14286:                                        'display'    => 'Add as file',
1.1055    raeburn  14287:                                        'dependency' => 'Include as dependency',
                   14288:                                        'discard'    => 'Discard',
                   14289:                                       );
                   14290:     if ($is_dir) {
1.1059    raeburn  14291:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  14292:     }
1.1056    raeburn  14293:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   14294:     my $offset = 0;
1.1055    raeburn  14295:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  14296:         $offset ++;
1.1065    raeburn  14297:         if ($action ne 'display') {
                   14298:             $offset ++;
                   14299:         }  
1.1055    raeburn  14300:         $output .= '<td><span class="LC_nobreak">'.
                   14301:                    '<label><input type="radio" name="archive_'.$count.
                   14302:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   14303:         my $text = $choices{$action};
                   14304:         if ($is_dir) {
                   14305:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   14306:             if ($action eq 'display') {
1.1059    raeburn  14307:                 $text = &mt('Add as folder');
1.1055    raeburn  14308:             }
1.1056    raeburn  14309:         } else {
                   14310:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   14311: 
                   14312:         }
                   14313:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   14314:         if ($action eq 'dependency') {
                   14315:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   14316:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   14317:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   14318:                        '<option value=""></option>'."\n".
                   14319:                        '</select>'."\n".
                   14320:                        '</div>';
1.1059    raeburn  14321:         } elsif ($action eq 'display') {
                   14322:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   14323:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   14324:                        '</div>';
1.1055    raeburn  14325:         }
1.1056    raeburn  14326:         $output .= '</td>';
1.1055    raeburn  14327:     }
                   14328:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   14329:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   14330:     for (my $i=0; $i<$depth; $i++) {
                   14331:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   14332:     }
                   14333:     if ($is_dir) {
                   14334:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   14335:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   14336:     } else {
                   14337:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   14338:     }
                   14339:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   14340:                &end_data_table_row();
                   14341:     return $output;
                   14342: }
                   14343: 
                   14344: sub archive_options_form {
1.1065    raeburn  14345:     my ($form,$display,$count,$hiddenelem) = @_;
                   14346:     my %lt = &Apache::lonlocal::texthash(
                   14347:                perm => 'Permanently remove archive file?',
                   14348:                hows => 'How should each extracted item be incorporated in the course?',
                   14349:                cont => 'Content actions for all',
                   14350:                addf => 'Add as folder/file',
                   14351:                incd => 'Include as dependency for a displayed file',
                   14352:                disc => 'Discard',
                   14353:                no   => 'No',
                   14354:                yes  => 'Yes',
                   14355:                save => 'Save',
                   14356:     );
                   14357:     my $output = <<"END";
                   14358: <form name="$form" method="post" action="">
                   14359: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   14360: <label>
                   14361:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   14362: </label>
                   14363: &nbsp;
                   14364: <label>
                   14365:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   14366: </span>
                   14367: </p>
                   14368: <input type="hidden" name="phase" value="decompress_cleanup" />
                   14369: <br />$lt{'hows'}
                   14370: <div class="LC_columnSection">
                   14371:   <fieldset>
                   14372:     <legend>$lt{'cont'}</legend>
                   14373:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   14374:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   14375:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   14376:   </fieldset>
                   14377: </div>
                   14378: END
                   14379:     return $output.
1.1055    raeburn  14380:            &start_data_table()."\n".
1.1065    raeburn  14381:            $display."\n".
1.1055    raeburn  14382:            &end_data_table()."\n".
                   14383:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   14384:            $hiddenelem.
1.1065    raeburn  14385:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  14386:            '</form>';
                   14387: }
                   14388: 
                   14389: sub archive_javascript {
1.1056    raeburn  14390:     my ($startcount,$numitems,$titles,$children) = @_;
                   14391:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  14392:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  14393:     my $scripttag = <<START;
                   14394: <script type="text/javascript">
                   14395: // <![CDATA[
                   14396: 
                   14397: function checkAll(form,prefix) {
                   14398:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   14399:     for (var i=0; i < form.elements.length; i++) {
                   14400:         var id = form.elements[i].id;
                   14401:         if ((id != '') && (id != undefined)) {
                   14402:             if (idstr.test(id)) {
                   14403:                 if (form.elements[i].type == 'radio') {
                   14404:                     form.elements[i].checked = true;
1.1056    raeburn  14405:                     var nostart = i-$startcount;
1.1059    raeburn  14406:                     var offset = nostart%7;
                   14407:                     var count = (nostart-offset)/7;    
1.1056    raeburn  14408:                     dependencyCheck(form,count,offset);
1.1055    raeburn  14409:                 }
                   14410:             }
                   14411:         }
                   14412:     }
                   14413: }
                   14414: 
                   14415: function propagateCheck(form,count) {
                   14416:     if (count > 0) {
1.1059    raeburn  14417:         var startelement = $startcount + ((count-1) * 7);
                   14418:         for (var j=1; j<6; j++) {
                   14419:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  14420:                 var item = startelement + j; 
                   14421:                 if (form.elements[item].type == 'radio') {
                   14422:                     if (form.elements[item].checked) {
                   14423:                         containerCheck(form,count,j);
                   14424:                         break;
                   14425:                     }
1.1055    raeburn  14426:                 }
                   14427:             }
                   14428:         }
                   14429:     }
                   14430: }
                   14431: 
                   14432: numitems = $numitems
1.1056    raeburn  14433: var titles = new Array(numitems);
                   14434: var parents = new Array(numitems);
1.1055    raeburn  14435: for (var i=0; i<numitems; i++) {
1.1056    raeburn  14436:     parents[i] = new Array;
1.1055    raeburn  14437: }
1.1059    raeburn  14438: var maintitle = '$maintitle';
1.1055    raeburn  14439: 
                   14440: START
                   14441: 
1.1056    raeburn  14442:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   14443:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  14444:         for (my $i=0; $i<@contents; $i ++) {
                   14445:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   14446:         }
                   14447:     }
                   14448: 
1.1056    raeburn  14449:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   14450:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   14451:     }
                   14452: 
1.1055    raeburn  14453:     $scripttag .= <<END;
                   14454: 
                   14455: function containerCheck(form,count,offset) {
                   14456:     if (count > 0) {
1.1056    raeburn  14457:         dependencyCheck(form,count,offset);
1.1059    raeburn  14458:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  14459:         form.elements[item].checked = true;
                   14460:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   14461:             if (parents[count].length > 0) {
                   14462:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  14463:                     containerCheck(form,parents[count][j],offset);
                   14464:                 }
                   14465:             }
                   14466:         }
                   14467:     }
                   14468: }
                   14469: 
                   14470: function dependencyCheck(form,count,offset) {
                   14471:     if (count > 0) {
1.1059    raeburn  14472:         var chosen = (offset+$startcount)+7*(count-1);
                   14473:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  14474:         var currtype = form.elements[depitem].type;
                   14475:         if (form.elements[chosen].value == 'dependency') {
                   14476:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   14477:             form.elements[depitem].options.length = 0;
                   14478:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085    raeburn  14479:             for (var i=1; i<=numitems; i++) {
                   14480:                 if (i == count) {
                   14481:                     continue;
                   14482:                 }
1.1059    raeburn  14483:                 var startelement = $startcount + (i-1) * 7;
                   14484:                 for (var j=1; j<6; j++) {
                   14485:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  14486:                         var item = startelement + j;
                   14487:                         if (form.elements[item].type == 'radio') {
                   14488:                             if (form.elements[item].checked) {
                   14489:                                 if (form.elements[item].value == 'display') {
                   14490:                                     var n = form.elements[depitem].options.length;
                   14491:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   14492:                                 }
                   14493:                             }
                   14494:                         }
                   14495:                     }
                   14496:                 }
                   14497:             }
                   14498:         } else {
                   14499:             document.getElementById('arc_depon_'+count).style.display='none';
                   14500:             form.elements[depitem].options.length = 0;
                   14501:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   14502:         }
1.1059    raeburn  14503:         titleCheck(form,count,offset);
1.1056    raeburn  14504:     }
                   14505: }
                   14506: 
                   14507: function propagateSelect(form,count,offset) {
                   14508:     if (count > 0) {
1.1065    raeburn  14509:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  14510:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   14511:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   14512:             if (parents[count].length > 0) {
                   14513:                 for (var j=0; j<parents[count].length; j++) {
                   14514:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  14515:                 }
                   14516:             }
                   14517:         }
                   14518:     }
                   14519: }
1.1056    raeburn  14520: 
                   14521: function containerSelect(form,count,offset,picked) {
                   14522:     if (count > 0) {
1.1065    raeburn  14523:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  14524:         if (form.elements[item].type == 'radio') {
                   14525:             if (form.elements[item].value == 'dependency') {
                   14526:                 if (form.elements[item+1].type == 'select-one') {
                   14527:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   14528:                         if (form.elements[item+1].options[i].value == picked) {
                   14529:                             form.elements[item+1].selectedIndex = i;
                   14530:                             break;
                   14531:                         }
                   14532:                     }
                   14533:                 }
                   14534:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   14535:                     if (parents[count].length > 0) {
                   14536:                         for (var j=0; j<parents[count].length; j++) {
                   14537:                             containerSelect(form,parents[count][j],offset,picked);
                   14538:                         }
                   14539:                     }
                   14540:                 }
                   14541:             }
                   14542:         }
                   14543:     }
                   14544: }
                   14545: 
1.1059    raeburn  14546: function titleCheck(form,count,offset) {
                   14547:     if (count > 0) {
                   14548:         var chosen = (offset+$startcount)+7*(count-1);
                   14549:         var depitem = $startcount + ((count-1) * 7) + 2;
                   14550:         var currtype = form.elements[depitem].type;
                   14551:         if (form.elements[chosen].value == 'display') {
                   14552:             document.getElementById('arc_title_'+count).style.display='block';
                   14553:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   14554:                 document.getElementById('archive_title_'+count).value=maintitle;
                   14555:             }
                   14556:         } else {
                   14557:             document.getElementById('arc_title_'+count).style.display='none';
                   14558:             if (currtype == 'text') { 
                   14559:                 document.getElementById('archive_title_'+count).value='';
                   14560:             }
                   14561:         }
                   14562:     }
                   14563:     return;
                   14564: }
                   14565: 
1.1055    raeburn  14566: // ]]>
                   14567: </script>
                   14568: END
                   14569:     return $scripttag;
                   14570: }
                   14571: 
                   14572: sub process_extracted_files {
1.1067    raeburn  14573:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  14574:     my $numitems = $env{'form.archive_count'};
1.1294    raeburn  14575:     return if ((!$numitems) || ($numitems =~ /\D/));
1.1055    raeburn  14576:     my @ids=&Apache::lonnet::current_machine_ids();
                   14577:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  14578:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  14579:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   14580:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   14581:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   14582:         $pathtocheck = "$dir_root/$destination";
                   14583:         $dir = $dir_root;
                   14584:         $ishome = 1;
                   14585:     } else {
                   14586:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   14587:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1294    raeburn  14588:         $dir = "$dir_root/$docudom/$docuname";
1.1055    raeburn  14589:     }
                   14590:     my $currdir = "$dir_root/$destination";
                   14591:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   14592:     if ($env{'form.folderpath'}) {
                   14593:         my @items = split('&',$env{'form.folderpath'});
                   14594:         $folders{'0'} = $items[-2];
1.1099    raeburn  14595:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   14596:             $containers{'0'}='page';
                   14597:         } else {  
                   14598:             $containers{'0'}='sequence';
                   14599:         }
1.1055    raeburn  14600:     }
                   14601:     my @archdirs = &get_env_multiple('form.archive_directory');
                   14602:     if ($numitems) {
                   14603:         for (my $i=1; $i<=$numitems; $i++) {
                   14604:             my $path = $env{'form.archive_content_'.$i};
                   14605:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   14606:                 my $item = $1;
                   14607:                 $toplevelitems{$item} = $i;
                   14608:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   14609:                     $is_dir{$item} = 1;
                   14610:                 }
                   14611:             }
                   14612:         }
                   14613:     }
1.1067    raeburn  14614:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  14615:     if (keys(%toplevelitems) > 0) {
                   14616:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  14617:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   14618:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  14619:     }
1.1066    raeburn  14620:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  14621:     if ($numitems) {
                   14622:         for (my $i=1; $i<=$numitems; $i++) {
1.1086    raeburn  14623:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  14624:             my $path = $env{'form.archive_content_'.$i};
                   14625:             if ($path =~ /^\Q$pathtocheck\E/) {
                   14626:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   14627:                     if ($prefix ne '' && $path ne '') {
                   14628:                         if (-e $prefix.$path) {
1.1066    raeburn  14629:                             if ((@archdirs > 0) && 
                   14630:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   14631:                                 $todeletedir{$prefix.$path} = 1;
                   14632:                             } else {
                   14633:                                 $todelete{$prefix.$path} = 1;
                   14634:                             }
1.1055    raeburn  14635:                         }
                   14636:                     }
                   14637:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  14638:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  14639:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  14640:                     $docstitle = $env{'form.archive_title_'.$i};
                   14641:                     if ($docstitle eq '') {
                   14642:                         $docstitle = $title;
                   14643:                     }
1.1055    raeburn  14644:                     $outer = 0;
1.1056    raeburn  14645:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   14646:                         if (@{$dirorder{$i}} > 0) {
                   14647:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  14648:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   14649:                                     $outer = $item;
                   14650:                                     last;
                   14651:                                 }
                   14652:                             }
                   14653:                         }
                   14654:                     }
                   14655:                     my ($errtext,$fatal) = 
                   14656:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   14657:                                                '/'.$folders{$outer}.'.'.
                   14658:                                                $containers{$outer});
                   14659:                     next if ($fatal);
                   14660:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   14661:                         if ($context eq 'coursedocs') {
1.1056    raeburn  14662:                             $mapinner{$i} = time;
1.1055    raeburn  14663:                             $folders{$i} = 'default_'.$mapinner{$i};
                   14664:                             $containers{$i} = 'sequence';
                   14665:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   14666:                                       $folders{$i}.'.'.$containers{$i};
                   14667:                             my $newidx = &LONCAPA::map::getresidx();
                   14668:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  14669:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  14670:                             push(@LONCAPA::map::order,$newidx);
                   14671:                             my ($outtext,$errtext) =
                   14672:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   14673:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  14674:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  14675:                             $newseqid{$i} = $newidx;
1.1067    raeburn  14676:                             unless ($errtext) {
1.1294    raeburn  14677:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',
                   14678:                                                        &HTML::Entities::encode($docstitle,'<>&"')).
                   14679:                                             '</li>'."\n";
1.1067    raeburn  14680:                             }
1.1055    raeburn  14681:                         }
                   14682:                     } else {
                   14683:                         if ($context eq 'coursedocs') {
                   14684:                             my $newidx=&LONCAPA::map::getresidx();
                   14685:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   14686:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   14687:                                       $title;
1.1392    raeburn  14688:                             if (($outer !~ /\D/) &&
                   14689:                                 (($mapinner{$outer} eq 'default') || ($mapinner{$outer} !~ /\D/)) &&
                   14690:                                 ($newidx !~ /\D/)) {
1.1294    raeburn  14691:                                 if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   14692:                                     mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   14693:                                 }
                   14694:                                 if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   14695:                                     mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   14696:                                 }
                   14697:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   14698:                                     if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
                   14699:                                         $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
                   14700:                                         unless ($ishome) {
                   14701:                                             my $fetch = "$newdest{$i}/$title";
                   14702:                                             $fetch =~ s/^\Q$prefix$dir\E//;
                   14703:                                             $prompttofetch{$fetch} = 1;
                   14704:                                         }
1.1292    raeburn  14705:                                     }
1.1067    raeburn  14706:                                 }
1.1294    raeburn  14707:                                 $LONCAPA::map::resources[$newidx]=
                   14708:                                     $docstitle.':'.$url.':false:normal:res';
                   14709:                                 push(@LONCAPA::map::order, $newidx);
                   14710:                                 my ($outtext,$errtext)=
                   14711:                                     &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   14712:                                                             $docuname.'/'.$folders{$outer}.
                   14713:                                                             '.'.$containers{$outer},1,1);
                   14714:                                 unless ($errtext) {
                   14715:                                     if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   14716:                                         $result .= '<li>'.&mt('File: [_1] added to course',
                   14717:                                                               &HTML::Entities::encode($docstitle,'<>&"')).
                   14718:                                                    '</li>'."\n";
                   14719:                                     }
1.1067    raeburn  14720:                                 }
1.1294    raeburn  14721:                             } else {
                   14722:                                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                   14723:                                                 &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1296    raeburn  14724:                             }
1.1055    raeburn  14725:                         }
                   14726:                     }
1.1086    raeburn  14727:                 }
                   14728:             } else {
1.1294    raeburn  14729:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                   14730:                                 &HTML::Entities::encode($path,'<>&"')).'<br />'; 
1.1086    raeburn  14731:             }
                   14732:         }
                   14733:         for (my $i=1; $i<=$numitems; $i++) {
                   14734:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   14735:             my $path = $env{'form.archive_content_'.$i};
                   14736:             if ($path =~ /^\Q$pathtocheck\E/) {
                   14737:                 my ($title) = ($path =~ m{/([^/]+)$});
                   14738:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   14739:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   14740:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   14741:                         my ($itemidx,$fullpath,$relpath);
                   14742:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   14743:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  14744:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086    raeburn  14745:                                 if ($dirorder{$i}->[$j] eq $container) {
                   14746:                                     $itemidx = $j;
1.1056    raeburn  14747:                                 }
                   14748:                             }
1.1086    raeburn  14749:                         }
                   14750:                         if ($itemidx eq '') {
                   14751:                             $itemidx =  0;
                   14752:                         } 
                   14753:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   14754:                             if ($mapinner{$referrer{$i}}) {
                   14755:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   14756:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   14757:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   14758:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   14759:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   14760:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   14761:                                             if (!-e $fullpath) {
                   14762:                                                 mkdir($fullpath,0755);
1.1056    raeburn  14763:                                             }
                   14764:                                         }
1.1086    raeburn  14765:                                     } else {
                   14766:                                         last;
1.1056    raeburn  14767:                                     }
1.1086    raeburn  14768:                                 }
                   14769:                             }
                   14770:                         } elsif ($newdest{$referrer{$i}}) {
                   14771:                             $fullpath = $newdest{$referrer{$i}};
                   14772:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   14773:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   14774:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   14775:                                     last;
                   14776:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   14777:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   14778:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   14779:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   14780:                                         if (!-e $fullpath) {
                   14781:                                             mkdir($fullpath,0755);
1.1056    raeburn  14782:                                         }
                   14783:                                     }
1.1086    raeburn  14784:                                 } else {
                   14785:                                     last;
1.1056    raeburn  14786:                                 }
1.1055    raeburn  14787:                             }
                   14788:                         }
1.1086    raeburn  14789:                         if ($fullpath ne '') {
                   14790:                             if (-e "$prefix$path") {
1.1292    raeburn  14791:                                 unless (rename("$prefix$path","$fullpath/$title")) {
                   14792:                                      $warning .= &mt('Failed to rename dependency').'<br />';
                   14793:                                 }
1.1086    raeburn  14794:                             }
                   14795:                             if (-e "$fullpath/$title") {
                   14796:                                 my $showpath;
                   14797:                                 if ($relpath ne '') {
                   14798:                                     $showpath = "$relpath/$title";
                   14799:                                 } else {
                   14800:                                     $showpath = "/$title";
                   14801:                                 } 
1.1294    raeburn  14802:                                 $result .= '<li>'.&mt('[_1] included as a dependency',
                   14803:                                                       &HTML::Entities::encode($showpath,'<>&"')).
                   14804:                                            '</li>'."\n";
1.1292    raeburn  14805:                                 unless ($ishome) {
                   14806:                                     my $fetch = "$fullpath/$title";
                   14807:                                     $fetch =~ s/^\Q$prefix$dir\E//; 
                   14808:                                     $prompttofetch{$fetch} = 1;
                   14809:                                 }
1.1086    raeburn  14810:                             }
                   14811:                         }
1.1055    raeburn  14812:                     }
1.1086    raeburn  14813:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   14814:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1294    raeburn  14815:                                     &HTML::Entities::encode($path,'<>&"'),
                   14816:                                     &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
                   14817:                                 '<br />';
1.1055    raeburn  14818:                 }
                   14819:             } else {
1.1294    raeburn  14820:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
1.1296    raeburn  14821:                                 &HTML::Entities::encode($path)).'<br />';
1.1055    raeburn  14822:             }
                   14823:         }
                   14824:         if (keys(%todelete)) {
                   14825:             foreach my $key (keys(%todelete)) {
                   14826:                 unlink($key);
1.1066    raeburn  14827:             }
                   14828:         }
                   14829:         if (keys(%todeletedir)) {
                   14830:             foreach my $key (keys(%todeletedir)) {
                   14831:                 rmdir($key);
                   14832:             }
                   14833:         }
                   14834:         foreach my $dir (sort(keys(%is_dir))) {
                   14835:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   14836:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  14837:             }
                   14838:         }
1.1067    raeburn  14839:         if ($result ne '') {
                   14840:             $output .= '<ul>'."\n".
                   14841:                        $result."\n".
                   14842:                        '</ul>';
                   14843:         }
                   14844:         unless ($ishome) {
                   14845:             my $replicationfail;
                   14846:             foreach my $item (keys(%prompttofetch)) {
                   14847:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   14848:                 unless ($fetchresult eq 'ok') {
                   14849:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   14850:                 }
                   14851:             }
                   14852:             if ($replicationfail) {
                   14853:                 $output .= '<p class="LC_error">'.
                   14854:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   14855:                            $replicationfail.
                   14856:                            '</ul></p>';
                   14857:             }
                   14858:         }
1.1055    raeburn  14859:     } else {
                   14860:         $warning = &mt('No items found in archive.');
                   14861:     }
                   14862:     if ($error) {
                   14863:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   14864:                    $error.'</p>'."\n";
                   14865:     }
                   14866:     if ($warning) {
                   14867:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   14868:     }
                   14869:     return $output;
                   14870: }
                   14871: 
1.1066    raeburn  14872: sub cleanup_empty_dirs {
                   14873:     my ($path) = @_;
                   14874:     if (($path ne '') && (-d $path)) {
                   14875:         if (opendir(my $dirh,$path)) {
                   14876:             my @dircontents = grep(!/^\./,readdir($dirh));
                   14877:             my $numitems = 0;
                   14878:             foreach my $item (@dircontents) {
                   14879:                 if (-d "$path/$item") {
1.1111    raeburn  14880:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  14881:                     if (-e "$path/$item") {
                   14882:                         $numitems ++;
                   14883:                     }
                   14884:                 } else {
                   14885:                     $numitems ++;
                   14886:                 }
                   14887:             }
                   14888:             if ($numitems == 0) {
                   14889:                 rmdir($path);
                   14890:             }
                   14891:             closedir($dirh);
                   14892:         }
                   14893:     }
                   14894:     return;
                   14895: }
                   14896: 
1.41      ng       14897: =pod
1.45      matthew  14898: 
1.1162    raeburn  14899: =item * &get_folder_hierarchy()
1.1068    raeburn  14900: 
                   14901: Provides hierarchy of names of folders/sub-folders containing the current
                   14902: item,
                   14903: 
                   14904: Inputs: 3
                   14905:      - $navmap - navmaps object
                   14906: 
                   14907:      - $map - url for map (either the trigger itself, or map containing
                   14908:                            the resource, which is the trigger).
                   14909: 
                   14910:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   14911: 
                   14912: Outputs: 1 @pathitems - array of folder/subfolder names.
                   14913: 
                   14914: =cut
                   14915: 
                   14916: sub get_folder_hierarchy {
                   14917:     my ($navmap,$map,$showitem) = @_;
                   14918:     my @pathitems;
                   14919:     if (ref($navmap)) {
                   14920:         my $mapres = $navmap->getResourceByUrl($map);
                   14921:         if (ref($mapres)) {
                   14922:             my $pcslist = $mapres->map_hierarchy();
                   14923:             if ($pcslist ne '') {
                   14924:                 my @pcs = split(/,/,$pcslist);
                   14925:                 foreach my $pc (@pcs) {
                   14926:                     if ($pc == 1) {
1.1129    raeburn  14927:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  14928:                     } else {
                   14929:                         my $res = $navmap->getByMapPc($pc);
                   14930:                         if (ref($res)) {
                   14931:                             my $title = $res->compTitle();
                   14932:                             $title =~ s/\W+/_/g;
                   14933:                             if ($title ne '') {
                   14934:                                 push(@pathitems,$title);
                   14935:                             }
                   14936:                         }
                   14937:                     }
                   14938:                 }
                   14939:             }
1.1071    raeburn  14940:             if ($showitem) {
                   14941:                 if ($mapres->{ID} eq '0.0') {
1.1129    raeburn  14942:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  14943:                 } else {
                   14944:                     my $maptitle = $mapres->compTitle();
                   14945:                     $maptitle =~ s/\W+/_/g;
                   14946:                     if ($maptitle ne '') {
                   14947:                         push(@pathitems,$maptitle);
                   14948:                     }
1.1068    raeburn  14949:                 }
                   14950:             }
                   14951:         }
                   14952:     }
                   14953:     return @pathitems;
                   14954: }
                   14955: 
                   14956: =pod
                   14957: 
1.1015    raeburn  14958: =item * &get_turnedin_filepath()
                   14959: 
                   14960: Determines path in a user's portfolio file for storage of files uploaded
                   14961: to a specific essayresponse or dropbox item.
                   14962: 
                   14963: Inputs: 3 required + 1 optional.
                   14964: $symb is symb for resource, $uname and $udom are for current user (required).
                   14965: $caller is optional (can be "submission", if routine is called when storing
                   14966: an upoaded file when "Submit Answer" button was pressed).
                   14967: 
                   14968: Returns array containing $path and $multiresp. 
                   14969: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   14970: than one file upload item.  Callers of routine should append partid as a 
                   14971: subdirectory to $path in cases where $multiresp is 1.
                   14972: 
                   14973: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   14974: 
                   14975: =cut
                   14976: 
                   14977: sub get_turnedin_filepath {
                   14978:     my ($symb,$uname,$udom,$caller) = @_;
                   14979:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   14980:     my $turnindir;
                   14981:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   14982:     $turnindir = $userhash{'turnindir'};
                   14983:     my ($path,$multiresp);
                   14984:     if ($turnindir eq '') {
                   14985:         if ($caller eq 'submission') {
                   14986:             $turnindir = &mt('turned in');
                   14987:             $turnindir =~ s/\W+/_/g;
                   14988:             my %newhash = (
                   14989:                             'turnindir' => $turnindir,
                   14990:                           );
                   14991:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   14992:         }
                   14993:     }
                   14994:     if ($turnindir ne '') {
                   14995:         $path = '/'.$turnindir.'/';
                   14996:         my ($multipart,$turnin,@pathitems);
                   14997:         my $navmap = Apache::lonnavmaps::navmap->new();
                   14998:         if (defined($navmap)) {
                   14999:             my $mapres = $navmap->getResourceByUrl($map);
                   15000:             if (ref($mapres)) {
                   15001:                 my $pcslist = $mapres->map_hierarchy();
                   15002:                 if ($pcslist ne '') {
                   15003:                     foreach my $pc (split(/,/,$pcslist)) {
                   15004:                         my $res = $navmap->getByMapPc($pc);
                   15005:                         if (ref($res)) {
                   15006:                             my $title = $res->compTitle();
                   15007:                             $title =~ s/\W+/_/g;
                   15008:                             if ($title ne '') {
1.1149    raeburn  15009:                                 if (($pc > 1) && (length($title) > 12)) {
                   15010:                                     $title = substr($title,0,12);
                   15011:                                 }
1.1015    raeburn  15012:                                 push(@pathitems,$title);
                   15013:                             }
                   15014:                         }
                   15015:                     }
                   15016:                 }
                   15017:                 my $maptitle = $mapres->compTitle();
                   15018:                 $maptitle =~ s/\W+/_/g;
                   15019:                 if ($maptitle ne '') {
1.1149    raeburn  15020:                     if (length($maptitle) > 12) {
                   15021:                         $maptitle = substr($maptitle,0,12);
                   15022:                     }
1.1015    raeburn  15023:                     push(@pathitems,$maptitle);
                   15024:                 }
                   15025:                 unless ($env{'request.state'} eq 'construct') {
                   15026:                     my $res = $navmap->getBySymb($symb);
                   15027:                     if (ref($res)) {
                   15028:                         my $partlist = $res->parts();
                   15029:                         my $totaluploads = 0;
                   15030:                         if (ref($partlist) eq 'ARRAY') {
                   15031:                             foreach my $part (@{$partlist}) {
                   15032:                                 my @types = $res->responseType($part);
                   15033:                                 my @ids = $res->responseIds($part);
                   15034:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   15035:                                     if ($types[$i] eq 'essay') {
                   15036:                                         my $partid = $part.'_'.$ids[$i];
                   15037:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   15038:                                             $totaluploads ++;
                   15039:                                         }
                   15040:                                     }
                   15041:                                 }
                   15042:                             }
                   15043:                             if ($totaluploads > 1) {
                   15044:                                 $multiresp = 1;
                   15045:                             }
                   15046:                         }
                   15047:                     }
                   15048:                 }
                   15049:             } else {
                   15050:                 return;
                   15051:             }
                   15052:         } else {
                   15053:             return;
                   15054:         }
                   15055:         my $restitle=&Apache::lonnet::gettitle($symb);
                   15056:         $restitle =~ s/\W+/_/g;
                   15057:         if ($restitle eq '') {
                   15058:             $restitle = ($resurl =~ m{/[^/]+$});
                   15059:             if ($restitle eq '') {
                   15060:                 $restitle = time;
                   15061:             }
                   15062:         }
1.1149    raeburn  15063:         if (length($restitle) > 12) {
                   15064:             $restitle = substr($restitle,0,12);
                   15065:         }
1.1015    raeburn  15066:         push(@pathitems,$restitle);
                   15067:         $path .= join('/',@pathitems);
                   15068:     }
                   15069:     return ($path,$multiresp);
                   15070: }
                   15071: 
                   15072: =pod
                   15073: 
1.464     albertel 15074: =back
1.41      ng       15075: 
1.112     bowersj2 15076: =head1 CSV Upload/Handling functions
1.38      albertel 15077: 
1.41      ng       15078: =over 4
                   15079: 
1.648     raeburn  15080: =item * &upfile_store($r)
1.41      ng       15081: 
                   15082: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 15083: needs $env{'form.upfile'}
1.41      ng       15084: returns $datatoken to be put into hidden field
                   15085: 
                   15086: =cut
1.31      albertel 15087: 
                   15088: sub upfile_store {
                   15089:     my $r=shift;
1.258     albertel 15090:     $env{'form.upfile'}=~s/\r/\n/gs;
                   15091:     $env{'form.upfile'}=~s/\f/\n/gs;
                   15092:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   15093:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 15094: 
1.1299    raeburn  15095:     my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
                   15096:                                      '_enroll_'.$env{'request.course.id'}.'_'.
                   15097:                                      time.'_'.$$);
                   15098:     return if ($datatoken eq '');
                   15099: 
1.31      albertel 15100:     {
1.158     raeburn  15101:         my $datafile = $r->dir_config('lonDaemons').
                   15102:                            '/tmp/'.$datatoken.'.tmp';
1.1317    raeburn  15103:         if ( open(my $fh,'>',$datafile) ) {
1.258     albertel 15104:             print $fh $env{'form.upfile'};
1.158     raeburn  15105:             close($fh);
                   15106:         }
1.31      albertel 15107:     }
                   15108:     return $datatoken;
                   15109: }
                   15110: 
1.56      matthew  15111: =pod
                   15112: 
1.1290    raeburn  15113: =item * &load_tmp_file($r,$datatoken)
1.41      ng       15114: 
                   15115: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1290    raeburn  15116: $datatoken is the name to assign to the temporary file.
1.258     albertel 15117: sets $env{'form.upfile'} to the contents of the file
1.41      ng       15118: 
                   15119: =cut
1.31      albertel 15120: 
                   15121: sub load_tmp_file {
1.1290    raeburn  15122:     my ($r,$datatoken) = @_;
                   15123:     return if ($datatoken eq '');
1.31      albertel 15124:     my @studentdata=();
                   15125:     {
1.158     raeburn  15126:         my $studentfile = $r->dir_config('lonDaemons').
1.1290    raeburn  15127:                               '/tmp/'.$datatoken.'.tmp';
1.1317    raeburn  15128:         if ( open(my $fh,'<',$studentfile) ) {
1.158     raeburn  15129:             @studentdata=<$fh>;
                   15130:             close($fh);
                   15131:         }
1.31      albertel 15132:     }
1.258     albertel 15133:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 15134: }
                   15135: 
1.1290    raeburn  15136: sub valid_datatoken {
                   15137:     my ($datatoken) = @_;
1.1325    raeburn  15138:     if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
1.1290    raeburn  15139:         return $datatoken;
                   15140:     }
                   15141:     return;
                   15142: }
                   15143: 
1.56      matthew  15144: =pod
                   15145: 
1.648     raeburn  15146: =item * &upfile_record_sep()
1.41      ng       15147: 
                   15148: Separate uploaded file into records
                   15149: returns array of records,
1.258     albertel 15150: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       15151: 
                   15152: =cut
1.31      albertel 15153: 
                   15154: sub upfile_record_sep {
1.258     albertel 15155:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 15156:     } else {
1.248     albertel 15157: 	my @records;
1.258     albertel 15158: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 15159: 	    if ($line=~/^\s*$/) { next; }
                   15160: 	    push(@records,$line);
                   15161: 	}
                   15162: 	return @records;
1.31      albertel 15163:     }
                   15164: }
                   15165: 
1.56      matthew  15166: =pod
                   15167: 
1.648     raeburn  15168: =item * &record_sep($record)
1.41      ng       15169: 
1.258     albertel 15170: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       15171: 
                   15172: =cut
                   15173: 
1.263     www      15174: sub takeleft {
                   15175:     my $index=shift;
                   15176:     return substr('0000'.$index,-4,4);
                   15177: }
                   15178: 
1.31      albertel 15179: sub record_sep {
                   15180:     my $record=shift;
                   15181:     my %components=();
1.258     albertel 15182:     if ($env{'form.upfiletype'} eq 'xml') {
                   15183:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 15184:         my $i=0;
1.356     albertel 15185:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 15186:             $field=~s/^(\"|\')//;
                   15187:             $field=~s/(\"|\')$//;
1.263     www      15188:             $components{&takeleft($i)}=$field;
1.31      albertel 15189:             $i++;
                   15190:         }
1.258     albertel 15191:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 15192:         my $i=0;
1.356     albertel 15193:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 15194:             $field=~s/^(\"|\')//;
                   15195:             $field=~s/(\"|\')$//;
1.263     www      15196:             $components{&takeleft($i)}=$field;
1.31      albertel 15197:             $i++;
                   15198:         }
                   15199:     } else {
1.561     www      15200:         my $separator=',';
1.480     banghart 15201:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      15202:             $separator=';';
1.480     banghart 15203:         }
1.31      albertel 15204:         my $i=0;
1.561     www      15205: # the character we are looking for to indicate the end of a quote or a record 
                   15206:         my $looking_for=$separator;
                   15207: # do not add the characters to the fields
                   15208:         my $ignore=0;
                   15209: # we just encountered a separator (or the beginning of the record)
                   15210:         my $just_found_separator=1;
                   15211: # store the field we are working on here
                   15212:         my $field='';
                   15213: # work our way through all characters in record
                   15214:         foreach my $character ($record=~/(.)/g) {
                   15215:             if ($character eq $looking_for) {
                   15216:                if ($character ne $separator) {
                   15217: # Found the end of a quote, again looking for separator
                   15218:                   $looking_for=$separator;
                   15219:                   $ignore=1;
                   15220:                } else {
                   15221: # Found a separator, store away what we got
                   15222:                   $components{&takeleft($i)}=$field;
                   15223: 	          $i++;
                   15224:                   $just_found_separator=1;
                   15225:                   $ignore=0;
                   15226:                   $field='';
                   15227:                }
                   15228:                next;
                   15229:             }
                   15230: # single or double quotation marks after a separator indicate beginning of a quote
                   15231: # we are now looking for the end of the quote and need to ignore separators
                   15232:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   15233:                $looking_for=$character;
                   15234:                next;
                   15235:             }
                   15236: # ignore would be true after we reached the end of a quote
                   15237:             if ($ignore) { next; }
                   15238:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   15239:             $field.=$character;
                   15240:             $just_found_separator=0; 
1.31      albertel 15241:         }
1.561     www      15242: # catch the very last entry, since we never encountered the separator
                   15243:         $components{&takeleft($i)}=$field;
1.31      albertel 15244:     }
                   15245:     return %components;
                   15246: }
                   15247: 
1.144     matthew  15248: ######################################################
                   15249: ######################################################
                   15250: 
1.56      matthew  15251: =pod
                   15252: 
1.648     raeburn  15253: =item * &upfile_select_html()
1.41      ng       15254: 
1.144     matthew  15255: Return HTML code to select a file from the users machine and specify 
                   15256: the file type.
1.41      ng       15257: 
                   15258: =cut
                   15259: 
1.144     matthew  15260: ######################################################
                   15261: ######################################################
1.31      albertel 15262: sub upfile_select_html {
1.144     matthew  15263:     my %Types = (
                   15264:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 15265:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  15266:                  space => &mt('Space separated'),
                   15267:                  tab   => &mt('Tabulator separated'),
                   15268: #                 xml   => &mt('HTML/XML'),
                   15269:                  );
                   15270:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  15271:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  15272:     foreach my $type (sort(keys(%Types))) {
                   15273:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   15274:     }
                   15275:     $Str .= "</select>\n";
                   15276:     return $Str;
1.31      albertel 15277: }
                   15278: 
1.301     albertel 15279: sub get_samples {
                   15280:     my ($records,$toget) = @_;
                   15281:     my @samples=({});
                   15282:     my $got=0;
                   15283:     foreach my $rec (@$records) {
                   15284: 	my %temp = &record_sep($rec);
                   15285: 	if (! grep(/\S/, values(%temp))) { next; }
                   15286: 	if (%temp) {
                   15287: 	    $samples[$got]=\%temp;
                   15288: 	    $got++;
                   15289: 	    if ($got == $toget) { last; }
                   15290: 	}
                   15291:     }
                   15292:     return \@samples;
                   15293: }
                   15294: 
1.144     matthew  15295: ######################################################
                   15296: ######################################################
                   15297: 
1.56      matthew  15298: =pod
                   15299: 
1.648     raeburn  15300: =item * &csv_print_samples($r,$records)
1.41      ng       15301: 
                   15302: Prints a table of sample values from each column uploaded $r is an
                   15303: Apache Request ref, $records is an arrayref from
                   15304: &Apache::loncommon::upfile_record_sep
                   15305: 
                   15306: =cut
                   15307: 
1.144     matthew  15308: ######################################################
                   15309: ######################################################
1.31      albertel 15310: sub csv_print_samples {
                   15311:     my ($r,$records) = @_;
1.662     bisitz   15312:     my $samples = &get_samples($records,5);
1.301     albertel 15313: 
1.594     raeburn  15314:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   15315:               &start_data_table_header_row());
1.356     albertel 15316:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   15317:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  15318:     $r->print(&end_data_table_header_row());
1.301     albertel 15319:     foreach my $hash (@$samples) {
1.594     raeburn  15320: 	$r->print(&start_data_table_row());
1.356     albertel 15321: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 15322: 	    $r->print('<td>');
1.356     albertel 15323: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 15324: 	    $r->print('</td>');
                   15325: 	}
1.594     raeburn  15326: 	$r->print(&end_data_table_row());
1.31      albertel 15327:     }
1.594     raeburn  15328:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 15329: }
                   15330: 
1.144     matthew  15331: ######################################################
                   15332: ######################################################
                   15333: 
1.56      matthew  15334: =pod
                   15335: 
1.648     raeburn  15336: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       15337: 
                   15338: Prints a table to create associations between values and table columns.
1.144     matthew  15339: 
1.41      ng       15340: $r is an Apache Request ref,
                   15341: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  15342: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       15343: 
                   15344: =cut
                   15345: 
1.144     matthew  15346: ######################################################
                   15347: ######################################################
1.31      albertel 15348: sub csv_print_select_table {
                   15349:     my ($r,$records,$d) = @_;
1.301     albertel 15350:     my $i=0;
                   15351:     my $samples = &get_samples($records,1);
1.144     matthew  15352:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  15353: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  15354:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  15355:               '<th>'.&mt('Column').'</th>'.
                   15356:               &end_data_table_header_row()."\n");
1.356     albertel 15357:     foreach my $array_ref (@$d) {
                   15358: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  15359: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 15360: 
1.875     bisitz   15361: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  15362: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 15363: 	$r->print('<option value="none"></option>');
1.356     albertel 15364: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   15365: 	    $r->print('<option value="'.$sample.'"'.
                   15366:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   15367:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 15368: 	}
1.594     raeburn  15369: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 15370: 	$i++;
                   15371:     }
1.594     raeburn  15372:     $r->print(&end_data_table());
1.31      albertel 15373:     $i--;
                   15374:     return $i;
                   15375: }
1.56      matthew  15376: 
1.144     matthew  15377: ######################################################
                   15378: ######################################################
                   15379: 
1.56      matthew  15380: =pod
1.31      albertel 15381: 
1.648     raeburn  15382: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       15383: 
                   15384: Prints a table of sample values from the upload and can make associate samples to internal names.
                   15385: 
                   15386: $r is an Apache Request ref,
                   15387: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   15388: $d is an array of 2 element arrays (internal name, displayed name)
                   15389: 
                   15390: =cut
                   15391: 
1.144     matthew  15392: ######################################################
                   15393: ######################################################
1.31      albertel 15394: sub csv_samples_select_table {
                   15395:     my ($r,$records,$d) = @_;
                   15396:     my $i=0;
1.144     matthew  15397:     #
1.662     bisitz   15398:     my $max_samples = 5;
                   15399:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  15400:     $r->print(&start_data_table().
                   15401:               &start_data_table_header_row().'<th>'.
                   15402:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   15403:               &end_data_table_header_row());
1.301     albertel 15404: 
                   15405:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  15406: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  15407: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 15408: 	foreach my $option (@$d) {
                   15409: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  15410: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 15411:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  15412:                       $display.'</option>');
1.31      albertel 15413: 	}
                   15414: 	$r->print('</select></td><td>');
1.662     bisitz   15415: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 15416: 	    if (defined($samples->[$line]{$key})) { 
                   15417: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   15418: 	    }
                   15419: 	}
1.594     raeburn  15420: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 15421: 	$i++;
                   15422:     }
1.594     raeburn  15423:     $r->print(&end_data_table());
1.31      albertel 15424:     $i--;
                   15425:     return($i);
1.115     matthew  15426: }
                   15427: 
1.144     matthew  15428: ######################################################
                   15429: ######################################################
                   15430: 
1.115     matthew  15431: =pod
                   15432: 
1.648     raeburn  15433: =item * &clean_excel_name($name)
1.115     matthew  15434: 
                   15435: Returns a replacement for $name which does not contain any illegal characters.
                   15436: 
                   15437: =cut
                   15438: 
1.144     matthew  15439: ######################################################
                   15440: ######################################################
1.115     matthew  15441: sub clean_excel_name {
                   15442:     my ($name) = @_;
                   15443:     $name =~ s/[:\*\?\/\\]//g;
                   15444:     if (length($name) > 31) {
                   15445:         $name = substr($name,0,31);
                   15446:     }
                   15447:     return $name;
1.25      albertel 15448: }
1.84      albertel 15449: 
1.85      albertel 15450: =pod
                   15451: 
1.648     raeburn  15452: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 15453: 
                   15454: Returns either 1 or undef
                   15455: 
                   15456: 1 if the part is to be hidden, undef if it is to be shown
                   15457: 
                   15458: Arguments are:
                   15459: 
                   15460: $id the id of the part to be checked
                   15461: $symb, optional the symb of the resource to check
                   15462: $udom, optional the domain of the user to check for
                   15463: $uname, optional the username of the user to check for
                   15464: 
                   15465: =cut
1.84      albertel 15466: 
                   15467: sub check_if_partid_hidden {
                   15468:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 15469:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 15470: 					 $symb,$udom,$uname);
1.141     albertel 15471:     my $truth=1;
                   15472:     #if the string starts with !, then the list is the list to show not hide
                   15473:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 15474:     my @hiddenlist=split(/,/,$hiddenparts);
                   15475:     foreach my $checkid (@hiddenlist) {
1.141     albertel 15476: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 15477:     }
1.141     albertel 15478:     return !$truth;
1.84      albertel 15479: }
1.127     matthew  15480: 
1.138     matthew  15481: 
                   15482: ############################################################
                   15483: ############################################################
                   15484: 
                   15485: =pod
                   15486: 
1.157     matthew  15487: =back 
                   15488: 
1.138     matthew  15489: =head1 cgi-bin script and graphing routines
                   15490: 
1.157     matthew  15491: =over 4
                   15492: 
1.648     raeburn  15493: =item * &get_cgi_id()
1.138     matthew  15494: 
                   15495: Inputs: none
                   15496: 
                   15497: Returns an id which can be used to pass environment variables
                   15498: to various cgi-bin scripts.  These environment variables will
                   15499: be removed from the users environment after a given time by
                   15500: the routine &Apache::lonnet::transfer_profile_to_env.
                   15501: 
                   15502: =cut
                   15503: 
                   15504: ############################################################
                   15505: ############################################################
1.152     albertel 15506: my $uniq=0;
1.136     matthew  15507: sub get_cgi_id {
1.154     albertel 15508:     $uniq=($uniq+1)%100000;
1.280     albertel 15509:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  15510: }
                   15511: 
1.127     matthew  15512: ############################################################
                   15513: ############################################################
                   15514: 
                   15515: =pod
                   15516: 
1.648     raeburn  15517: =item * &DrawBarGraph()
1.127     matthew  15518: 
1.138     matthew  15519: Facilitates the plotting of data in a (stacked) bar graph.
                   15520: Puts plot definition data into the users environment in order for 
                   15521: graph.png to plot it.  Returns an <img> tag for the plot.
                   15522: The bars on the plot are labeled '1','2',...,'n'.
                   15523: 
                   15524: Inputs:
                   15525: 
                   15526: =over 4
                   15527: 
                   15528: =item $Title: string, the title of the plot
                   15529: 
                   15530: =item $xlabel: string, text describing the X-axis of the plot
                   15531: 
                   15532: =item $ylabel: string, text describing the Y-axis of the plot
                   15533: 
                   15534: =item $Max: scalar, the maximum Y value to use in the plot
                   15535: If $Max is < any data point, the graph will not be rendered.
                   15536: 
1.140     matthew  15537: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  15538: they are plotted.  If undefined, default values will be used.
                   15539: 
1.178     matthew  15540: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   15541: 
1.138     matthew  15542: =item @Values: An array of array references.  Each array reference holds data
                   15543: to be plotted in a stacked bar chart.
                   15544: 
1.239     matthew  15545: =item If the final element of @Values is a hash reference the key/value
                   15546: pairs will be added to the graph definition.
                   15547: 
1.138     matthew  15548: =back
                   15549: 
                   15550: Returns:
                   15551: 
                   15552: An <img> tag which references graph.png and the appropriate identifying
                   15553: information for the plot.
                   15554: 
1.127     matthew  15555: =cut
                   15556: 
                   15557: ############################################################
                   15558: ############################################################
1.134     matthew  15559: sub DrawBarGraph {
1.178     matthew  15560:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  15561:     #
                   15562:     if (! defined($colors)) {
                   15563:         $colors = ['#33ff00', 
                   15564:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   15565:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   15566:                   ]; 
                   15567:     }
1.228     matthew  15568:     my $extra_settings = {};
                   15569:     if (ref($Values[-1]) eq 'HASH') {
                   15570:         $extra_settings = pop(@Values);
                   15571:     }
1.127     matthew  15572:     #
1.136     matthew  15573:     my $identifier = &get_cgi_id();
                   15574:     my $id = 'cgi.'.$identifier;        
1.129     matthew  15575:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  15576:         return '';
                   15577:     }
1.225     matthew  15578:     #
                   15579:     my @Labels;
                   15580:     if (defined($labels)) {
                   15581:         @Labels = @$labels;
                   15582:     } else {
                   15583:         for (my $i=0;$i<@{$Values[0]};$i++) {
1.1263    raeburn  15584:             push(@Labels,$i+1);
1.225     matthew  15585:         }
                   15586:     }
                   15587:     #
1.129     matthew  15588:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  15589:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  15590:     my %ValuesHash;
                   15591:     my $NumSets=1;
                   15592:     foreach my $array (@Values) {
                   15593:         next if (! ref($array));
1.136     matthew  15594:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  15595:             join(',',@$array);
1.129     matthew  15596:     }
1.127     matthew  15597:     #
1.136     matthew  15598:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  15599:     if ($NumBars < 3) {
                   15600:         $width = 120+$NumBars*32;
1.220     matthew  15601:         $xskip = 1;
1.225     matthew  15602:         $bar_width = 30;
                   15603:     } elsif ($NumBars < 5) {
                   15604:         $width = 120+$NumBars*20;
                   15605:         $xskip = 1;
                   15606:         $bar_width = 20;
1.220     matthew  15607:     } elsif ($NumBars < 10) {
1.136     matthew  15608:         $width = 120+$NumBars*15;
                   15609:         $xskip = 1;
                   15610:         $bar_width = 15;
                   15611:     } elsif ($NumBars <= 25) {
                   15612:         $width = 120+$NumBars*11;
                   15613:         $xskip = 5;
                   15614:         $bar_width = 8;
                   15615:     } elsif ($NumBars <= 50) {
                   15616:         $width = 120+$NumBars*8;
                   15617:         $xskip = 5;
                   15618:         $bar_width = 4;
                   15619:     } else {
                   15620:         $width = 120+$NumBars*8;
                   15621:         $xskip = 5;
                   15622:         $bar_width = 4;
                   15623:     }
                   15624:     #
1.137     matthew  15625:     $Max = 1 if ($Max < 1);
                   15626:     if ( int($Max) < $Max ) {
                   15627:         $Max++;
                   15628:         $Max = int($Max);
                   15629:     }
1.127     matthew  15630:     $Title  = '' if (! defined($Title));
                   15631:     $xlabel = '' if (! defined($xlabel));
                   15632:     $ylabel = '' if (! defined($ylabel));
1.369     www      15633:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   15634:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   15635:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  15636:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  15637:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   15638:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   15639:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   15640:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   15641:     $ValuesHash{$id.'.height'}   = $height;
                   15642:     $ValuesHash{$id.'.width'}    = $width;
                   15643:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   15644:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   15645:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  15646:     #
1.228     matthew  15647:     # Deal with other parameters
                   15648:     while (my ($key,$value) = each(%$extra_settings)) {
                   15649:         $ValuesHash{$id.'.'.$key} = $value;
                   15650:     }
                   15651:     #
1.646     raeburn  15652:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  15653:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   15654: }
                   15655: 
                   15656: ############################################################
                   15657: ############################################################
                   15658: 
                   15659: =pod
                   15660: 
1.648     raeburn  15661: =item * &DrawXYGraph()
1.137     matthew  15662: 
1.138     matthew  15663: Facilitates the plotting of data in an XY graph.
                   15664: Puts plot definition data into the users environment in order for 
                   15665: graph.png to plot it.  Returns an <img> tag for the plot.
                   15666: 
                   15667: Inputs:
                   15668: 
                   15669: =over 4
                   15670: 
                   15671: =item $Title: string, the title of the plot
                   15672: 
                   15673: =item $xlabel: string, text describing the X-axis of the plot
                   15674: 
                   15675: =item $ylabel: string, text describing the Y-axis of the plot
                   15676: 
                   15677: =item $Max: scalar, the maximum Y value to use in the plot
                   15678: If $Max is < any data point, the graph will not be rendered.
                   15679: 
                   15680: =item $colors: Array ref containing the hex color codes for the data to be 
                   15681: plotted in.  If undefined, default values will be used.
                   15682: 
                   15683: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   15684: 
                   15685: =item $Ydata: Array ref containing Array refs.  
1.185     www      15686: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  15687: 
                   15688: =item %Values: hash indicating or overriding any default values which are 
                   15689: passed to graph.png.  
                   15690: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   15691: 
                   15692: =back
                   15693: 
                   15694: Returns:
                   15695: 
                   15696: An <img> tag which references graph.png and the appropriate identifying
                   15697: information for the plot.
                   15698: 
1.137     matthew  15699: =cut
                   15700: 
                   15701: ############################################################
                   15702: ############################################################
                   15703: sub DrawXYGraph {
                   15704:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   15705:     #
                   15706:     # Create the identifier for the graph
                   15707:     my $identifier = &get_cgi_id();
                   15708:     my $id = 'cgi.'.$identifier;
                   15709:     #
                   15710:     $Title  = '' if (! defined($Title));
                   15711:     $xlabel = '' if (! defined($xlabel));
                   15712:     $ylabel = '' if (! defined($ylabel));
                   15713:     my %ValuesHash = 
                   15714:         (
1.369     www      15715:          $id.'.title'  => &escape($Title),
                   15716:          $id.'.xlabel' => &escape($xlabel),
                   15717:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  15718:          $id.'.y_max_value'=> $Max,
                   15719:          $id.'.labels'     => join(',',@$Xlabels),
                   15720:          $id.'.PlotType'   => 'XY',
                   15721:          );
                   15722:     #
                   15723:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   15724:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   15725:     }
                   15726:     #
                   15727:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   15728:         return '';
                   15729:     }
                   15730:     my $NumSets=1;
1.138     matthew  15731:     foreach my $array (@{$Ydata}){
1.137     matthew  15732:         next if (! ref($array));
                   15733:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   15734:     }
1.138     matthew  15735:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  15736:     #
                   15737:     # Deal with other parameters
                   15738:     while (my ($key,$value) = each(%Values)) {
                   15739:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  15740:     }
                   15741:     #
1.646     raeburn  15742:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  15743:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   15744: }
                   15745: 
                   15746: ############################################################
                   15747: ############################################################
                   15748: 
                   15749: =pod
                   15750: 
1.648     raeburn  15751: =item * &DrawXYYGraph()
1.138     matthew  15752: 
                   15753: Facilitates the plotting of data in an XY graph with two Y axes.
                   15754: Puts plot definition data into the users environment in order for 
                   15755: graph.png to plot it.  Returns an <img> tag for the plot.
                   15756: 
                   15757: Inputs:
                   15758: 
                   15759: =over 4
                   15760: 
                   15761: =item $Title: string, the title of the plot
                   15762: 
                   15763: =item $xlabel: string, text describing the X-axis of the plot
                   15764: 
                   15765: =item $ylabel: string, text describing the Y-axis of the plot
                   15766: 
                   15767: =item $colors: Array ref containing the hex color codes for the data to be 
                   15768: plotted in.  If undefined, default values will be used.
                   15769: 
                   15770: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   15771: 
                   15772: =item $Ydata1: The first data set
                   15773: 
                   15774: =item $Min1: The minimum value of the left Y-axis
                   15775: 
                   15776: =item $Max1: The maximum value of the left Y-axis
                   15777: 
                   15778: =item $Ydata2: The second data set
                   15779: 
                   15780: =item $Min2: The minimum value of the right Y-axis
                   15781: 
                   15782: =item $Max2: The maximum value of the left Y-axis
                   15783: 
                   15784: =item %Values: hash indicating or overriding any default values which are 
                   15785: passed to graph.png.  
                   15786: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   15787: 
                   15788: =back
                   15789: 
                   15790: Returns:
                   15791: 
                   15792: An <img> tag which references graph.png and the appropriate identifying
                   15793: information for the plot.
1.136     matthew  15794: 
                   15795: =cut
                   15796: 
                   15797: ############################################################
                   15798: ############################################################
1.137     matthew  15799: sub DrawXYYGraph {
                   15800:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   15801:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  15802:     #
                   15803:     # Create the identifier for the graph
                   15804:     my $identifier = &get_cgi_id();
                   15805:     my $id = 'cgi.'.$identifier;
                   15806:     #
                   15807:     $Title  = '' if (! defined($Title));
                   15808:     $xlabel = '' if (! defined($xlabel));
                   15809:     $ylabel = '' if (! defined($ylabel));
                   15810:     my %ValuesHash = 
                   15811:         (
1.369     www      15812:          $id.'.title'  => &escape($Title),
                   15813:          $id.'.xlabel' => &escape($xlabel),
                   15814:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  15815:          $id.'.labels' => join(',',@$Xlabels),
                   15816:          $id.'.PlotType' => 'XY',
                   15817:          $id.'.NumSets' => 2,
1.137     matthew  15818:          $id.'.two_axes' => 1,
                   15819:          $id.'.y1_max_value' => $Max1,
                   15820:          $id.'.y1_min_value' => $Min1,
                   15821:          $id.'.y2_max_value' => $Max2,
                   15822:          $id.'.y2_min_value' => $Min2,
1.136     matthew  15823:          );
                   15824:     #
1.137     matthew  15825:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   15826:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   15827:     }
                   15828:     #
                   15829:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   15830:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  15831:         return '';
                   15832:     }
                   15833:     my $NumSets=1;
1.137     matthew  15834:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  15835:         next if (! ref($array));
                   15836:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  15837:     }
                   15838:     #
                   15839:     # Deal with other parameters
                   15840:     while (my ($key,$value) = each(%Values)) {
                   15841:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  15842:     }
                   15843:     #
1.646     raeburn  15844:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 15845:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  15846: }
                   15847: 
                   15848: ############################################################
                   15849: ############################################################
                   15850: 
                   15851: =pod
                   15852: 
1.157     matthew  15853: =back 
                   15854: 
1.139     matthew  15855: =head1 Statistics helper routines?  
                   15856: 
                   15857: Bad place for them but what the hell.
                   15858: 
1.157     matthew  15859: =over 4
                   15860: 
1.648     raeburn  15861: =item * &chartlink()
1.139     matthew  15862: 
                   15863: Returns a link to the chart for a specific student.  
                   15864: 
                   15865: Inputs:
                   15866: 
                   15867: =over 4
                   15868: 
                   15869: =item $linktext: The text of the link
                   15870: 
                   15871: =item $sname: The students username
                   15872: 
                   15873: =item $sdomain: The students domain
                   15874: 
                   15875: =back
                   15876: 
1.157     matthew  15877: =back
                   15878: 
1.139     matthew  15879: =cut
                   15880: 
                   15881: ############################################################
                   15882: ############################################################
                   15883: sub chartlink {
                   15884:     my ($linktext, $sname, $sdomain) = @_;
                   15885:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      15886:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 15887:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  15888:        '">'.$linktext.'</a>';
1.153     matthew  15889: }
                   15890: 
                   15891: #######################################################
                   15892: #######################################################
                   15893: 
                   15894: =pod
                   15895: 
                   15896: =head1 Course Environment Routines
1.157     matthew  15897: 
                   15898: =over 4
1.153     matthew  15899: 
1.648     raeburn  15900: =item * &restore_course_settings()
1.153     matthew  15901: 
1.648     raeburn  15902: =item * &store_course_settings()
1.153     matthew  15903: 
                   15904: Restores/Store indicated form parameters from the course environment.
                   15905: Will not overwrite existing values of the form parameters.
                   15906: 
                   15907: Inputs: 
                   15908: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   15909: 
                   15910: a hash ref describing the data to be stored.  For example:
                   15911:    
                   15912: %Save_Parameters = ('Status' => 'scalar',
                   15913:     'chartoutputmode' => 'scalar',
                   15914:     'chartoutputdata' => 'scalar',
                   15915:     'Section' => 'array',
1.373     raeburn  15916:     'Group' => 'array',
1.153     matthew  15917:     'StudentData' => 'array',
                   15918:     'Maps' => 'array');
                   15919: 
                   15920: Returns: both routines return nothing
                   15921: 
1.631     raeburn  15922: =back
                   15923: 
1.153     matthew  15924: =cut
                   15925: 
                   15926: #######################################################
                   15927: #######################################################
                   15928: sub store_course_settings {
1.496     albertel 15929:     return &store_settings($env{'request.course.id'},@_);
                   15930: }
                   15931: 
                   15932: sub store_settings {
1.153     matthew  15933:     # save to the environment
                   15934:     # appenv the same items, just to be safe
1.300     albertel 15935:     my $udom  = $env{'user.domain'};
                   15936:     my $uname = $env{'user.name'};
1.496     albertel 15937:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  15938:     my %SaveHash;
                   15939:     my %AppHash;
                   15940:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 15941:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 15942:         my $envname = 'environment.'.$basename;
1.258     albertel 15943:         if (exists($env{'form.'.$setting})) {
1.153     matthew  15944:             # Save this value away
                   15945:             if ($type eq 'scalar' &&
1.258     albertel 15946:                 (! exists($env{$envname}) || 
                   15947:                  $env{$envname} ne $env{'form.'.$setting})) {
                   15948:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   15949:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  15950:             } elsif ($type eq 'array') {
                   15951:                 my $stored_form;
1.258     albertel 15952:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  15953:                     $stored_form = join(',',
                   15954:                                         map {
1.369     www      15955:                                             &escape($_);
1.258     albertel 15956:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  15957:                 } else {
                   15958:                     $stored_form = 
1.369     www      15959:                         &escape($env{'form.'.$setting});
1.153     matthew  15960:                 }
                   15961:                 # Determine if the array contents are the same.
1.258     albertel 15962:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  15963:                     $SaveHash{$basename} = $stored_form;
                   15964:                     $AppHash{$envname}   = $stored_form;
                   15965:                 }
                   15966:             }
                   15967:         }
                   15968:     }
                   15969:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 15970:                                           $udom,$uname);
1.153     matthew  15971:     if ($put_result !~ /^(ok|delayed)/) {
                   15972:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   15973:                                  'got error:'.$put_result);
                   15974:     }
                   15975:     # Make sure these settings stick around in this session, too
1.646     raeburn  15976:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  15977:     return;
                   15978: }
                   15979: 
                   15980: sub restore_course_settings {
1.499     albertel 15981:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 15982: }
                   15983: 
                   15984: sub restore_settings {
                   15985:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  15986:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 15987:         next if (exists($env{'form.'.$setting}));
1.496     albertel 15988:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  15989:             '.'.$setting;
1.258     albertel 15990:         if (exists($env{$envname})) {
1.153     matthew  15991:             if ($type eq 'scalar') {
1.258     albertel 15992:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  15993:             } elsif ($type eq 'array') {
1.258     albertel 15994:                 $env{'form.'.$setting} = [ 
1.153     matthew  15995:                                            map { 
1.369     www      15996:                                                &unescape($_); 
1.258     albertel 15997:                                            } split(',',$env{$envname})
1.153     matthew  15998:                                            ];
                   15999:             }
                   16000:         }
                   16001:     }
1.127     matthew  16002: }
                   16003: 
1.618     raeburn  16004: #######################################################
                   16005: #######################################################
                   16006: 
                   16007: =pod
                   16008: 
                   16009: =head1 Domain E-mail Routines  
                   16010: 
                   16011: =over 4
                   16012: 
1.648     raeburn  16013: =item * &build_recipient_list()
1.618     raeburn  16014: 
1.1144    raeburn  16015: Build recipient lists for following types of e-mail:
1.766     raeburn  16016: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144    raeburn  16017: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   16018: module change checking, student/employee ID conflict checks, as
                   16019: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   16020: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  16021: 
                   16022: Inputs:
1.619     raeburn  16023: defmail (scalar - email address of default recipient), 
1.1144    raeburn  16024: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   16025: requestsmail, updatesmail, or idconflictsmail).
                   16026: 
1.619     raeburn  16027: defdom (domain for which to retrieve configuration settings),
1.1144    raeburn  16028: 
1.619     raeburn  16029: origmail (scalar - email address of recipient from loncapa.conf, 
1.1297    raeburn  16030: i.e., predates configuration by DC via domainprefs.pm
                   16031: 
                   16032: $requname username of requester (if mailing type is helpdeskmail)
                   16033: 
                   16034: $requdom domain of requester (if mailing type is helpdeskmail)
                   16035: 
                   16036: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
                   16037: 
1.618     raeburn  16038: 
1.655     raeburn  16039: Returns: comma separated list of addresses to which to send e-mail.
                   16040: 
                   16041: =back
1.618     raeburn  16042: 
                   16043: =cut
                   16044: 
                   16045: ############################################################
                   16046: ############################################################
                   16047: sub build_recipient_list {
1.1297    raeburn  16048:     my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618     raeburn  16049:     my @recipients;
1.1270    raeburn  16050:     my ($otheremails,$lastresort,$allbcc,$addtext);
1.618     raeburn  16051:     my %domconfig =
1.1270    raeburn  16052:         &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618     raeburn  16053:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  16054:         if (exists($domconfig{'contacts'}{$mailing})) {
                   16055:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   16056:                 my @contacts = ('adminemail','supportemail');
                   16057:                 foreach my $item (@contacts) {
                   16058:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   16059:                         my $addr = $domconfig{'contacts'}{$item}; 
                   16060:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   16061:                             push(@recipients,$addr);
                   16062:                         }
1.619     raeburn  16063:                     }
1.1270    raeburn  16064:                 }
                   16065:                 $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
                   16066:                 if ($mailing eq 'helpdeskmail') {
                   16067:                     if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
                   16068:                         my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
                   16069:                         my @ok_bccs;
                   16070:                         foreach my $bcc (@bccs) {
                   16071:                             $bcc =~ s/^\s+//g;
                   16072:                             $bcc =~ s/\s+$//g;
                   16073:                             if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                   16074:                                 if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                   16075:                                     push(@ok_bccs,$bcc);
                   16076:                                 }
                   16077:                             }
                   16078:                         }
                   16079:                         if (@ok_bccs > 0) {
                   16080:                             $allbcc = join(', ',@ok_bccs);
                   16081:                         }
                   16082:                     }
                   16083:                     $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618     raeburn  16084:                 }
                   16085:             }
1.766     raeburn  16086:         } elsif ($origmail ne '') {
1.1270    raeburn  16087:             $lastresort = $origmail;
1.618     raeburn  16088:         }
1.1297    raeburn  16089:         if ($mailing eq 'helpdeskmail') {
                   16090:             if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
                   16091:                 (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
                   16092:                 my ($inststatus,$inststatus_checked);
                   16093:                 if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
                   16094:                     ($env{'user.domain'} ne 'public')) {
                   16095:                     $inststatus_checked = 1;
                   16096:                     $inststatus = $env{'environment.inststatus'};
                   16097:                 }
                   16098:                 unless ($inststatus_checked) {
                   16099:                     if (($requname ne '') && ($requdom ne '')) {
                   16100:                         if (($requname =~ /^$match_username$/) &&
                   16101:                             ($requdom =~ /^$match_domain$/) &&
                   16102:                             (&Apache::lonnet::domain($requdom))) {
                   16103:                             my $requhome = &Apache::lonnet::homeserver($requname,
                   16104:                                                                       $requdom);
                   16105:                             unless ($requhome eq 'no_host') {
                   16106:                                 my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
                   16107:                                 $inststatus = $userenv{'inststatus'};
                   16108:                                 $inststatus_checked = 1;
                   16109:                             }
                   16110:                         }
                   16111:                     }
                   16112:                 }
                   16113:                 unless ($inststatus_checked) {
                   16114:                     if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
                   16115:                         my %srch = (srchby     => 'email',
                   16116:                                     srchdomain => $defdom,
                   16117:                                     srchterm   => $reqemail,
                   16118:                                     srchtype   => 'exact');
                   16119:                         my %srch_results = &Apache::lonnet::usersearch(\%srch);
                   16120:                         foreach my $uname (keys(%srch_results)) {
                   16121:                             if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
                   16122:                                 $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
                   16123:                                 $inststatus_checked = 1;
                   16124:                                 last;
                   16125:                             }
                   16126:                         }
                   16127:                         unless ($inststatus_checked) {
                   16128:                             my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
                   16129:                             if ($dirsrchres eq 'ok') {
                   16130:                                 foreach my $uname (keys(%srch_results)) {
                   16131:                                     if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
                   16132:                                         $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
                   16133:                                         $inststatus_checked = 1;
                   16134:                                         last;
                   16135:                                     }
                   16136:                                 }
                   16137:                             }
                   16138:                         }
                   16139:                     }
                   16140:                 }
                   16141:                 if ($inststatus ne '') {
                   16142:                     foreach my $status (split(/\:/,$inststatus)) {
                   16143:                         if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
                   16144:                             my @contacts = ('adminemail','supportemail');
                   16145:                             foreach my $item (@contacts) {
                   16146:                                 if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
                   16147:                                     my $addr = $domconfig{'contacts'}{'overrides'}{$status};
                   16148:                                     if (!grep(/^\Q$addr\E$/,@recipients)) {
                   16149:                                         push(@recipients,$addr);
                   16150:                                     }
                   16151:                                 }
                   16152:                             }
                   16153:                             $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
                   16154:                             if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
                   16155:                                 my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
                   16156:                                 my @ok_bccs;
                   16157:                                 foreach my $bcc (@bccs) {
                   16158:                                     $bcc =~ s/^\s+//g;
                   16159:                                     $bcc =~ s/\s+$//g;
                   16160:                                     if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                   16161:                                         if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                   16162:                                             push(@ok_bccs,$bcc);
                   16163:                                         }
                   16164:                                     }
                   16165:                                 }
                   16166:                                 if (@ok_bccs > 0) {
                   16167:                                     $allbcc = join(', ',@ok_bccs);
                   16168:                                 }
                   16169:                             }
                   16170:                             $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
                   16171:                             last;
                   16172:                         }
                   16173:                     }
                   16174:                 }
                   16175:             }
                   16176:         }
1.619     raeburn  16177:     } elsif ($origmail ne '') {
1.1270    raeburn  16178:         $lastresort = $origmail;
                   16179:     }
1.1297    raeburn  16180:     if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1270    raeburn  16181:         unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
                   16182:             my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   16183:             my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
                   16184:             my %what = (
                   16185:                           perlvar => 1,
                   16186:                        );
                   16187:             my $primary = &Apache::lonnet::domain($defdom,'primary');
                   16188:             if ($primary) {
                   16189:                 my $gotaddr;
                   16190:                 my ($result,$returnhash) =
                   16191:                     &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
                   16192:                 if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
                   16193:                     if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
                   16194:                         $lastresort = $returnhash->{'lonSupportEMail'};
                   16195:                         $gotaddr = 1;
                   16196:                     }
                   16197:                 }
                   16198:                 unless ($gotaddr) {
                   16199:                     my $uintdom = &Apache::lonnet::internet_dom($primary);
                   16200:                     my $intdom = &Apache::lonnet::internet_dom($lonhost);
                   16201:                     unless ($uintdom eq $intdom) {
                   16202:                         my %domconfig =
                   16203:                             &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
                   16204:                         if (ref($domconfig{'contacts'}) eq 'HASH') {
                   16205:                             if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
                   16206:                                 my @contacts = ('adminemail','supportemail');
                   16207:                                 foreach my $item (@contacts) {
                   16208:                                     if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
                   16209:                                         my $addr = $domconfig{'contacts'}{$item};
                   16210:                                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   16211:                                             push(@recipients,$addr);
                   16212:                                         }
                   16213:                                     }
                   16214:                                 }
                   16215:                                 if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
                   16216:                                     $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
                   16217:                                 }
                   16218:                                 if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
                   16219:                                     my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
                   16220:                                     my @ok_bccs;
                   16221:                                     foreach my $bcc (@bccs) {
                   16222:                                         $bcc =~ s/^\s+//g;
                   16223:                                         $bcc =~ s/\s+$//g;
                   16224:                                         if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                   16225:                                             if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                   16226:                                                 push(@ok_bccs,$bcc);
                   16227:                                             }
                   16228:                                         }
                   16229:                                     }
                   16230:                                     if (@ok_bccs > 0) {
                   16231:                                         $allbcc = join(', ',@ok_bccs);
                   16232:                                     }
                   16233:                                 }
                   16234:                                 $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
                   16235:                             }
                   16236:                         }
                   16237:                     }
                   16238:                 }
                   16239:             }
                   16240:         }
1.618     raeburn  16241:     }
1.688     raeburn  16242:     if (defined($defmail)) {
                   16243:         if ($defmail ne '') {
                   16244:             push(@recipients,$defmail);
                   16245:         }
1.618     raeburn  16246:     }
                   16247:     if ($otheremails) {
1.619     raeburn  16248:         my @others;
                   16249:         if ($otheremails =~ /,/) {
                   16250:             @others = split(/,/,$otheremails);
1.618     raeburn  16251:         } else {
1.619     raeburn  16252:             push(@others,$otheremails);
                   16253:         }
                   16254:         foreach my $addr (@others) {
                   16255:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   16256:                 push(@recipients,$addr);
                   16257:             }
1.618     raeburn  16258:         }
                   16259:     }
1.1298    raeburn  16260:     if ($mailing eq 'helpdeskmail') {
1.1270    raeburn  16261:         if ((!@recipients) && ($lastresort ne '')) {
                   16262:             push(@recipients,$lastresort);
                   16263:         }
                   16264:     } elsif ($lastresort ne '') {
                   16265:         if (!grep(/^\Q$lastresort\E$/,@recipients)) {
                   16266:             push(@recipients,$lastresort);
                   16267:         }
                   16268:     }
1.1271    raeburn  16269:     my $recipientlist = join(',',@recipients);
1.1270    raeburn  16270:     if (wantarray) {
                   16271:         return ($recipientlist,$allbcc,$addtext);
                   16272:     } else {
                   16273:         return $recipientlist;
                   16274:     }
1.618     raeburn  16275: }
                   16276: 
1.127     matthew  16277: ############################################################
                   16278: ############################################################
1.154     albertel 16279: 
1.655     raeburn  16280: =pod
                   16281: 
1.1224    musolffc 16282: =over 4
                   16283: 
1.1223    musolffc 16284: =item * &mime_email()
                   16285: 
                   16286: Sends an email with a possible attachment
                   16287: 
                   16288: Inputs:
                   16289: 
                   16290: =over 4
                   16291: 
                   16292: from -              Sender's email address
                   16293: 
1.1343    raeburn  16294: replyto -           Reply-To email address
                   16295: 
1.1223    musolffc 16296: to -                Email address of recipient
                   16297: 
                   16298: subject -           Subject of email
                   16299: 
                   16300: body -              Body of email
                   16301: 
                   16302: cc_string -         Carbon copy email address
                   16303: 
                   16304: bcc -               Blind carbon copy email address
                   16305: 
                   16306: attachment_path -   Path of file to be attached
                   16307: 
                   16308: file_name -         Name of file to be attached
                   16309: 
                   16310: attachment_text -   The body of an attachment of type "TEXT"
                   16311: 
                   16312: =back
                   16313: 
                   16314: =back
                   16315: 
                   16316: =cut
                   16317: 
                   16318: ############################################################
                   16319: ############################################################
                   16320: 
                   16321: sub mime_email {
1.1343    raeburn  16322:     my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path, 
                   16323:         $file_name,$attachment_text) = @_;
                   16324:  
1.1223    musolffc 16325:     my $msg = MIME::Lite->new(
                   16326:              From    => $from,
                   16327:              To      => $to,
                   16328:              Subject => $subject,
                   16329:              Type    =>'TEXT',
                   16330:              Data    => $body,
                   16331:              );
1.1343    raeburn  16332:     if ($replyto ne '') {
                   16333:         $msg->add("Reply-To" => $replyto);
                   16334:     }
1.1223    musolffc 16335:     if ($cc_string ne '') {
                   16336:         $msg->add("Cc" => $cc_string);
                   16337:     }
                   16338:     if ($bcc ne '') {
                   16339:         $msg->add("Bcc" => $bcc);
                   16340:     }
                   16341:     $msg->attr("content-type"         => "text/plain");
                   16342:     $msg->attr("content-type.charset" => "UTF-8");
                   16343:     # Attach file if given
                   16344:     if ($attachment_path) {
                   16345:         unless ($file_name) {
                   16346:             if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
                   16347:         }
                   16348:         my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
                   16349:         $msg->attach(Type     => $type,
                   16350:                      Path     => $attachment_path,
                   16351:                      Filename => $file_name
                   16352:                      );
                   16353:     # Otherwise attach text if given
                   16354:     } elsif ($attachment_text) {
                   16355:         $msg->attach(Type => 'TEXT',
                   16356:                      Data => $attachment_text);
                   16357:     }
                   16358:     # Send it
                   16359:     $msg->send('sendmail');
                   16360: }
                   16361: 
                   16362: ############################################################
                   16363: ############################################################
                   16364: 
                   16365: =pod
                   16366: 
1.655     raeburn  16367: =head1 Course Catalog Routines
                   16368: 
                   16369: =over 4
                   16370: 
                   16371: =item * &gather_categories()
                   16372: 
                   16373: Converts category definitions - keys of categories hash stored in  
                   16374: coursecategories in configuration.db on the primary library server in a 
                   16375: domain - to an array.  Also generates javascript and idx hash used to 
                   16376: generate Domain Coordinator interface for editing Course Categories.
                   16377: 
                   16378: Inputs:
1.663     raeburn  16379: 
1.655     raeburn  16380: categories (reference to hash of category definitions).
1.663     raeburn  16381: 
1.655     raeburn  16382: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   16383:       categories and subcategories).
1.663     raeburn  16384: 
1.655     raeburn  16385: idx (reference to hash of counters used in Domain Coordinator interface for 
                   16386:       editing Course Categories).
1.663     raeburn  16387: 
1.655     raeburn  16388: jsarray (reference to array of categories used to create Javascript arrays for
                   16389:          Domain Coordinator interface for editing Course Categories).
                   16390: 
                   16391: Returns: nothing
                   16392: 
                   16393: Side effects: populates cats, idx and jsarray. 
                   16394: 
                   16395: =cut
                   16396: 
                   16397: sub gather_categories {
                   16398:     my ($categories,$cats,$idx,$jsarray) = @_;
                   16399:     my %counters;
                   16400:     my $num = 0;
                   16401:     foreach my $item (keys(%{$categories})) {
                   16402:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   16403:         if ($container eq '' && $depth == 0) {
                   16404:             $cats->[$depth][$categories->{$item}] = $cat;
                   16405:         } else {
                   16406:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   16407:         }
                   16408:         my ($escitem,$tail) = split(/:/,$item,2);
                   16409:         if ($counters{$tail} eq '') {
                   16410:             $counters{$tail} = $num;
                   16411:             $num ++;
                   16412:         }
                   16413:         if (ref($idx) eq 'HASH') {
                   16414:             $idx->{$item} = $counters{$tail};
                   16415:         }
                   16416:         if (ref($jsarray) eq 'ARRAY') {
                   16417:             push(@{$jsarray->[$counters{$tail}]},$item);
                   16418:         }
                   16419:     }
                   16420:     return;
                   16421: }
                   16422: 
                   16423: =pod
                   16424: 
                   16425: =item * &extract_categories()
                   16426: 
                   16427: Used to generate breadcrumb trails for course categories.
                   16428: 
                   16429: Inputs:
1.663     raeburn  16430: 
1.655     raeburn  16431: categories (reference to hash of category definitions).
1.663     raeburn  16432: 
1.655     raeburn  16433: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   16434:       categories and subcategories).
1.663     raeburn  16435: 
1.655     raeburn  16436: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  16437: 
1.655     raeburn  16438: allitems (reference to hash - key is category key 
                   16439:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  16440: 
1.655     raeburn  16441: idx (reference to hash of counters used in Domain Coordinator interface for
                   16442:       editing Course Categories).
1.663     raeburn  16443: 
1.655     raeburn  16444: jsarray (reference to array of categories used to create Javascript arrays for
                   16445:          Domain Coordinator interface for editing Course Categories).
                   16446: 
1.665     raeburn  16447: subcats (reference to hash of arrays containing all subcategories within each 
                   16448:          category, -recursive)
                   16449: 
1.1321    raeburn  16450: maxd (reference to hash used to hold max depth for all top-level categories).
                   16451: 
1.655     raeburn  16452: Returns: nothing
                   16453: 
                   16454: Side effects: populates trails and allitems hash references.
                   16455: 
                   16456: =cut
                   16457: 
                   16458: sub extract_categories {
1.1321    raeburn  16459:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
1.655     raeburn  16460:     if (ref($categories) eq 'HASH') {
                   16461:         &gather_categories($categories,$cats,$idx,$jsarray);
                   16462:         if (ref($cats->[0]) eq 'ARRAY') {
                   16463:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   16464:                 my $name = $cats->[0][$i];
                   16465:                 my $item = &escape($name).'::0';
                   16466:                 my $trailstr;
                   16467:                 if ($name eq 'instcode') {
                   16468:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  16469:                 } elsif ($name eq 'communities') {
                   16470:                     $trailstr = &mt('Communities');
1.1239    raeburn  16471:                 } elsif ($name eq 'placement') {
                   16472:                     $trailstr = &mt('Placement Tests');
1.655     raeburn  16473:                 } else {
                   16474:                     $trailstr = $name;
                   16475:                 }
                   16476:                 if ($allitems->{$item} eq '') {
                   16477:                     push(@{$trails},$trailstr);
                   16478:                     $allitems->{$item} = scalar(@{$trails})-1;
                   16479:                 }
                   16480:                 my @parents = ($name);
                   16481:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   16482:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   16483:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  16484:                         if (ref($subcats) eq 'HASH') {
                   16485:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   16486:                         }
1.1321    raeburn  16487:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
1.665     raeburn  16488:                     }
                   16489:                 } else {
                   16490:                     if (ref($subcats) eq 'HASH') {
                   16491:                         $subcats->{$item} = [];
1.655     raeburn  16492:                     }
1.1321    raeburn  16493:                     if (ref($maxd) eq 'HASH') {
                   16494:                         $maxd->{$name} = 1;
                   16495:                     }
1.655     raeburn  16496:                 }
                   16497:             }
                   16498:         }
                   16499:     }
                   16500:     return;
                   16501: }
                   16502: 
                   16503: =pod
                   16504: 
1.1162    raeburn  16505: =item * &recurse_categories()
1.655     raeburn  16506: 
                   16507: Recursively used to generate breadcrumb trails for course categories.
                   16508: 
                   16509: Inputs:
1.663     raeburn  16510: 
1.655     raeburn  16511: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   16512:       categories and subcategories).
1.663     raeburn  16513: 
1.655     raeburn  16514: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  16515: 
                   16516: category (current course category, for which breadcrumb trail is being generated).
                   16517: 
                   16518: trails (reference to array of breadcrumb trails for each category).
                   16519: 
1.655     raeburn  16520: allitems (reference to hash - key is category key
                   16521:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  16522: 
1.655     raeburn  16523: parents (array containing containers directories for current category, 
                   16524:          back to top level). 
                   16525: 
                   16526: Returns: nothing
                   16527: 
                   16528: Side effects: populates trails and allitems hash references
                   16529: 
                   16530: =cut
                   16531: 
                   16532: sub recurse_categories {
1.1321    raeburn  16533:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
1.655     raeburn  16534:     my $shallower = $depth - 1;
                   16535:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   16536:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   16537:             my $name = $cats->[$depth]{$category}[$k];
                   16538:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321    raeburn  16539:             my $trailstr = join(' &raquo; ',(@{$parents},$category));
1.655     raeburn  16540:             if ($allitems->{$item} eq '') {
                   16541:                 push(@{$trails},$trailstr);
                   16542:                 $allitems->{$item} = scalar(@{$trails})-1;
                   16543:             }
                   16544:             my $deeper = $depth+1;
                   16545:             push(@{$parents},$category);
1.665     raeburn  16546:             if (ref($subcats) eq 'HASH') {
                   16547:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   16548:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   16549:                     my $higher;
                   16550:                     if ($j > 0) {
                   16551:                         $higher = &escape($parents->[$j]).':'.
                   16552:                                   &escape($parents->[$j-1]).':'.$j;
                   16553:                     } else {
                   16554:                         $higher = &escape($parents->[$j]).'::'.$j;
                   16555:                     }
                   16556:                     push(@{$subcats->{$higher}},$subcat);
                   16557:                 }
                   16558:             }
                   16559:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
1.1321    raeburn  16560:                                 $subcats,$maxd);
1.655     raeburn  16561:             pop(@{$parents});
                   16562:         }
                   16563:     } else {
                   16564:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321    raeburn  16565:         my $trailstr = join(' &raquo; ',(@{$parents},$category));
1.655     raeburn  16566:         if ($allitems->{$item} eq '') {
                   16567:             push(@{$trails},$trailstr);
                   16568:             $allitems->{$item} = scalar(@{$trails})-1;
                   16569:         }
1.1321    raeburn  16570:         if (ref($maxd) eq 'HASH') {
                   16571:             if ($depth > $maxd->{$parents->[0]}) {
                   16572:                 $maxd->{$parents->[0]} = $depth;
                   16573:             }
                   16574:         }
1.655     raeburn  16575:     }
                   16576:     return;
                   16577: }
                   16578: 
1.663     raeburn  16579: =pod
                   16580: 
1.1162    raeburn  16581: =item * &assign_categories_table()
1.663     raeburn  16582: 
                   16583: Create a datatable for display of hierarchical categories in a domain,
                   16584: with checkboxes to allow a course to be categorized. 
                   16585: 
                   16586: Inputs:
                   16587: 
                   16588: cathash - reference to hash of categories defined for the domain (from
                   16589:           configuration.db)
                   16590: 
                   16591: currcat - scalar with an & separated list of categories assigned to a course. 
                   16592: 
1.919     raeburn  16593: type    - scalar contains course type (Course or Community).
                   16594: 
1.1260    raeburn  16595: disabled - scalar (optional) contains disabled="disabled" if input elements are
                   16596:            to be readonly (e.g., Domain Helpdesk role viewing course settings).
                   16597: 
1.663     raeburn  16598: Returns: $output (markup to be displayed) 
                   16599: 
                   16600: =cut
                   16601: 
                   16602: sub assign_categories_table {
1.1259    raeburn  16603:     my ($cathash,$currcat,$type,$disabled) = @_;
1.663     raeburn  16604:     my $output;
                   16605:     if (ref($cathash) eq 'HASH') {
1.1321    raeburn  16606:         my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
                   16607:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
1.663     raeburn  16608:         $maxdepth = scalar(@cats);
                   16609:         if (@cats > 0) {
                   16610:             my $itemcount = 0;
                   16611:             if (ref($cats[0]) eq 'ARRAY') {
                   16612:                 my @currcategories;
                   16613:                 if ($currcat ne '') {
                   16614:                     @currcategories = split('&',$currcat);
                   16615:                 }
1.919     raeburn  16616:                 my $table;
1.663     raeburn  16617:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   16618:                     my $parent = $cats[0][$i];
1.919     raeburn  16619:                     next if ($parent eq 'instcode');
                   16620:                     if ($type eq 'Community') {
                   16621:                         next unless ($parent eq 'communities');
1.1239    raeburn  16622:                     } elsif ($type eq 'Placement') {
                   16623:                         next unless ($parent eq 'placement');
1.919     raeburn  16624:                     } else {
1.1239    raeburn  16625:                         next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919     raeburn  16626:                     }
1.663     raeburn  16627:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   16628:                     my $item = &escape($parent).'::0';
                   16629:                     my $checked = '';
                   16630:                     if (@currcategories > 0) {
                   16631:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   16632:                             $checked = ' checked="checked"';
1.663     raeburn  16633:                         }
                   16634:                     }
1.919     raeburn  16635:                     my $parent_title = $parent;
                   16636:                     if ($parent eq 'communities') {
                   16637:                         $parent_title = &mt('Communities');
1.1239    raeburn  16638:                     } elsif ($parent eq 'placement') {
                   16639:                         $parent_title = &mt('Placement Tests');
1.919     raeburn  16640:                     }
                   16641:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   16642:                               '<input type="checkbox" name="usecategory" value="'.
1.1259    raeburn  16643:                               $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919     raeburn  16644:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  16645:                     my $depth = 1;
                   16646:                     push(@path,$parent);
1.1259    raeburn  16647:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663     raeburn  16648:                     pop(@path);
1.919     raeburn  16649:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  16650:                     $itemcount ++;
                   16651:                 }
1.919     raeburn  16652:                 if ($itemcount) {
                   16653:                     $output = &Apache::loncommon::start_data_table().
                   16654:                               $table.
                   16655:                               &Apache::loncommon::end_data_table();
                   16656:                 }
1.663     raeburn  16657:             }
                   16658:         }
                   16659:     }
                   16660:     return $output;
                   16661: }
                   16662: 
                   16663: =pod
                   16664: 
1.1162    raeburn  16665: =item * &assign_category_rows()
1.663     raeburn  16666: 
                   16667: Create a datatable row for display of nested categories in a domain,
                   16668: with checkboxes to allow a course to be categorized,called recursively.
                   16669: 
                   16670: Inputs:
                   16671: 
                   16672: itemcount - track row number for alternating colors
                   16673: 
                   16674: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   16675:       categories and subcategories.
                   16676: 
                   16677: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   16678: 
                   16679: parent - parent of current category item
                   16680: 
                   16681: path - Array containing all categories back up through the hierarchy from the
                   16682:        current category to the top level.
                   16683: 
                   16684: currcategories - reference to array of current categories assigned to the course
                   16685: 
1.1260    raeburn  16686: disabled - scalar (optional) contains disabled="disabled" if input elements are
                   16687:            to be readonly (e.g., Domain Helpdesk role viewing course settings).
                   16688: 
1.663     raeburn  16689: Returns: $output (markup to be displayed).
                   16690: 
                   16691: =cut
                   16692: 
                   16693: sub assign_category_rows {
1.1259    raeburn  16694:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663     raeburn  16695:     my ($text,$name,$item,$chgstr);
                   16696:     if (ref($cats) eq 'ARRAY') {
                   16697:         my $maxdepth = scalar(@{$cats});
                   16698:         if (ref($cats->[$depth]) eq 'HASH') {
                   16699:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   16700:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   16701:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145    raeburn  16702:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  16703:                 for (my $j=0; $j<$numchildren; $j++) {
                   16704:                     $name = $cats->[$depth]{$parent}[$j];
                   16705:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   16706:                     my $deeper = $depth+1;
                   16707:                     my $checked = '';
                   16708:                     if (ref($currcategories) eq 'ARRAY') {
                   16709:                         if (@{$currcategories} > 0) {
                   16710:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   16711:                                 $checked = ' checked="checked"';
1.663     raeburn  16712:                             }
                   16713:                         }
                   16714:                     }
1.664     raeburn  16715:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   16716:                              '<input type="checkbox" name="usecategory" value="'.
1.1259    raeburn  16717:                              $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675     raeburn  16718:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   16719:                              '</td><td>';
1.663     raeburn  16720:                     if (ref($path) eq 'ARRAY') {
                   16721:                         push(@{$path},$name);
1.1259    raeburn  16722:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663     raeburn  16723:                         pop(@{$path});
                   16724:                     }
                   16725:                     $text .= '</td></tr>';
                   16726:                 }
                   16727:                 $text .= '</table></td>';
                   16728:             }
                   16729:         }
                   16730:     }
                   16731:     return $text;
                   16732: }
                   16733: 
1.1181    raeburn  16734: =pod
                   16735: 
                   16736: =back
                   16737: 
                   16738: =cut
                   16739: 
1.655     raeburn  16740: ############################################################
                   16741: ############################################################
                   16742: 
                   16743: 
1.443     albertel 16744: sub commit_customrole {
1.1408    raeburn  16745:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context,$othdomby,$requester) = @_;
1.1399    raeburn  16746:     my $result = &Apache::lonnet::assigncustomrole(
1.1408    raeburn  16747:                      $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,
                   16748:                      $context,$othdomby,$requester);
1.630     raeburn  16749:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 16750:                          ($start?', '.&mt('starting').' '.localtime($start):'').
1.1399    raeburn  16751:                          ($end?', ending '.localtime($end):'').': <b>'.$result.'</b><br />';
                   16752:     if (wantarray) {
                   16753:         return ($output,$result);
                   16754:     } else {
                   16755:         return $output;
                   16756:     }
1.443     albertel 16757: }
                   16758: 
                   16759: sub commit_standardrole {
1.1408    raeburn  16760:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits,
                   16761:         $othdomby,$requester) = @_;
1.1399    raeburn  16762:     my ($output,$logmsg,$linefeed,$result);
1.541     raeburn  16763:     if ($context eq 'auto') {
                   16764:         $linefeed = "\n";
                   16765:     } else {
                   16766:         $linefeed = "<br />\n";
                   16767:     }  
1.443     albertel 16768:     if ($three eq 'st') {
1.1399    raeburn  16769:         $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1408    raeburn  16770:                                       $one,$two,$sec,$context,$credits,$othdomby,
                   16771:                                       $requester);
1.541     raeburn  16772:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  16773:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   16774:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 16775:         } else {
1.541     raeburn  16776:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 16777:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  16778:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   16779:             if ($context eq 'auto') {
                   16780:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   16781:             } else {
                   16782:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   16783:                &mt('Add to classlist').': <b>ok</b>';
                   16784:             }
                   16785:             $output .= $linefeed;
1.443     albertel 16786:         }
                   16787:     } else {
                   16788:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   16789:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  16790:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.1408    raeburn  16791:         $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,
                   16792:                                               '','',$context,$othdomby,$requester);
1.541     raeburn  16793:         if ($context eq 'auto') {
                   16794:             $output .= $result.$linefeed;
                   16795:         } else {
                   16796:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   16797:         }
1.443     albertel 16798:     }
1.1399    raeburn  16799:     if (wantarray) {
                   16800:         return ($output,$result);
                   16801:     } else {
                   16802:         return $output;
                   16803:     }
1.443     albertel 16804: }
                   16805: 
                   16806: sub commit_studentrole {
1.1116    raeburn  16807:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
1.1408    raeburn  16808:         $credits,$othdomby,$requester) = @_;
1.626     raeburn  16809:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  16810:     if ($context eq 'auto') {
                   16811:         $linefeed = "\n";
                   16812:     } else {
                   16813:         $linefeed = '<br />'."\n";
                   16814:     }
1.443     albertel 16815:     if (defined($one) && defined($two)) {
                   16816:         my $cid=$one.'_'.$two;
                   16817:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   16818:         my $secchange = 0;
                   16819:         my $expire_role_result;
                   16820:         my $modify_section_result;
1.628     raeburn  16821:         if ($oldsec ne '-1') { 
                   16822:             if ($oldsec ne $sec) {
1.443     albertel 16823:                 $secchange = 1;
1.628     raeburn  16824:                 my $now = time;
1.443     albertel 16825:                 my $uurl='/'.$cid;
                   16826:                 $uurl=~s/\_/\//g;
                   16827:                 if ($oldsec) {
                   16828:                     $uurl.='/'.$oldsec;
                   16829:                 }
1.626     raeburn  16830:                 $oldsecurl = $uurl;
1.628     raeburn  16831:                 $expire_role_result = 
1.1408    raeburn  16832:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,
                   16833:                                                 '','','',$context,$othdomby,$requester);
                   16834:                 if ($env{'request.course.sec'} ne '') {
1.628     raeburn  16835:                     if ($expire_role_result eq 'refused') {
                   16836:                         my @roles = ('st');
                   16837:                         my @statuses = ('previous');
                   16838:                         my @roledoms = ($one);
                   16839:                         my $withsec = 1;
                   16840:                         my %roleshash = 
                   16841:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   16842:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   16843:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   16844:                             my ($oldstart,$oldend) = 
                   16845:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   16846:                             if ($oldend > 0 && $oldend <= $now) {
                   16847:                                 $expire_role_result = 'ok';
                   16848:                             }
                   16849:                         }
                   16850:                     }
                   16851:                 }
1.443     albertel 16852:                 $result = $expire_role_result;
                   16853:             }
                   16854:         }
                   16855:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116    raeburn  16856:             $modify_section_result = 
                   16857:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   16858:                                                            undef,undef,undef,$sec,
                   16859:                                                            $end,$start,'','',$cid,
1.1408    raeburn  16860:                                                            '',$context,$credits,'',
                   16861:                                                            $othdomby,$requester);
1.443     albertel 16862:             if ($modify_section_result =~ /^ok/) {
                   16863:                 if ($secchange == 1) {
1.628     raeburn  16864:                     if ($sec eq '') {
                   16865:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   16866:                     } else {
                   16867:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   16868:                     }
1.443     albertel 16869:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  16870:                     if ($sec eq '') {
                   16871:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   16872:                     } else {
                   16873:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   16874:                     }
1.443     albertel 16875:                 } else {
1.628     raeburn  16876:                     if ($sec eq '') {
                   16877:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   16878:                     } else {
                   16879:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   16880:                     }
1.443     albertel 16881:                 }
                   16882:             } else {
1.1115    raeburn  16883:                 if ($secchange) { 
1.628     raeburn  16884:                     $$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;
                   16885:                 } else {
                   16886:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   16887:                 }
1.443     albertel 16888:             }
                   16889:             $result = $modify_section_result;
                   16890:         } elsif ($secchange == 1) {
1.628     raeburn  16891:             if ($oldsec eq '') {
1.1103    raeburn  16892:                 $$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  16893:             } else {
                   16894:                 $$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;
                   16895:             }
1.626     raeburn  16896:             if ($expire_role_result eq 'refused') {
                   16897:                 my $newsecurl = '/'.$cid;
                   16898:                 $newsecurl =~ s/\_/\//g;
                   16899:                 if ($sec ne '') {
                   16900:                     $newsecurl.='/'.$sec;
                   16901:                 }
                   16902:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   16903:                     if ($sec eq '') {
                   16904:                         $$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;
                   16905:                     } else {
                   16906:                         $$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;
                   16907:                     }
                   16908:                 }
                   16909:             }
1.443     albertel 16910:         }
                   16911:     } else {
1.626     raeburn  16912:         $$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 16913:         $result = "error: incomplete course id\n";
                   16914:     }
                   16915:     return $result;
                   16916: }
                   16917: 
1.1108    raeburn  16918: sub show_role_extent {
                   16919:     my ($scope,$context,$role) = @_;
                   16920:     $scope =~ s{^/}{};
                   16921:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   16922:     push(@courseroles,'co');
                   16923:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   16924:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   16925:         $scope =~ s{/}{_};
                   16926:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   16927:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   16928:         my ($audom,$auname) = split(/\//,$scope);
                   16929:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   16930:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   16931:     } else {
                   16932:         $scope =~ s{/$}{};
                   16933:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   16934:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   16935:     }
                   16936: }
                   16937: 
1.443     albertel 16938: ############################################################
                   16939: ############################################################
                   16940: 
1.566     albertel 16941: sub check_clone {
1.578     raeburn  16942:     my ($args,$linefeed) = @_;
1.566     albertel 16943:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   16944:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   16945:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
1.1344    raeburn  16946:     my $clonetitle;
                   16947:     my @clonemsg;
1.566     albertel 16948:     my $can_clone = 0;
1.944     raeburn  16949:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  16950:     if ($lctype ne 'community') {
                   16951:         $lctype = 'course';
                   16952:     }
1.566     albertel 16953:     if ($clonehome eq 'no_host') {
1.944     raeburn  16954:         if ($args->{'crstype'} eq 'Community') {
1.1344    raeburn  16955:             push(@clonemsg,({
                   16956:                               mt => 'No new community created.',
                   16957:                               args => [],
                   16958:                             },
                   16959:                             {
                   16960:                               mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
                   16961:                               args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
                   16962:                             }));
1.908     raeburn  16963:         } else {
1.1344    raeburn  16964:             push(@clonemsg,({
                   16965:                               mt => 'No new course created.',
                   16966:                               args => [],
                   16967:                             },
                   16968:                             {
                   16969:                               mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
                   16970:                               args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
                   16971:                             }));
                   16972:         }
1.566     albertel 16973:     } else {
                   16974: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.1344    raeburn  16975:         $clonetitle = $clonedesc{'description'};
1.944     raeburn  16976:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  16977:             if ($clonedesc{'type'} ne 'Community') {
1.1344    raeburn  16978:                 push(@clonemsg,({
                   16979:                                   mt => 'No new community created.',
                   16980:                                   args => [],
                   16981:                                 },
                   16982:                                 {
                   16983:                                   mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
                   16984:                                   args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
                   16985:                                 }));
                   16986:                 return ($can_clone,\@clonemsg,$cloneid,$clonehome);
1.908     raeburn  16987:             }
                   16988:         }
1.1262    raeburn  16989: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882     raeburn  16990:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 16991: 	    $can_clone = 1;
                   16992: 	} else {
1.1221    raeburn  16993: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566     albertel 16994: 						 $args->{'clonedomain'},$args->{'clonecourse'});
1.1221    raeburn  16995:             if ($clonehash{'cloners'} eq '') {
                   16996:                 my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
                   16997:                 if ($domdefs{'canclone'}) {
                   16998:                     unless ($domdefs{'canclone'} eq 'none') {
                   16999:                         if ($domdefs{'canclone'} eq 'domain') {
                   17000:                             if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
                   17001:                                 $can_clone = 1;
                   17002:                             }
                   17003:                         } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
                   17004:                                  ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                   17005:                             if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
                   17006:                                                                           $clonehash{'internal.coursecode'},$args->{'crscode'})) {
                   17007:                                 $can_clone = 1;
                   17008:                             }
                   17009:                         }
                   17010:                     }
                   17011:                 }
1.578     raeburn  17012:             } else {
1.1221    raeburn  17013: 	        my @cloners = split(/,/,$clonehash{'cloners'});
                   17014:                 if (grep(/^\*$/,@cloners)) {
1.942     raeburn  17015:                     $can_clone = 1;
1.1221    raeburn  17016:                 } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942     raeburn  17017:                     $can_clone = 1;
1.1225    raeburn  17018:                 } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   17019:                     $can_clone = 1;
1.1221    raeburn  17020:                 }
                   17021:                 unless ($can_clone) {
1.1225    raeburn  17022:                     if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
                   17023:                         ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
1.1221    raeburn  17024:                         my (%gotdomdefaults,%gotcodedefaults);
                   17025:                         foreach my $cloner (@cloners) {
                   17026:                             if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
                   17027:                                 ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
                   17028:                                 my (%codedefaults,@code_order);
                   17029:                                 if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
                   17030:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
                   17031:                                         %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
                   17032:                                     }
                   17033:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
                   17034:                                         @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
                   17035:                                     }
                   17036:                                 } else {
                   17037:                                     &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
                   17038:                                                                             \%codedefaults,
                   17039:                                                                             \@code_order);
                   17040:                                     $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
                   17041:                                     $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
                   17042:                                 }
                   17043:                                 if (@code_order > 0) {
                   17044:                                     if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
                   17045:                                                                                 $cloner,$clonehash{'internal.coursecode'},
                   17046:                                                                                 $args->{'crscode'})) {
                   17047:                                         $can_clone = 1;
                   17048:                                         last;
                   17049:                                     }
                   17050:                                 }
                   17051:                             }
                   17052:                         }
                   17053:                     }
1.1225    raeburn  17054:                 }
                   17055:             }
                   17056:             unless ($can_clone) {
                   17057:                 my $ccrole = 'cc';
                   17058:                 if ($args->{'crstype'} eq 'Community') {
                   17059:                     $ccrole = 'co';
                   17060:                 }
                   17061: 	        my %roleshash =
                   17062: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   17063: 					          $args->{'ccdomain'},
                   17064:                                                   'userroles',['active'],[$ccrole],
                   17065: 					          [$args->{'clonedomain'}]);
                   17066: 	        if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
                   17067:                     $can_clone = 1;
                   17068:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
                   17069:                                                           $args->{'ccuname'},$args->{'ccdomain'})) {
                   17070:                     $can_clone = 1;
1.1221    raeburn  17071:                 }
                   17072:             }
                   17073:             unless ($can_clone) {
                   17074:                 if ($args->{'crstype'} eq 'Community') {
1.1344    raeburn  17075:                     push(@clonemsg,({
                   17076:                                       mt => 'No new community created.',
                   17077:                                       args => [],
                   17078:                                     },
                   17079:                                     {
                   17080:                                       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]).',
                   17081:                                       args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
                   17082:                                     }));
1.942     raeburn  17083:                 } else {
1.1344    raeburn  17084:                     push(@clonemsg,({
                   17085:                                       mt => 'No new course created.',
                   17086:                                       args => [],
                   17087:                                     },
                   17088:                                     {
                   17089:                                       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]).',
                   17090:                                       args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
                   17091:                                     }));
1.1221    raeburn  17092:                 }
1.566     albertel 17093: 	    }
1.578     raeburn  17094:         }
1.566     albertel 17095:     }
1.1344    raeburn  17096:     return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
1.566     albertel 17097: }
                   17098: 
1.444     albertel 17099: sub construct_course {
1.1262    raeburn  17100:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
1.1344    raeburn  17101:         $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
                   17102:     my ($outcome,$msgref,$clonemsgref);
1.541     raeburn  17103:     my $linefeed =  '<br />'."\n";
                   17104:     if ($context eq 'auto') {
                   17105:         $linefeed = "\n";
                   17106:     }
1.566     albertel 17107: 
                   17108: #
                   17109: # Are we cloning?
                   17110: #
1.1344    raeburn  17111:     my ($can_clone,$cloneid,$clonehome,$clonetitle);
1.566     albertel 17112:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.1344    raeburn  17113: 	($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
1.566     albertel 17114:         if (!$can_clone) {
1.1344    raeburn  17115: 	    return (0,$outcome,$clonemsgref);
1.566     albertel 17116: 	}
                   17117:     }
                   17118: 
1.444     albertel 17119: #
                   17120: # Open course
                   17121: #
1.1239    raeburn  17122:     my $showncrstype;
                   17123:     if ($args->{'crstype'} eq 'Placement') {
                   17124:         $showncrstype = 'placement test'; 
                   17125:     } else {  
                   17126:         $showncrstype = lc($args->{'crstype'});
                   17127:     }
1.444     albertel 17128:     my %cenv=();
                   17129:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   17130:                                              $args->{'cdescr'},
                   17131:                                              $args->{'curl'},
                   17132:                                              $args->{'course_home'},
                   17133:                                              $args->{'nonstandard'},
                   17134:                                              $args->{'crscode'},
                   17135:                                              $args->{'ccuname'}.':'.
                   17136:                                              $args->{'ccdomain'},
1.882     raeburn  17137:                                              $args->{'crstype'},
1.1344    raeburn  17138:                                              $cnum,$context,$category,
                   17139:                                              $callercontext);
1.444     albertel 17140: 
                   17141:     # Note: The testing routines depend on this being output; see 
                   17142:     # Utils::Course. This needs to at least be output as a comment
                   17143:     # if anyone ever decides to not show this, and Utils::Course::new
                   17144:     # will need to be suitably modified.
1.1344    raeburn  17145:     if (($callercontext eq 'auto') && ($user_lh ne '')) {
                   17146:         $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
                   17147:     } else {
                   17148:         $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
                   17149:     }
1.943     raeburn  17150:     if ($$courseid =~ /^error:/) {
1.1344    raeburn  17151:         return (0,$outcome,$clonemsgref);
1.943     raeburn  17152:     }
                   17153: 
1.444     albertel 17154: #
                   17155: # Check if created correctly
                   17156: #
1.479     albertel 17157:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 17158:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  17159:     if ($crsuhome eq 'no_host') {
1.1344    raeburn  17160:         if (($callercontext eq 'auto') && ($user_lh ne '')) {
                   17161:             $outcome .= &mt_user($user_lh,
                   17162:                             'Course creation failed, unrecognized course home server.');
                   17163:         } else {
                   17164:             $outcome .= &mt('Course creation failed, unrecognized course home server.');
                   17165:         }
                   17166:         $outcome .= $linefeed;
                   17167:         return (0,$outcome,$clonemsgref);
1.943     raeburn  17168:     }
1.541     raeburn  17169:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 17170: 
1.444     albertel 17171: #
1.566     albertel 17172: # Do the cloning
                   17173: #   
1.1344    raeburn  17174:     my @clonemsg;
1.566     albertel 17175:     if ($can_clone && $cloneid) {
1.1344    raeburn  17176:         push(@clonemsg,
                   17177:                       {
                   17178:                           mt => 'Created [_1] by cloning from [_2]',
                   17179:                           args => [$showncrstype,$clonetitle],
                   17180:                       });
1.566     albertel 17181: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 17182: # Copy all files
1.1344    raeburn  17183:         my @info =
                   17184: 	    &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
                   17185: 	                                             $args->{'dateshift'},$args->{'crscode'},
                   17186:                                                      $args->{'ccuname'}.':'.$args->{'ccdomain'},
                   17187:                                                      $args->{'tinyurls'});
                   17188:         if (@info) {
                   17189:             push(@clonemsg,@info);
                   17190:         }
1.444     albertel 17191: # Restore URL
1.566     albertel 17192: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 17193: # Restore title
1.566     albertel 17194: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  17195: # Restore creation date, creator and creation context.
                   17196:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   17197:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   17198:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 17199: # Mark as cloned
1.566     albertel 17200: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      17201: # Need to clone grading mode
                   17202:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   17203:         $cenv{'grading'}=$newenv{'grading'};
                   17204: # Do not clone these environment entries
                   17205:         &Apache::lonnet::del('environment',
                   17206:                   ['default_enrollment_start_date',
                   17207:                    'default_enrollment_end_date',
                   17208:                    'question.email',
                   17209:                    'policy.email',
                   17210:                    'comment.email',
                   17211:                    'pch.users.denied',
1.725     raeburn  17212:                    'plc.users.denied',
                   17213:                    'hidefromcat',
1.1121    raeburn  17214:                    'checkforpriv',
1.1355    raeburn  17215:                    'categories'],
1.638     www      17216:                    $$crsudom,$$crsunum);
1.1170    raeburn  17217:         if ($args->{'textbook'}) {
                   17218:             $cenv{'internal.textbook'} = $args->{'textbook'};
                   17219:         }
1.444     albertel 17220:     }
1.566     albertel 17221: 
1.444     albertel 17222: #
                   17223: # Set environment (will override cloned, if existing)
                   17224: #
                   17225:     my @sections = ();
                   17226:     my @xlists = ();
                   17227:     if ($args->{'crstype'}) {
                   17228:         $cenv{'type'}=$args->{'crstype'};
                   17229:     }
1.1371    raeburn  17230:     if ($args->{'lti'}) {
                   17231:         $cenv{'internal.lti'}=$args->{'lti'};
                   17232:     }
1.444     albertel 17233:     if ($args->{'crsid'}) {
                   17234:         $cenv{'courseid'}=$args->{'crsid'};
                   17235:     }
                   17236:     if ($args->{'crscode'}) {
                   17237:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   17238:     }
                   17239:     if ($args->{'crsquota'} ne '') {
                   17240:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   17241:     } else {
                   17242:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   17243:     }
                   17244:     if ($args->{'ccuname'}) {
                   17245:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   17246:                                         ':'.$args->{'ccdomain'};
                   17247:     } else {
                   17248:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   17249:     }
1.1116    raeburn  17250:     if ($args->{'defaultcredits'}) {
                   17251:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   17252:     }
1.444     albertel 17253:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
1.1412    raeburn  17254:     my @oklcsecs = (); # Used to accumulate LON-CAPA sections for validated institutional sections.
1.444     albertel 17255:     if ($args->{'crssections'}) {
                   17256:         $cenv{'internal.sectionnums'} = '';
                   17257:         if ($args->{'crssections'} =~ m/,/) {
                   17258:             @sections = split/,/,$args->{'crssections'};
                   17259:         } else {
                   17260:             $sections[0] = $args->{'crssections'};
                   17261:         }
                   17262:         if (@sections > 0) {
                   17263:             foreach my $item (@sections) {
                   17264:                 my ($sec,$gp) = split/:/,$item;
                   17265:                 my $class = $args->{'crscode'}.$sec;
                   17266:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   17267:                 $cenv{'internal.sectionnums'} .= $item.',';
1.1412    raeburn  17268:                 if ($addcheck eq 'ok') {
                   17269:                     unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
                   17270:                         push(@oklcsecs,$gp);
                   17271:                     }
                   17272:                 } else {
1.1263    raeburn  17273:                     push(@badclasses,$class);
1.444     albertel 17274:                 }
                   17275:             }
                   17276:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   17277:         }
                   17278:     }
                   17279: # do not hide course coordinator from staff listing, 
                   17280: # even if privileged
                   17281:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121    raeburn  17282: # add course coordinator's domain to domains to check for privileged users
                   17283: # if different to course domain
                   17284:     if ($$crsudom ne $args->{'ccdomain'}) {
                   17285:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   17286:     }
1.444     albertel 17287: # add crosslistings
                   17288:     if ($args->{'crsxlist'}) {
                   17289:         $cenv{'internal.crosslistings'}='';
                   17290:         if ($args->{'crsxlist'} =~ m/,/) {
                   17291:             @xlists = split/,/,$args->{'crsxlist'};
                   17292:         } else {
                   17293:             $xlists[0] = $args->{'crsxlist'};
                   17294:         }
                   17295:         if (@xlists > 0) {
                   17296:             foreach my $item (@xlists) {
                   17297:                 my ($xl,$gp) = split/:/,$item;
                   17298:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   17299:                 $cenv{'internal.crosslistings'} .= $item.',';
1.1412    raeburn  17300:                 if ($addcheck eq 'ok') {
                   17301:                     unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
                   17302:                         push(@oklcsecs,$gp);
                   17303:                     }
                   17304:                 } else {
1.1263    raeburn  17305:                     push(@badclasses,$xl);
1.444     albertel 17306:                 }
                   17307:             }
                   17308:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   17309:         }
                   17310:     }
                   17311:     if ($args->{'autoadds'}) {
                   17312:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   17313:     }
                   17314:     if ($args->{'autodrops'}) {
                   17315:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   17316:     }
                   17317: # check for notification of enrollment changes
                   17318:     my @notified = ();
                   17319:     if ($args->{'notify_owner'}) {
                   17320:         if ($args->{'ccuname'} ne '') {
                   17321:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   17322:         }
                   17323:     }
                   17324:     if ($args->{'notify_dc'}) {
                   17325:         if ($uname ne '') { 
1.630     raeburn  17326:             push(@notified,$uname.':'.$udom);
1.444     albertel 17327:         }
                   17328:     }
                   17329:     if (@notified > 0) {
                   17330:         my $notifylist;
                   17331:         if (@notified > 1) {
                   17332:             $notifylist = join(',',@notified);
                   17333:         } else {
                   17334:             $notifylist = $notified[0];
                   17335:         }
                   17336:         $cenv{'internal.notifylist'} = $notifylist;
                   17337:     }
                   17338:     if (@badclasses > 0) {
                   17339:         my %lt=&Apache::lonlocal::texthash(
1.1264    raeburn  17340:                 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
                   17341:                 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
                   17342:                 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444     albertel 17343:         );
1.1264    raeburn  17344:         my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
                   17345:                            &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  17346:         if ($context eq 'auto') {
                   17347:             $outcome .= $badclass_msg.$linefeed;
1.1261    raeburn  17348:         } else {
1.566     albertel 17349:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1261    raeburn  17350:         }
                   17351:         foreach my $item (@badclasses) {
1.541     raeburn  17352:             if ($context eq 'auto') {
1.1261    raeburn  17353:                 $outcome .= " - $item\n";
1.541     raeburn  17354:             } else {
1.1261    raeburn  17355:                 $outcome .= "<li>$item</li>\n";
1.541     raeburn  17356:             }
1.1261    raeburn  17357:         }
                   17358:         if ($context eq 'auto') {
                   17359:             $outcome .= $linefeed;
                   17360:         } else {
                   17361:             $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  17362:         } 
1.444     albertel 17363:     }
                   17364:     if ($args->{'no_end_date'}) {
                   17365:         $args->{'endaccess'} = 0;
                   17366:     }
1.1412    raeburn  17367: #  If an official course with institutional sections is created by cloning 
                   17368: #  an existing course, section-specific hiding of course totals in student's
                   17369: #  view of grades as copied from cloned course, will be checked for valid 
                   17370: #  sections.
                   17371:     if (($can_clone && $cloneid) &&
                   17372:         ($cenv{'internal.coursecode'} ne '') &&
                   17373:         ($cenv{'grading'} eq 'standard') &&
                   17374:         ($cenv{'hidetotals'} ne '') &&
                   17375:         ($cenv{'hidetotals'} ne 'all')) {
                   17376:         my @hidesecs;
                   17377:         my $deletehidetotals;
                   17378:         if (@oklcsecs) {
                   17379:             foreach my $sec (split(/,/,$cenv{'hidetotals'})) {
                   17380:                 if (grep(/^\Q$sec$/,@oklcsecs)) {
                   17381:                     push(@hidesecs,$sec);
                   17382:                 }
                   17383:             }
                   17384:             if (@hidesecs) {
                   17385:                 $cenv{'hidetotals'} = join(',',@hidesecs);
                   17386:             } else {
                   17387:                 $deletehidetotals = 1;
                   17388:             }
                   17389:         } else {
                   17390:             $deletehidetotals = 1;
                   17391:         }
                   17392:         if ($deletehidetotals) {
                   17393:             delete($cenv{'hidetotals'});
                   17394:             &Apache::lonnet::del('environment',['hidetotals'],$$crsudom,$$crsunum);
                   17395:         }
                   17396:     }
1.444     albertel 17397:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   17398:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   17399:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   17400:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   17401:     if ($args->{'showphotos'}) {
                   17402:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   17403:     }
                   17404:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   17405:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   17406:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   17407:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  17408:             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'); 
                   17409:             if ($context eq 'auto') {
                   17410:                 $outcome .= $krb_msg;
                   17411:             } else {
1.566     albertel 17412:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  17413:             }
                   17414:             $outcome .= $linefeed;
1.444     albertel 17415:         }
                   17416:     }
                   17417:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   17418:        if ($args->{'setpolicy'}) {
                   17419:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   17420:        }
                   17421:        if ($args->{'setcontent'}) {
                   17422:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   17423:        }
1.1251    raeburn  17424:        if ($args->{'setcomment'}) {
                   17425:            $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   17426:        }
1.444     albertel 17427:     }
                   17428:     if ($args->{'reshome'}) {
                   17429: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   17430: 	$cenv{'reshome'}=~s/\/+$/\//;
                   17431:     }
                   17432: #
                   17433: # course has keyed access
                   17434: #
                   17435:     if ($args->{'setkeys'}) {
                   17436:        $cenv{'keyaccess'}='yes';
                   17437:     }
                   17438: # if specified, key authority is not course, but user
                   17439: # only active if keyaccess is yes
                   17440:     if ($args->{'keyauth'}) {
1.487     albertel 17441: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   17442: 	$user = &LONCAPA::clean_username($user);
                   17443: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     17444: 	if ($user ne '' && $domain ne '') {
1.487     albertel 17445: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 17446: 	}
                   17447:     }
                   17448: 
1.1166    raeburn  17449: #
1.1167    raeburn  17450: #  generate and store uniquecode (available to course requester), if course should have one.
1.1166    raeburn  17451: #
                   17452:     if ($args->{'uniquecode'}) {
                   17453:         my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
                   17454:         if ($code) {
                   17455:             $cenv{'internal.uniquecode'} = $code;
1.1167    raeburn  17456:             my %crsinfo =
                   17457:                 &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
                   17458:             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   17459:                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   17460:                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
                   17461:             } 
1.1166    raeburn  17462:             if (ref($coderef)) {
                   17463:                 $$coderef = $code;
                   17464:             }
                   17465:         }
                   17466:     }
                   17467: 
1.444     albertel 17468:     if ($args->{'disresdis'}) {
                   17469:         $cenv{'pch.roles.denied'}='st';
                   17470:     }
                   17471:     if ($args->{'disablechat'}) {
                   17472:         $cenv{'plc.roles.denied'}='st';
                   17473:     }
                   17474: 
                   17475:     # Record we've not yet viewed the Course Initialization Helper for this 
                   17476:     # course
                   17477:     $cenv{'course.helper.not.run'} = 1;
                   17478:     #
                   17479:     # Use new Randomseed
                   17480:     #
                   17481:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   17482:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   17483:     #
                   17484:     # The encryption code and receipt prefix for this course
                   17485:     #
                   17486:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   17487:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   17488:     #
                   17489:     # By default, use standard grading
                   17490:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   17491: 
1.541     raeburn  17492:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   17493:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 17494: #
                   17495: # Open all assignments
                   17496: #
                   17497:     if ($args->{'openall'}) {
1.1341    raeburn  17498:        my $opendate = time;
                   17499:        if ($args->{'openallfrom'} =~ /^\d+$/) {
                   17500:            $opendate = $args->{'openallfrom'};
                   17501:        }
1.444     albertel 17502:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
1.1341    raeburn  17503:        my %storecontent = ($storeunder         => $opendate,
1.444     albertel 17504:                            $storeunder.'.type' => 'date_start');
1.1341    raeburn  17505:        $outcome .= &mt('All assignments open starting [_1]',
                   17506:                        &Apache::lonlocal::locallocaltime($opendate)).': '.
                   17507:                    &Apache::lonnet::cput
                   17508:                        ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 17509:    }
                   17510: #
                   17511: # Set first page
                   17512: #
                   17513:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   17514: 	    || ($cloneid)) {
                   17515: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 17516: 
                   17517: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   17518:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   17519: 
1.444     albertel 17520:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   17521:         my $title; my $url;
                   17522:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   17523: 	    $title=&mt('Syllabus');
1.444     albertel 17524:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   17525:         } else {
1.963     raeburn  17526:             $title=&mt('Table of Contents');
1.444     albertel 17527:             $url='/adm/navmaps';
                   17528:         }
1.445     albertel 17529: 
                   17530:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   17531: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   17532: 
                   17533: 	if ($errtext) { $fatal=2; }
1.541     raeburn  17534:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 17535:     }
1.566     albertel 17536: 
1.1237    raeburn  17537: # 
                   17538: # Set params for Placement Tests
                   17539: #
1.1239    raeburn  17540:     if ($args->{'crstype'} eq 'Placement') {
                   17541:        my %storecontent; 
                   17542:        my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
                   17543:        my %defaults = (
                   17544:                         buttonshide   => { value => 'yes',
                   17545:                                            type => 'string_yesno',},
                   17546:                         type          => { value => 'randomizetry',
                   17547:                                            type  => 'string_questiontype',},
                   17548:                         maxtries      => { value => 1,
                   17549:                                            type => 'int_pos',},
                   17550:                         problemstatus => { value => 'no',
                   17551:                                            type  => 'string_problemstatus',},
                   17552:                       );
                   17553:        foreach my $key (keys(%defaults)) {
                   17554:            $storecontent{$prefix.$key} = $defaults{$key}{'value'};
                   17555:            $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
                   17556:        }
1.1237    raeburn  17557:        &Apache::lonnet::cput
                   17558:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum); 
                   17559:     }
                   17560: 
1.1344    raeburn  17561:     return (1,$outcome,\@clonemsg);
1.444     albertel 17562: }
                   17563: 
1.1166    raeburn  17564: sub make_unique_code {
                   17565:     my ($cdom,$cnum) = @_;
                   17566:     # get lock on uniquecodes db
                   17567:     my $lockhash = {
                   17568:                       $cnum."\0".'uniquecodes' => $env{'user.name'}.
                   17569:                                                   ':'.$env{'user.domain'},
                   17570:                    };
                   17571:     my $tries = 0;
                   17572:     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   17573:     my ($code,$error);
                   17574:   
                   17575:     while (($gotlock ne 'ok') && ($tries<3)) {
                   17576:         $tries ++;
                   17577:         sleep 1;
                   17578:         $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   17579:     }
                   17580:     if ($gotlock eq 'ok') {
                   17581:         my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
                   17582:         my $gotcode;
                   17583:         my $attempts = 0;
                   17584:         while ((!$gotcode) && ($attempts < 100)) {
                   17585:             $code = &generate_code();
                   17586:             if (!exists($currcodes{$code})) {
                   17587:                 $gotcode = 1;
                   17588:                 unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                   17589:                     $error = 'nostore';
                   17590:                 }
                   17591:             }
                   17592:             $attempts ++;
                   17593:         }
                   17594:         my @del_lock = ($cnum."\0".'uniquecodes');
                   17595:         my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
                   17596:     } else {
                   17597:         $error = 'nolock';
                   17598:     }
                   17599:     return ($code,$error);
                   17600: }
                   17601: 
                   17602: sub generate_code {
                   17603:     my $code;
                   17604:     my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
                   17605:     for (my $i=0; $i<6; $i++) {
                   17606:         my $lettnum = int (rand 2);
                   17607:         my $item = '';
                   17608:         if ($lettnum) {
                   17609:             $item = $letts[int( rand(18) )];
                   17610:         } else {
                   17611:             $item = 1+int( rand(8) );
                   17612:         }
                   17613:         $code .= $item;
                   17614:     }
                   17615:     return $code;
                   17616: }
                   17617: 
1.444     albertel 17618: ############################################################
                   17619: ############################################################
                   17620: 
1.1237    raeburn  17621: # Community, Course and Placement Test
1.378     raeburn  17622: sub course_type {
                   17623:     my ($cid) = @_;
                   17624:     if (!defined($cid)) {
                   17625:         $cid = $env{'request.course.id'};
                   17626:     }
1.404     albertel 17627:     if (defined($env{'course.'.$cid.'.type'})) {
                   17628:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  17629:     } else {
                   17630:         return 'Course';
1.377     raeburn  17631:     }
                   17632: }
1.156     albertel 17633: 
1.406     raeburn  17634: sub group_term {
                   17635:     my $crstype = &course_type();
                   17636:     my %names = (
                   17637:                   'Course' => 'group',
1.865     raeburn  17638:                   'Community' => 'group',
1.1237    raeburn  17639:                   'Placement' => 'group',
1.406     raeburn  17640:                 );
                   17641:     return $names{$crstype};
                   17642: }
                   17643: 
1.902     raeburn  17644: sub course_types {
1.1310    raeburn  17645:     my @types = ('official','unofficial','community','textbook','placement','lti');
1.902     raeburn  17646:     my %typename = (
                   17647:                          official   => 'Official course',
                   17648:                          unofficial => 'Unofficial course',
                   17649:                          community  => 'Community',
1.1165    raeburn  17650:                          textbook   => 'Textbook course',
1.1237    raeburn  17651:                          placement  => 'Placement test',
1.1310    raeburn  17652:                          lti        => 'LTI provider',
1.902     raeburn  17653:                    );
                   17654:     return (\@types,\%typename);
                   17655: }
                   17656: 
1.156     albertel 17657: sub icon {
                   17658:     my ($file)=@_;
1.505     albertel 17659:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 17660:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 17661:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 17662:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   17663: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   17664: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   17665: 	            $curfext.".gif") {
                   17666: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   17667: 		$curfext.".gif";
                   17668: 	}
                   17669:     }
1.249     albertel 17670:     return &lonhttpdurl($iconname);
1.154     albertel 17671: } 
1.84      albertel 17672: 
1.575     albertel 17673: sub lonhttpdurl {
1.692     www      17674: #
                   17675: # Had been used for "small fry" static images on separate port 8080.
                   17676: # Modify here if lightweight http functionality desired again.
                   17677: # Currently eliminated due to increasing firewall issues.
                   17678: #
1.575     albertel 17679:     my ($url)=@_;
1.692     www      17680:     return $url;
1.215     albertel 17681: }
                   17682: 
1.213     albertel 17683: sub connection_aborted {
                   17684:     my ($r)=@_;
                   17685:     $r->print(" ");$r->rflush();
                   17686:     my $c = $r->connection;
                   17687:     return $c->aborted();
                   17688: }
                   17689: 
1.221     foxr     17690: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     17691: #    strings as 'strings'.
                   17692: sub escape_single {
1.221     foxr     17693:     my ($input) = @_;
1.223     albertel 17694:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     17695:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   17696:     return $input;
                   17697: }
1.223     albertel 17698: 
1.222     foxr     17699: #  Same as escape_single, but escape's "'s  This 
                   17700: #  can be used for  "strings"
                   17701: sub escape_double {
                   17702:     my ($input) = @_;
                   17703:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   17704:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   17705:     return $input;
                   17706: }
1.223     albertel 17707:  
1.222     foxr     17708: #   Escapes the last element of a full URL.
                   17709: sub escape_url {
                   17710:     my ($url)   = @_;
1.238     raeburn  17711:     my @urlslices = split(/\//, $url,-1);
1.369     www      17712:     my $lastitem = &escape(pop(@urlslices));
1.1203    raeburn  17713:     return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222     foxr     17714: }
1.462     albertel 17715: 
1.820     raeburn  17716: sub compare_arrays {
                   17717:     my ($arrayref1,$arrayref2) = @_;
                   17718:     my (@difference,%count);
                   17719:     @difference = ();
                   17720:     %count = ();
                   17721:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   17722:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   17723:         foreach my $element (keys(%count)) {
                   17724:             if ($count{$element} == 1) {
                   17725:                 push(@difference,$element);
                   17726:             }
                   17727:         }
                   17728:     }
                   17729:     return @difference;
                   17730: }
                   17731: 
1.1322    raeburn  17732: sub lon_status_items {
                   17733:     my %defaults = (
                   17734:                      E         => 100,
                   17735:                      W         => 4,
                   17736:                      N         => 1,
1.1324    raeburn  17737:                      U         => 5,
1.1322    raeburn  17738:                      threshold => 200,
                   17739:                      sysmail   => 2500,
                   17740:                    );
                   17741:     my %names = (
                   17742:                    E => 'Errors',
                   17743:                    W => 'Warnings',
                   17744:                    N => 'Notices',
1.1324    raeburn  17745:                    U => 'Unsent',
1.1322    raeburn  17746:                 );
                   17747:     return (\%defaults,\%names);
                   17748: }
                   17749: 
1.817     bisitz   17750: # -------------------------------------------------------- Initialize user login
1.462     albertel 17751: sub init_user_environment {
1.463     albertel 17752:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 17753:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   17754: 
                   17755:     my $public=($username eq 'public' && $domain eq 'public');
                   17756: 
1.1415    raeburn  17757:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv,
                   17758:         $coauthorenv);
1.462     albertel 17759:     my $now=time;
                   17760: 
                   17761:     if ($public) {
                   17762: 	my $max_public=100;
                   17763: 	my $oldest;
                   17764: 	my $oldest_time=0;
                   17765: 	for(my $next=1;$next<=$max_public;$next++) {
                   17766: 	    if (-e $lonids."/publicuser_$next.id") {
                   17767: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   17768: 		if ($mtime<$oldest_time || !$oldest_time) {
                   17769: 		    $oldest_time=$mtime;
                   17770: 		    $oldest=$next;
                   17771: 		}
                   17772: 	    } else {
                   17773: 		$cookie="publicuser_$next";
                   17774: 		last;
                   17775: 	    }
                   17776: 	}
                   17777: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   17778:     } else {
1.1275    raeburn  17779: 	# See if old ID present, if so, remove if this isn't a robot,
                   17780: 	# killing any existing non-robot sessions
1.463     albertel 17781: 	if (!$args->{'robot'}) {
                   17782: 	    opendir(DIR,$lonids);
                   17783: 	    while ($filename=readdir(DIR)) {
                   17784: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1320    raeburn  17785:                     if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
                   17786:                             &GDBM_READER(),0640)) {
1.1295    raeburn  17787:                         my $linkedfile;
1.1320    raeburn  17788:                         if (exists($oldenv{'user.linkedenv'})) {
                   17789:                             $linkedfile = $oldenv{'user.linkedenv'};
1.1295    raeburn  17790:                         }
1.1320    raeburn  17791:                         untie(%oldenv);
                   17792:                         if (unlink("$lonids/$filename")) {
                   17793:                             if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
                   17794:                                 if (-l "$lonids/$linkedfile.id") {
                   17795:                                     unlink("$lonids/$linkedfile.id");
                   17796:                                 }
1.1295    raeburn  17797:                             }
                   17798:                         }
                   17799:                     } else {
                   17800:                         unlink($lonids.'/'.$filename);
                   17801:                     }
1.463     albertel 17802: 		}
1.462     albertel 17803: 	    }
1.463     albertel 17804: 	    closedir(DIR);
1.1204    raeburn  17805: # If there is a undeleted lockfile for the user's paste buffer remove it.
                   17806:             my $namespace = 'nohist_courseeditor';
                   17807:             my $lockingkey = 'paste'."\0".'locked_num';
                   17808:             my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
                   17809:                                                 $domain,$username);
                   17810:             if (exists($lockhash{$lockingkey})) {
                   17811:                 my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
                   17812:                 unless ($delresult eq 'ok') {
                   17813:                     &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
                   17814:                 }
                   17815:             }
1.462     albertel 17816: 	}
                   17817: # Give them a new cookie
1.463     albertel 17818: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      17819: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 17820: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 17821:     
                   17822: # Initialize roles
                   17823: 
1.1414    raeburn  17824: 	($userroles,$firstaccenv,$timerintenv,$coauthorenv) = 
1.1062    raeburn  17825:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 17826:     }
                   17827: # ------------------------------------ Check browser type and MathML capability
                   17828: 
1.1194    raeburn  17829:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
                   17830:         $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462     albertel 17831: 
                   17832: # ------------------------------------------------------------- Get environment
                   17833: 
                   17834:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   17835:     my ($tmp) = keys(%userenv);
1.1275    raeburn  17836:     if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1.462     albertel 17837: 	undef(%userenv);
                   17838:     }
                   17839:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   17840: 	$form->{'interface'}=$userenv{'interface'};
                   17841:     }
                   17842:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   17843: 
                   17844: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   17845:     foreach my $option ('interface','localpath','localres') {
                   17846:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 17847:     }
                   17848: # --------------------------------------------------------- Write first profile
                   17849: 
                   17850:     {
1.1350    raeburn  17851:         my $ip = &Apache::lonnet::get_requestor_ip($r);
1.462     albertel 17852: 	my %initial_env = 
                   17853: 	    ("user.name"          => $username,
                   17854: 	     "user.domain"        => $domain,
                   17855: 	     "user.home"          => $authhost,
                   17856: 	     "browser.type"       => $clientbrowser,
                   17857: 	     "browser.version"    => $clientversion,
                   17858: 	     "browser.mathml"     => $clientmathml,
                   17859: 	     "browser.unicode"    => $clientunicode,
                   17860: 	     "browser.os"         => $clientos,
1.1137    raeburn  17861:              "browser.mobile"     => $clientmobile,
1.1141    raeburn  17862:              "browser.info"       => $clientinfo,
1.1194    raeburn  17863:              "browser.osversion"  => $clientosversion,
1.462     albertel 17864: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   17865: 	     "request.course.fn"  => '',
                   17866: 	     "request.course.uri" => '',
                   17867: 	     "request.course.sec" => '',
                   17868: 	     "request.role"       => 'cm',
                   17869: 	     "request.role.adv"   => $env{'user.adv'},
1.1350    raeburn  17870: 	     "request.host"       => $ip,);
1.462     albertel 17871: 
                   17872:         if ($form->{'localpath'}) {
                   17873: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   17874: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   17875:         }
                   17876: 	
                   17877: 	if ($form->{'interface'}) {
                   17878: 	    $form->{'interface'}=~s/\W//gs;
                   17879: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   17880: 	    $env{'browser.interface'}=$form->{'interface'};
                   17881: 	}
                   17882: 
1.1157    raeburn  17883:         if ($form->{'iptoken'}) {
                   17884:             my $lonhost = $r->dir_config('lonHostID');
                   17885:             $initial_env{"user.noloadbalance"} = $lonhost;
                   17886:             $env{'user.noloadbalance'} = $lonhost;
                   17887:         }
                   17888: 
1.1268    raeburn  17889:         if ($form->{'noloadbalance'}) {
                   17890:             my @hosts = &Apache::lonnet::current_machine_ids();
                   17891:             my $hosthere = $form->{'noloadbalance'};
                   17892:             if (grep(/^\Q$hosthere\E$/,@hosts)) {
                   17893:                 $initial_env{"user.noloadbalance"} = $hosthere;
                   17894:                 $env{'user.noloadbalance'} = $hosthere;
                   17895:             }
                   17896:         }
                   17897: 
1.1016    raeburn  17898:         unless ($domain eq 'public') {
1.1273    raeburn  17899:             my %is_adv = ( is_adv => $env{'user.adv'} );
                   17900:             my %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   17901: 
1.1414    raeburn  17902:             foreach my $tool ('aboutme','blog','webdav','portfolio','portaccess','timezone') {
                   17903:                 $userenv{'availabletools.'.$tool} =
1.1273    raeburn  17904:                     &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   17905:                                                       undef,\%userenv,\%domdef,\%is_adv);
                   17906:             }
1.980     raeburn  17907: 
1.1311    raeburn  17908:             foreach my $crstype ('official','unofficial','community','textbook','placement','lti') {
1.1273    raeburn  17909:                 $userenv{'canrequest.'.$crstype} =
                   17910:                     &Apache::lonnet::usertools_access($username,$domain,$crstype,
                   17911:                                                       'reload','requestcourses',
                   17912:                                                       \%userenv,\%domdef,\%is_adv);
                   17913:             }
1.724     raeburn  17914: 
1.1418    raeburn  17915:             if ((ref($userroles) eq 'HASH') && ($userroles->{'user.author'}) &&
                   17916:                 (exists($userroles->{"user.role.au./$domain/"}))) {
                   17917:                 if ($userenv{'authoreditors'}) {
                   17918:                     $userenv{'editors'} = $userenv{'authoreditors'};
                   17919:                 } elsif ($domdef{'editors'} ne '') {
                   17920:                     $userenv{'editors'} = $domdef{'editors'};
                   17921:                 } else {
                   17922:                     $userenv{'editors'} = 'edit,xml';
                   17923:                 }
                   17924:             }
                   17925: 
1.1273    raeburn  17926:             $userenv{'canrequest.author'} =
                   17927:                 &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   17928:                                                   'reload','requestauthor',
1.980     raeburn  17929:                                                   \%userenv,\%domdef,\%is_adv);
1.1273    raeburn  17930:             my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   17931:                                                  $domain,$username);
                   17932:             my $reqstatus = $reqauthor{'author_status'};
                   17933:             if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { 
                   17934:                 if (ref($reqauthor{'author'}) eq 'HASH') {
                   17935:                     $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   17936:                                                       $reqauthor{'author'}{'timestamp'};
                   17937:                 }
1.1092    raeburn  17938:             }
1.1287    raeburn  17939:             my ($types,$typename) = &course_types();
                   17940:             if (ref($types) eq 'ARRAY') {
                   17941:                 my @options = ('approval','validate','autolimit');
                   17942:                 my $optregex = join('|',@options);
                   17943:                 my (%willtrust,%trustchecked);
                   17944:                 foreach my $type (@{$types}) {
                   17945:                     my $dom_str = $env{'environment.reqcrsotherdom.'.$type};
                   17946:                     if ($dom_str ne '') {
                   17947:                         my $updatedstr = '';
                   17948:                         my @possdomains = split(',',$dom_str);
                   17949:                         foreach my $entry (@possdomains) {
                   17950:                             my ($extdom,$extopt) = split(':',$entry);
                   17951:                             unless ($trustchecked{$extdom}) {
                   17952:                                 $willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom);
                   17953:                                 $trustchecked{$extdom} = 1;
                   17954:                             }
                   17955:                             if ($willtrust{$extdom}) {
                   17956:                                 $updatedstr .= $entry.',';
                   17957:                             }
                   17958:                         }
                   17959:                         $updatedstr =~ s/,$//;
                   17960:                         if ($updatedstr) {
                   17961:                             $userenv{'reqcrsotherdom.'.$type} = $updatedstr;
                   17962:                         } else {
                   17963:                             delete($userenv{'reqcrsotherdom.'.$type});
                   17964:                         }
                   17965:                     }
                   17966:                 }
                   17967:             }
1.1092    raeburn  17968:         }
1.462     albertel 17969: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  17970: 
1.462     albertel 17971: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   17972: 		 &GDBM_WRCREAT(),0640)) {
                   17973: 	    &_add_to_env(\%disk_env,\%initial_env);
                   17974: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   17975: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  17976:             if (ref($firstaccenv) eq 'HASH') {
                   17977:                 &_add_to_env(\%disk_env,$firstaccenv);
                   17978:             }
                   17979:             if (ref($timerintenv) eq 'HASH') {
                   17980:                 &_add_to_env(\%disk_env,$timerintenv);
                   17981:             }
1.1414    raeburn  17982:             if (ref($coauthorenv) eq 'HASH') {
                   17983:                 if (keys(%{$coauthorenv})) {
                   17984:                     &_add_to_env(\%disk_env,$coauthorenv);
                   17985:                 }
                   17986:             }
1.463     albertel 17987: 	    if (ref($args->{'extra_env'})) {
                   17988: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   17989: 	    }
1.462     albertel 17990: 	    untie(%disk_env);
                   17991: 	} else {
1.705     tempelho 17992: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   17993: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 17994: 	    return 'error: '.$!;
                   17995: 	}
                   17996:     }
                   17997:     $env{'request.role'}='cm';
                   17998:     $env{'request.role.adv'}=$env{'user.adv'};
                   17999:     $env{'browser.type'}=$clientbrowser;
                   18000: 
                   18001:     return $cookie;
                   18002: 
                   18003: }
                   18004: 
                   18005: sub _add_to_env {
                   18006:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  18007:     if (ref($env_data) eq 'HASH') {
                   18008:         while (my ($key,$value) = each(%$env_data)) {
                   18009: 	    $idf->{$prefix.$key} = $value;
                   18010: 	    $env{$prefix.$key}   = $value;
                   18011:         }
1.462     albertel 18012:     }
                   18013: }
                   18014: 
1.685     tempelho 18015: # --- Get the symbolic name of a problem and the url
                   18016: sub get_symb {
                   18017:     my ($request,$silent) = @_;
1.726     raeburn  18018:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 18019:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   18020:     if ($symb eq '') {
                   18021:         if (!$silent) {
1.1071    raeburn  18022:             if (ref($request)) { 
                   18023:                 $request->print("Unable to handle ambiguous references:$url:.");
                   18024:             }
1.685     tempelho 18025:             return ();
                   18026:         }
                   18027:     }
                   18028:     &Apache::lonenc::check_decrypt(\$symb);
                   18029:     return ($symb);
                   18030: }
                   18031: 
                   18032: # --------------------------------------------------------------Get annotation
                   18033: 
                   18034: sub get_annotation {
                   18035:     my ($symb,$enc) = @_;
                   18036: 
                   18037:     my $key = $symb;
                   18038:     if (!$enc) {
                   18039:         $key =
                   18040:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   18041:     }
                   18042:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   18043:     return $annotation{$key};
                   18044: }
                   18045: 
                   18046: sub clean_symb {
1.731     raeburn  18047:     my ($symb,$delete_enc) = @_;
1.685     tempelho 18048: 
                   18049:     &Apache::lonenc::check_decrypt(\$symb);
                   18050:     my $enc = $env{'request.enc'};
1.731     raeburn  18051:     if ($delete_enc) {
1.730     raeburn  18052:         delete($env{'request.enc'});
                   18053:     }
1.685     tempelho 18054: 
                   18055:     return ($symb,$enc);
                   18056: }
1.462     albertel 18057: 
1.1181    raeburn  18058: ############################################################
                   18059: ############################################################
                   18060: 
                   18061: =pod
                   18062: 
                   18063: =head1 Routines for building display used to search for courses
                   18064: 
                   18065: 
                   18066: =over 4
                   18067: 
                   18068: =item * &build_filters()
                   18069: 
                   18070: Create markup for a table used to set filters to use when selecting
1.1182    raeburn  18071: courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
                   18072: and quotacheck.pl
                   18073: 
1.1181    raeburn  18074: 
                   18075: Inputs:
                   18076: 
                   18077: filterlist - anonymous array of fields to include as potential filters 
                   18078: 
                   18079: crstype - course type
                   18080: 
                   18081: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                   18082:               to pop-open a course selector (will contain "extra element"). 
                   18083: 
                   18084: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
                   18085: 
                   18086: filter - anonymous hash of criteria and their values
                   18087: 
                   18088: action - form action
                   18089: 
                   18090: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
                   18091: 
1.1182    raeburn  18092: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181    raeburn  18093: 
                   18094: cloneruname - username of owner of new course who wants to clone
                   18095: 
                   18096: clonerudom - domain of owner of new course who wants to clone
                   18097: 
                   18098: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community) 
                   18099: 
                   18100: codetitlesref - reference to array of titles of components in institutional codes (official courses)
                   18101: 
                   18102: codedom - domain
                   18103: 
                   18104: formname - value of form element named "form". 
                   18105: 
                   18106: fixeddom - domain, if fixed.
                   18107: 
                   18108: prevphase - value to assign to form element named "phase" when going back to the previous screen  
                   18109: 
                   18110: cnameelement - name of form element in form on opener page which will receive title of selected course 
                   18111: 
                   18112: cnumelement - name of form element in form on opener page which will receive courseID  of selected course
                   18113: 
                   18114: cdomelement - name of form element in form on opener page which will receive domain of selected course
                   18115: 
                   18116: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
                   18117: 
                   18118: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
                   18119: 
                   18120: clonewarning - warning message about missing information for intended course owner when DC creates a course
                   18121: 
1.1182    raeburn  18122: 
1.1181    raeburn  18123: Returns: $output - HTML for display of search criteria, and hidden form elements.
                   18124: 
1.1182    raeburn  18125: 
1.1181    raeburn  18126: Side Effects: None
                   18127: 
                   18128: =cut
                   18129: 
                   18130: # ---------------------------------------------- search for courses based on last activity etc.
                   18131: 
                   18132: sub build_filters {
                   18133:     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
                   18134:         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
                   18135:         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
                   18136:         $cnameelement,$cnumelement,$cdomelement,$setroles,
                   18137:         $clonetext,$clonewarning) = @_;
1.1182    raeburn  18138:     my ($list,$jscript);
1.1181    raeburn  18139:     my $onchange = 'javascript:updateFilters(this)';
                   18140:     my ($domainselectform,$sincefilterform,$createdfilterform,
                   18141:         $ownerdomselectform,$persondomselectform,$instcodeform,
                   18142:         $typeselectform,$instcodetitle);
                   18143:     if ($formname eq '') {
                   18144:         $formname = $caller;
                   18145:     }
                   18146:     foreach my $item (@{$filterlist}) {
                   18147:         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   18148:                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
                   18149:             if ($item eq 'domainfilter') {
                   18150:                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
                   18151:             } elsif ($item eq 'coursefilter') {
                   18152:                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
                   18153:             } elsif ($item eq 'ownerfilter') {
                   18154:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   18155:             } elsif ($item eq 'ownerdomfilter') {
                   18156:                 $filter->{'ownerdomfilter'} =
                   18157:                     &LONCAPA::clean_domain($filter->{$item});
                   18158:                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                   18159:                                                        'ownerdomfilter',1);
                   18160:             } elsif ($item eq 'personfilter') {
                   18161:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   18162:             } elsif ($item eq 'persondomfilter') {
                   18163:                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                   18164:                                                         'persondomfilter',1);
                   18165:             } else {
                   18166:                 $filter->{$item} =~ s/\W//g;
                   18167:             }
                   18168:             if (!$filter->{$item}) {
                   18169:                 $filter->{$item} = '';
                   18170:             }
                   18171:         }
                   18172:         if ($item eq 'domainfilter') {
                   18173:             my $allow_blank = 1;
                   18174:             if ($formname eq 'portform') {
                   18175:                 $allow_blank=0;
                   18176:             } elsif ($formname eq 'studentform') {
                   18177:                 $allow_blank=0;
                   18178:             }
                   18179:             if ($fixeddom) {
                   18180:                 $domainselectform = '<input type="hidden" name="domainfilter"'.
                   18181:                                     ' value="'.$codedom.'" />'.
                   18182:                                     &Apache::lonnet::domain($codedom,'description');
                   18183:             } else {
                   18184:                 $domainselectform = &select_dom_form($filter->{$item},
                   18185:                                                      'domainfilter',
                   18186:                                                       $allow_blank,'',$onchange);
                   18187:             }
                   18188:         } else {
                   18189:             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
                   18190:         }
                   18191:     }
                   18192: 
                   18193:     # last course activity filter and selection
                   18194:     $sincefilterform = &timebased_select_form('sincefilter',$filter);
                   18195: 
                   18196:     # course created filter and selection
                   18197:     if (exists($filter->{'createdfilter'})) {
                   18198:         $createdfilterform = &timebased_select_form('createdfilter',$filter);
                   18199:     }
                   18200: 
1.1239    raeburn  18201:     my $prefix = $crstype;
                   18202:     if ($crstype eq 'Placement') {
                   18203:         $prefix = 'Placement Test'
                   18204:     }
1.1181    raeburn  18205:     my %lt = &Apache::lonlocal::texthash(
1.1239    raeburn  18206:                 'cac' => "$prefix Activity",
                   18207:                 'ccr' => "$prefix Created",
                   18208:                 'cde' => "$prefix Title",
                   18209:                 'cdo' => "$prefix Domain",
1.1181    raeburn  18210:                 'ins' => 'Institutional Code',
                   18211:                 'inc' => 'Institutional Categorization',
1.1239    raeburn  18212:                 'cow' => "$prefix Owner/Co-owner",
                   18213:                 'cop' => "$prefix Personnel Includes",
1.1181    raeburn  18214:                 'cog' => 'Type',
                   18215:              );
                   18216: 
                   18217:     if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   18218:         my $typeval = 'Course';
                   18219:         if ($crstype eq 'Community') {
                   18220:             $typeval = 'Community';
1.1239    raeburn  18221:         } elsif ($crstype eq 'Placement') {
                   18222:             $typeval = 'Placement';
1.1181    raeburn  18223:         }
                   18224:         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
                   18225:     } else {
                   18226:         $typeselectform =  '<select name="type" size="1"';
                   18227:         if ($onchange) {
                   18228:             $typeselectform .= ' onchange="'.$onchange.'"';
                   18229:         }
                   18230:         $typeselectform .= '>'."\n";
1.1237    raeburn  18231:         foreach my $posstype ('Course','Community','Placement') {
1.1239    raeburn  18232:             my $shown;
                   18233:             if ($posstype eq 'Placement') {
                   18234:                 $shown = &mt('Placement Test');
                   18235:             } else {
                   18236:                 $shown = &mt($posstype);
                   18237:             }
1.1181    raeburn  18238:             $typeselectform.='<option value="'.$posstype.'"'.
1.1239    raeburn  18239:                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181    raeburn  18240:         }
                   18241:         $typeselectform.="</select>";
                   18242:     }
                   18243: 
                   18244:     my ($cloneableonlyform,$cloneabletitle);
                   18245:     if (exists($filter->{'cloneableonly'})) {
                   18246:         my $cloneableon = '';
                   18247:         my $cloneableoff = ' checked="checked"';
                   18248:         if ($filter->{'cloneableonly'}) {
                   18249:             $cloneableon = $cloneableoff;
                   18250:             $cloneableoff = '';
                   18251:         }
                   18252:         $cloneableonlyform = '<span class="LC_nobreak"><label><input type="radio" name="cloneableonly" value="1" '.$cloneableon.'/>&nbsp;'.&mt('Required').'</label>'.('&nbsp;'x3).'<label><input type="radio" name="cloneableonly" value="" '.$cloneableoff.' />&nbsp;'.&mt('No restriction').'</label></span>';
                   18253:         if ($formname eq 'ccrs') {
1.1187    bisitz   18254:             $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181    raeburn  18255:         } else {
                   18256:             $cloneabletitle = &mt('Cloneable by you');
                   18257:         }
                   18258:     }
                   18259:     my $officialjs;
                   18260:     if ($crstype eq 'Course') {
                   18261:         if (exists($filter->{'instcodefilter'})) {
1.1182    raeburn  18262: #            if (($fixeddom) || ($formname eq 'requestcrs') ||
                   18263: #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
                   18264:             if ($codedom) { 
1.1181    raeburn  18265:                 $officialjs = 1;
                   18266:                 ($instcodeform,$jscript,$$numtitlesref) =
                   18267:                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                   18268:                                                                   $officialjs,$codetitlesref);
                   18269:                 if ($jscript) {
1.1182    raeburn  18270:                     $jscript = '<script type="text/javascript">'."\n".
                   18271:                                '// <![CDATA['."\n".
                   18272:                                $jscript."\n".
                   18273:                                '// ]]>'."\n".
                   18274:                                '</script>'."\n";
1.1181    raeburn  18275:                 }
                   18276:             }
                   18277:             if ($instcodeform eq '') {
                   18278:                 $instcodeform =
                   18279:                     '<input type="text" name="instcodefilter" size="10" value="'.
                   18280:                     $list->{'instcodefilter'}.'" />';
                   18281:                 $instcodetitle = $lt{'ins'};
                   18282:             } else {
                   18283:                 $instcodetitle = $lt{'inc'};
                   18284:             }
                   18285:             if ($fixeddom) {
                   18286:                 $instcodetitle .= '<br />('.$codedom.')';
                   18287:             }
                   18288:         }
                   18289:     }
                   18290:     my $output = qq|
                   18291: <form method="post" name="filterpicker" action="$action">
                   18292: <input type="hidden" name="form" value="$formname" />
                   18293: |;
                   18294:     if ($formname eq 'modifycourse') {
                   18295:         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                   18296:                    '<input type="hidden" name="prevphase" value="'.
                   18297:                    $prevphase.'" />'."\n";
1.1198    musolffc 18298:     } elsif ($formname eq 'quotacheck') {
                   18299:         $output .= qq|
                   18300: <input type="hidden" name="sortby" value="" />
                   18301: <input type="hidden" name="sortorder" value="" />
                   18302: |;
                   18303:     } else {
1.1181    raeburn  18304:         my $name_input;
                   18305:         if ($cnameelement ne '') {
                   18306:             $name_input = '<input type="hidden" name="cnameelement" value="'.
                   18307:                           $cnameelement.'" />';
                   18308:         }
                   18309:         $output .= qq|
1.1182    raeburn  18310: <input type="hidden" name="cnumelement" value="$cnumelement" />
                   18311: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181    raeburn  18312: $name_input
                   18313: $roleelement
                   18314: $multelement
                   18315: $typeelement
                   18316: |;
                   18317:         if ($formname eq 'portform') {
                   18318:             $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
                   18319:         }
                   18320:     }
                   18321:     if ($fixeddom) {
                   18322:         $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
                   18323:     }
                   18324:     $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
                   18325:     if ($sincefilterform) {
                   18326:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                   18327:                   .$sincefilterform
                   18328:                   .&Apache::lonhtmlcommon::row_closure();
                   18329:     }
                   18330:     if ($createdfilterform) {
                   18331:         $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                   18332:                   .$createdfilterform
                   18333:                   .&Apache::lonhtmlcommon::row_closure();
                   18334:     }
                   18335:     if ($domainselectform) {
                   18336:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                   18337:                   .$domainselectform
                   18338:                   .&Apache::lonhtmlcommon::row_closure();
                   18339:     }
                   18340:     if ($typeselectform) {
                   18341:         if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   18342:             $output .= $typeselectform;
                   18343:         } else {
                   18344:             $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                   18345:                       .$typeselectform
                   18346:                       .&Apache::lonhtmlcommon::row_closure();
                   18347:         }
                   18348:     }
                   18349:     if ($instcodeform) {
                   18350:         $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                   18351:                   .$instcodeform
                   18352:                   .&Apache::lonhtmlcommon::row_closure();
                   18353:     }
                   18354:     if (exists($filter->{'ownerfilter'})) {
                   18355:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                   18356:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   18357:                    '<input type="text" name="ownerfilter" size="20" value="'.
                   18358:                    $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   18359:                    $ownerdomselectform.'</td></tr></table>'.
                   18360:                    &Apache::lonhtmlcommon::row_closure();
                   18361:     }
                   18362:     if (exists($filter->{'personfilter'})) {
                   18363:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                   18364:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   18365:                    '<input type="text" name="personfilter" size="20" value="'.
                   18366:                    $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   18367:                    $persondomselectform.'</td></tr></table>'.
                   18368:                    &Apache::lonhtmlcommon::row_closure();
                   18369:     }
                   18370:     if (exists($filter->{'coursefilter'})) {
                   18371:         $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                   18372:                   .'<input type="text" name="coursefilter" size="25" value="'
                   18373:                   .$list->{'coursefilter'}.'" />'
                   18374:                   .&Apache::lonhtmlcommon::row_closure();
                   18375:     }
                   18376:     if ($cloneableonlyform) {
                   18377:         $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                   18378:                    $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
                   18379:     }
                   18380:     if (exists($filter->{'descriptfilter'})) {
                   18381:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                   18382:                   .'<input type="text" name="descriptfilter" size="40" value="'
                   18383:                   .$list->{'descriptfilter'}.'" />'
                   18384:                   .&Apache::lonhtmlcommon::row_closure(1);
                   18385:     }
                   18386:     $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                   18387:                '<input type="hidden" name="updater" value="" />'."\n".
                   18388:                '<input type="submit" name="gosearch" value="'.
                   18389:                &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
                   18390:     return $jscript.$clonewarning.$output;
                   18391: }
                   18392: 
                   18393: =pod 
                   18394: 
                   18395: =item * &timebased_select_form()
                   18396: 
1.1182    raeburn  18397: Create markup for a dropdown list used to select a time-based
1.1181    raeburn  18398: filter e.g., Course Activity, Course Created, when searching for courses
                   18399: or communities
                   18400: 
                   18401: Inputs:
                   18402: 
                   18403: item - name of form element (sincefilter or createdfilter)
                   18404: 
                   18405: filter - anonymous hash of criteria and their values
                   18406: 
                   18407: Returns: HTML for a select box contained a blank, then six time selections,
                   18408:          with value set in incoming form variables currently selected. 
                   18409: 
                   18410: Side Effects: None
                   18411: 
                   18412: =cut
                   18413: 
                   18414: sub timebased_select_form {
                   18415:     my ($item,$filter) = @_;
                   18416:     if (ref($filter) eq 'HASH') {
                   18417:         $filter->{$item} =~ s/[^\d-]//g;
                   18418:         if (!$filter->{$item}) { $filter->{$item}=-1; }
                   18419:         return &select_form(
                   18420:                             $filter->{$item},
                   18421:                             $item,
                   18422:                             {      '-1' => '',
                   18423:                                 '86400' => &mt('today'),
                   18424:                                '604800' => &mt('last week'),
                   18425:                               '2592000' => &mt('last month'),
                   18426:                               '7776000' => &mt('last three months'),
                   18427:                              '15552000' => &mt('last six months'),
                   18428:                              '31104000' => &mt('last year'),
                   18429:                     'select_form_order' =>
                   18430:                            ['-1','86400','604800','2592000','7776000',
                   18431:                             '15552000','31104000']});
                   18432:     }
                   18433: }
                   18434: 
                   18435: =pod
                   18436: 
                   18437: =item * &js_changer()
                   18438: 
                   18439: Create script tag containing Javascript used to submit course search form
1.1183    raeburn  18440: when course type or domain is changed, and also to hide 'Searching ...' on
                   18441: page load completion for page showing search result.
1.1181    raeburn  18442: 
                   18443: Inputs: None
                   18444: 
1.1183    raeburn  18445: Returns: markup containing updateFilters() and hideSearching() javascript functions. 
1.1181    raeburn  18446: 
                   18447: Side Effects: None
                   18448: 
                   18449: =cut
                   18450: 
                   18451: sub js_changer {
                   18452:     return <<ENDJS;
                   18453: <script type="text/javascript">
                   18454: // <![CDATA[
                   18455: function updateFilters(caller) {
                   18456:     if (typeof(caller) != "undefined") {
                   18457:         document.filterpicker.updater.value = caller.name;
                   18458:     }
                   18459:     document.filterpicker.submit();
                   18460: }
1.1183    raeburn  18461: 
                   18462: function hideSearching() {
                   18463:     if (document.getElementById('searching')) {
                   18464:         document.getElementById('searching').style.display = 'none';
                   18465:     }
                   18466:     return;
                   18467: }
                   18468: 
1.1181    raeburn  18469: // ]]>
                   18470: </script>
                   18471: 
                   18472: ENDJS
                   18473: }
                   18474: 
                   18475: =pod
                   18476: 
1.1182    raeburn  18477: =item * &search_courses()
                   18478: 
                   18479: Process selected filters form course search form and pass to lonnet::courseiddump
                   18480: to retrieve a hash for which keys are courseIDs which match the selected filters.
                   18481: 
                   18482: Inputs:
                   18483: 
                   18484: dom - domain being searched 
                   18485: 
                   18486: type - course type ('Course' or 'Community' or '.' if any).
                   18487: 
                   18488: filter - anonymous hash of criteria and their values
                   18489: 
                   18490: numtitles - for institutional codes - number of categories
                   18491: 
                   18492: cloneruname - optional username of new course owner
                   18493: 
                   18494: clonerudom - optional domain of new course owner
                   18495: 
1.1221    raeburn  18496: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, 
1.1182    raeburn  18497:             (used when DC is using course creation form)
                   18498: 
                   18499: codetitles - reference to array of titles of components in institutional codes (official courses).
                   18500: 
1.1221    raeburn  18501: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
                   18502:            (and so can clone automatically)
                   18503: 
                   18504: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
                   18505: 
                   18506: reqinstcode - institutional code of new course, where search_courses is used to identify potential 
                   18507:               courses to clone 
1.1182    raeburn  18508: 
                   18509: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
                   18510: 
                   18511: 
                   18512: Side Effects: None
                   18513: 
                   18514: =cut
                   18515: 
                   18516: 
                   18517: sub search_courses {
1.1221    raeburn  18518:     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
                   18519:         $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182    raeburn  18520:     my (%courses,%showcourses,$cloner);
                   18521:     if (($filter->{'ownerfilter'} ne '') ||
                   18522:         ($filter->{'ownerdomfilter'} ne '')) {
                   18523:         $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                   18524:                                        $filter->{'ownerdomfilter'};
                   18525:     }
                   18526:     foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
                   18527:         if (!$filter->{$item}) {
                   18528:             $filter->{$item}='.';
                   18529:         }
                   18530:     }
                   18531:     my $now = time;
                   18532:     my $timefilter =
                   18533:        ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
                   18534:     my ($createdbefore,$createdafter);
                   18535:     if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
                   18536:         $createdbefore = $now;
                   18537:         $createdafter = $now-$filter->{'createdfilter'};
                   18538:     }
                   18539:     my ($instcodefilter,$regexpok);
                   18540:     if ($numtitles) {
                   18541:         if ($env{'form.official'} eq 'on') {
                   18542:             $instcodefilter =
                   18543:                 &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   18544:             $regexpok = 1;
                   18545:         } elsif ($env{'form.official'} eq 'off') {
                   18546:             $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   18547:             unless ($instcodefilter eq '') {
                   18548:                 $regexpok = -1;
                   18549:             }
                   18550:         }
                   18551:     } else {
                   18552:         $instcodefilter = $filter->{'instcodefilter'};
                   18553:     }
                   18554:     if ($instcodefilter eq '') { $instcodefilter = '.'; }
                   18555:     if ($type eq '') { $type = '.'; }
                   18556: 
                   18557:     if (($clonerudom ne '') && ($cloneruname ne '')) {
                   18558:         $cloner = $cloneruname.':'.$clonerudom;
                   18559:     }
                   18560:     %courses = &Apache::lonnet::courseiddump($dom,
                   18561:                                              $filter->{'descriptfilter'},
                   18562:                                              $timefilter,
                   18563:                                              $instcodefilter,
                   18564:                                              $filter->{'combownerfilter'},
                   18565:                                              $filter->{'coursefilter'},
                   18566:                                              undef,undef,$type,$regexpok,undef,undef,
1.1221    raeburn  18567:                                              undef,undef,$cloner,$cc_clone,
1.1182    raeburn  18568:                                              $filter->{'cloneableonly'},
                   18569:                                              $createdbefore,$createdafter,undef,
1.1221    raeburn  18570:                                              $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182    raeburn  18571:     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
                   18572:         my $ccrole;
                   18573:         if ($type eq 'Community') {
                   18574:             $ccrole = 'co';
                   18575:         } else {
                   18576:             $ccrole = 'cc';
                   18577:         }
                   18578:         my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                   18579:                                                      $filter->{'persondomfilter'},
                   18580:                                                      'userroles',undef,
                   18581:                                                      [$ccrole,'in','ad','ep','ta','cr'],
                   18582:                                                      $dom);
                   18583:         foreach my $role (keys(%rolehash)) {
                   18584:             my ($cnum,$cdom,$courserole) = split(':',$role);
                   18585:             my $cid = $cdom.'_'.$cnum;
                   18586:             if (exists($courses{$cid})) {
                   18587:                 if (ref($courses{$cid}) eq 'HASH') {
                   18588:                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                   18589:                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1263    raeburn  18590:                             push(@{$courses{$cid}{roles}},$courserole);
1.1182    raeburn  18591:                         }
                   18592:                     } else {
                   18593:                         $courses{$cid}{roles} = [$courserole];
                   18594:                     }
                   18595:                     $showcourses{$cid} = $courses{$cid};
                   18596:                 }
                   18597:             }
                   18598:         }
                   18599:         %courses = %showcourses;
                   18600:     }
                   18601:     return %courses;
                   18602: }
                   18603: 
                   18604: =pod
                   18605: 
1.1181    raeburn  18606: =back
                   18607: 
1.1207    raeburn  18608: =head1 Routines for version requirements for current course.
                   18609: 
                   18610: =over 4
                   18611: 
                   18612: =item * &check_release_required()
                   18613: 
                   18614: Compares required LON-CAPA version with version on server, and
                   18615: if required version is newer looks for a server with the required version.
                   18616: 
                   18617: Looks first at servers in user's owen domain; if none suitable, looks at
                   18618: servers in course's domain are permitted to host sessions for user's domain.
                   18619: 
                   18620: Inputs:
                   18621: 
                   18622: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   18623: 
                   18624: $courseid - Course ID of current course
                   18625: 
                   18626: $rolecode - User's current role in course (for switchserver query string).
                   18627: 
                   18628: $required - LON-CAPA version needed by course (format: Major.Minor).
                   18629: 
                   18630: 
                   18631: Returns:
                   18632: 
                   18633: $switchserver - query string tp append to /adm/switchserver call (if 
                   18634:                 current server's LON-CAPA version is too old. 
                   18635: 
                   18636: $warning - Message is displayed if no suitable server could be found.
                   18637: 
                   18638: =cut
                   18639: 
                   18640: sub check_release_required {
                   18641:     my ($loncaparev,$courseid,$rolecode,$required) = @_;
                   18642:     my ($switchserver,$warning);
                   18643:     if ($required ne '') {
                   18644:         my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
                   18645:         my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   18646:         if ($reqdmajor ne '' && $reqdminor ne '') {
                   18647:             my $otherserver;
                   18648:             if (($major eq '' && $minor eq '') ||
                   18649:                 (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
                   18650:                 my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
                   18651:                 my $switchlcrev =
                   18652:                     &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
                   18653:                                                            $userdomserver);
                   18654:                 my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   18655:                 if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
                   18656:                     (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
                   18657:                     my $cdom = $env{'course.'.$courseid.'.domain'};
                   18658:                     if ($cdom ne $env{'user.domain'}) {
                   18659:                         my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
                   18660:                         my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
                   18661:                         my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   18662:                         my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
                   18663:                         my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
                   18664:                         my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
                   18665:                         my $canhost =
                   18666:                             &Apache::lonnet::can_host_session($env{'user.domain'},
                   18667:                                                               $coursedomserver,
                   18668:                                                               $remoterev,
                   18669:                                                               $udomdefaults{'remotesessions'},
                   18670:                                                               $defdomdefaults{'hostedsessions'});
                   18671: 
                   18672:                         if ($canhost) {
                   18673:                             $otherserver = $coursedomserver;
                   18674:                         } else {
                   18675:                             $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.");
                   18676:                         }
                   18677:                     } else {
                   18678:                         $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).");
                   18679:                     }
                   18680:                 } else {
                   18681:                     $otherserver = $userdomserver;
                   18682:                 }
                   18683:             }
                   18684:             if ($otherserver ne '') {
                   18685:                 $switchserver = 'otherserver='.$otherserver.'&amp;role='.$rolecode;
                   18686:             }
                   18687:         }
                   18688:     }
                   18689:     return ($switchserver,$warning);
                   18690: }
                   18691: 
                   18692: =pod
                   18693: 
                   18694: =item * &check_release_result()
                   18695: 
                   18696: Inputs:
                   18697: 
                   18698: $switchwarning - Warning message if no suitable server found to host session.
                   18699: 
                   18700: $switchserver - query string to append to /adm/switchserver containing lonHostID
                   18701:                 and current role.
                   18702: 
                   18703: Returns: HTML to display with information about requirement to switch server.
                   18704:          Either displaying warning with link to Roles/Courses screen or
                   18705:          display link to switchserver.
                   18706: 
1.1181    raeburn  18707: =cut
                   18708: 
1.1207    raeburn  18709: sub check_release_result {
                   18710:     my ($switchwarning,$switchserver) = @_;
                   18711:     my $output = &start_page('Selected course unavailable on this server').
                   18712:                  '<p class="LC_warning">';
                   18713:     if ($switchwarning) {
                   18714:         $output .= $switchwarning.'<br /><a href="/adm/roles">';
                   18715:         if (&show_course()) {
                   18716:             $output .= &mt('Display courses');
                   18717:         } else {
                   18718:             $output .= &mt('Display roles');
                   18719:         }
                   18720:         $output .= '</a>';
                   18721:     } elsif ($switchserver) {
                   18722:         $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
                   18723:                    '<br />'.
                   18724:                    '<a href="/adm/switchserver?'.$switchserver.'">'.
                   18725:                    &mt('Switch Server').
                   18726:                    '</a>';
                   18727:     }
                   18728:     $output .= '</p>'.&end_page();
                   18729:     return $output;
                   18730: }
                   18731: 
                   18732: =pod
                   18733: 
                   18734: =item * &needs_coursereinit()
                   18735: 
                   18736: Determine if course contents stored for user's session needs to be
                   18737: refreshed, because content has changed since "Big Hash" last tied.
                   18738: 
                   18739: Check for change is made if time last checked is more than 10 minutes ago
                   18740: (by default).
                   18741: 
                   18742: Inputs:
                   18743: 
                   18744: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   18745: 
                   18746: $interval (optional) - Time which may elapse (in s) between last check for content
                   18747:                        change in current course. (default: 600 s).  
                   18748: 
                   18749: Returns: an array; first element is:
                   18750: 
                   18751: =over 4
                   18752: 
                   18753: 'switch' - if content updates mean user's session
                   18754:            needs to be switched to a server running a newer LON-CAPA version
                   18755:  
                   18756: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
                   18757:            on current server hosting user's session                
                   18758: 
                   18759: ''       - if no action required.
                   18760: 
                   18761: =back
                   18762: 
                   18763: If first item element is 'switch':
                   18764: 
                   18765: second item is $switchwarning - Warning message if no suitable server found to host session. 
                   18766: 
                   18767: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
                   18768:                               and current role. 
                   18769: 
                   18770: otherwise: no other elements returned.
                   18771: 
                   18772: =back
                   18773: 
                   18774: =cut
                   18775: 
                   18776: sub needs_coursereinit {
                   18777:     my ($loncaparev,$interval) = @_;
                   18778:     return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
                   18779:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   18780:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   18781:     my $now = time;
                   18782:     if ($interval eq '') {
                   18783:         $interval = 600;
                   18784:     }
                   18785:     if (($now-$env{'request.course.timechecked'})>$interval) {
1.1282    raeburn  18786:         &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
1.1372    raeburn  18787:         my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
1.1282    raeburn  18788:         if ($blocked) {
                   18789:             return ();
                   18790:         }
1.1391    raeburn  18791:         my $update;
                   18792:         my $lastmainchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
                   18793:         my $lastsuppchange = &Apache::lonnet::get_suppchange($cdom,$cnum);
                   18794:         if ($lastmainchange > $env{'request.course.tied'}) {
                   18795:             my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
                   18796:             if ($needswitch) {
                   18797:                 return ('switch',$switchwarning,$switchserver);
                   18798:             }
                   18799:             $update = 'main';
                   18800:         }
                   18801:         if ($lastsuppchange > $env{'request.course.suppupdated'}) {
                   18802:             if ($update) {
                   18803:                 $update = 'both';
                   18804:             } else {
                   18805:                 my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
                   18806:                 if ($needswitch) {
                   18807:                     return ('switch',$switchwarning,$switchserver);
                   18808:                 } else {
                   18809:                     $update = 'supp';
1.1207    raeburn  18810:                 }
                   18811:             }
1.1391    raeburn  18812:             return ($update);
                   18813:         }
                   18814:     }
                   18815:     return ();
                   18816: }
                   18817: 
                   18818: sub switch_for_update {
                   18819:     my ($loncaparev,$cdom,$cnum) = @_;
                   18820:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   18821:     if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
                   18822:         my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
                   18823:         if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
                   18824:             &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
                   18825:                                     $curr_reqd_hash{'internal.releaserequired'}});
                   18826:             my ($switchserver,$switchwarning) =
                   18827:                 &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
                   18828:                                         $curr_reqd_hash{'internal.releaserequired'});
                   18829:             if ($switchwarning ne '' || $switchserver ne '') {
                   18830:                 return ('switch',$switchwarning,$switchserver);
                   18831:             }
1.1207    raeburn  18832:         }
                   18833:     }
                   18834:     return ();
                   18835: }
1.1181    raeburn  18836: 
1.1083    raeburn  18837: sub update_content_constraints {
1.1395    raeburn  18838:     my ($cdom,$cnum,$chome,$cid) = @_;
1.1083    raeburn  18839:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   18840:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
1.1307    raeburn  18841:     my (%checkresponsetypes,%checkcrsrestypes);
1.1083    raeburn  18842:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236    raeburn  18843:         my ($item,$name,$value) = split(/:/,$key);
1.1083    raeburn  18844:         if ($item eq 'resourcetag') {
                   18845:             if ($name eq 'responsetype') {
                   18846:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   18847:             }
1.1307    raeburn  18848:         } elsif ($item eq 'course') {
                   18849:             if ($name eq 'courserestype') {
                   18850:                 $checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key};
                   18851:             }
1.1083    raeburn  18852:         }
                   18853:     }
                   18854:     my $navmap = Apache::lonnavmaps::navmap->new();
                   18855:     if (defined($navmap)) {
1.1307    raeburn  18856:         my (%allresponses,%allcrsrestypes);
                   18857:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) {
                   18858:             if ($res->is_tool()) {
                   18859:                 if ($allcrsrestypes{'exttool'}) {
                   18860:                     $allcrsrestypes{'exttool'} ++;
                   18861:                 } else {
                   18862:                     $allcrsrestypes{'exttool'} = 1;
                   18863:                 }
                   18864:                 next;
                   18865:             }
1.1083    raeburn  18866:             my %responses = $res->responseTypes();
                   18867:             foreach my $key (keys(%responses)) {
                   18868:                 next unless(exists($checkresponsetypes{$key}));
                   18869:                 $allresponses{$key} += $responses{$key};
                   18870:             }
                   18871:         }
                   18872:         foreach my $key (keys(%allresponses)) {
                   18873:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   18874:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   18875:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   18876:             }
                   18877:         }
1.1307    raeburn  18878:         foreach my $key (keys(%allcrsrestypes)) {
1.1308    raeburn  18879:             my ($major,$minor) = split(/\./,$checkcrsrestypes{$key});
1.1307    raeburn  18880:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   18881:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   18882:             }
                   18883:         }
1.1083    raeburn  18884:         undef($navmap);
                   18885:     }
1.1391    raeburn  18886:     if (&Apache::lonnet::count_supptools($cnum,$cdom,1)) {
1.1308    raeburn  18887:         my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
                   18888:         if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   18889:             ($reqdmajor,$reqdminor) = ($major,$minor);
                   18890:         }
                   18891:     }
1.1083    raeburn  18892:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   18893:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   18894:     }
                   18895:     return;
                   18896: }
                   18897: 
1.1110    raeburn  18898: sub allmaps_incourse {
                   18899:     my ($cdom,$cnum,$chome,$cid) = @_;
                   18900:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   18901:         $cid = $env{'request.course.id'};
                   18902:         $cdom = $env{'course.'.$cid.'.domain'};
                   18903:         $cnum = $env{'course.'.$cid.'.num'};
                   18904:         $chome = $env{'course.'.$cid.'.home'};
                   18905:     }
                   18906:     my %allmaps = ();
                   18907:     my $lastchange =
                   18908:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   18909:     if ($lastchange > $env{'request.course.tied'}) {
                   18910:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   18911:         unless ($ferr) {
1.1395    raeburn  18912:             &update_content_constraints($cdom,$cnum,$chome,$cid);
1.1110    raeburn  18913:         }
                   18914:     }
                   18915:     my $navmap = Apache::lonnavmaps::navmap->new();
                   18916:     if (defined($navmap)) {
                   18917:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   18918:             $allmaps{$res->src()} = 1;
                   18919:         }
                   18920:     }
                   18921:     return \%allmaps;
                   18922: }
                   18923: 
1.1083    raeburn  18924: sub parse_supplemental_title {
                   18925:     my ($title) = @_;
                   18926: 
                   18927:     my ($foldertitle,$renametitle);
                   18928:     if ($title =~ /&amp;&amp;&amp;/) {
                   18929:         $title = &HTML::Entites::decode($title);
                   18930:     }
                   18931:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   18932:         $renametitle=$4;
                   18933:         my ($time,$uname,$udom) = ($1,$2,$3);
                   18934:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   18935:         my $name =  &plainname($uname,$udom);
                   18936:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   18937:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
1.1401    raeburn  18938:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.$name;
1.1402    raeburn  18939:         if ($foldertitle ne '') {
1.1401    raeburn  18940:             $title .= ': <br />'.$foldertitle;
                   18941:         }
1.1083    raeburn  18942:     }
                   18943:     if (wantarray) {
                   18944:         return ($title,$foldertitle,$renametitle);
                   18945:     }
                   18946:     return $title;
                   18947: }
                   18948: 
1.1395    raeburn  18949: sub get_supplemental {
                   18950:     my ($cnum,$cdom,$ignorecache,$possdel)=@_;
                   18951:     my $hashid=$cnum.':'.$cdom;
                   18952:     my ($supplemental,$cached,$set_httprefs);
                   18953:     unless ($ignorecache) {
                   18954:         ($supplemental,$cached) = &Apache::lonnet::is_cached_new('supplemental',$hashid);
                   18955:     }
                   18956:     unless (defined($cached)) {
                   18957:         my $chome=&Apache::lonnet::homeserver($cnum,$cdom);
                   18958:         unless ($chome eq 'no_host') {
                   18959:             my @order = @LONCAPA::map::order;
                   18960:             my @resources = @LONCAPA::map::resources;
                   18961:             my @resparms = @LONCAPA::map::resparms;
                   18962:             my @zombies = @LONCAPA::map::zombies;
                   18963:             my ($errors,%ids,%hidden);
                   18964:             $errors =
                   18965:                 &recurse_supplemental($cnum,$cdom,'supplemental.sequence',
                   18966:                                       $errors,$possdel,\%ids,\%hidden);
                   18967:             @LONCAPA::map::order = @order;
                   18968:             @LONCAPA::map::resources = @resources;
                   18969:             @LONCAPA::map::resparms = @resparms;
                   18970:             @LONCAPA::map::zombies = @zombies;
                   18971:             $set_httprefs = 1;
                   18972:             if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
                   18973:                 &Apache::lonnet::appenv({'request.course.suppupdated' => time});
                   18974:             }
                   18975:             $supplemental = {
                   18976:                                ids => \%ids,
                   18977:                                hidden => \%hidden,
                   18978:                             };
                   18979:             &Apache::lonnet::do_cache_new('supplemental',$hashid,$supplemental,600);
                   18980:         }
                   18981:     }
                   18982:     return ($supplemental,$set_httprefs);
                   18983: }
                   18984: 
1.1143    raeburn  18985: sub recurse_supplemental {
1.1391    raeburn  18986:     my ($cnum,$cdom,$suppmap,$errors,$possdel,$suppids,$hiddensupp,$hidden) = @_;
                   18987:     if (($suppmap) && (ref($suppids) eq 'HASH') && (ref($hiddensupp) eq 'HASH')) {
                   18988:         my $mapnum;
                   18989:         if ($suppmap eq 'supplemental.sequence') {
                   18990:             $mapnum = 0;
                   18991:         } else {
                   18992:             ($mapnum) = ($suppmap =~ /^supplemental_(\d+)\.sequence$/);
                   18993:         }
1.1143    raeburn  18994:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   18995:         if ($fatal) {
                   18996:             $errors ++;
                   18997:         } else {
1.1389    raeburn  18998:             my @order = @LONCAPA::map::order;
                   18999:             if (@order > 0) {
                   19000:                 my @resources = @LONCAPA::map::resources;
1.1391    raeburn  19001:                 my @resparms = @LONCAPA::map::resparms;
1.1389    raeburn  19002:                 foreach my $idx (@order) {
                   19003:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$resources[$idx]);
1.1143    raeburn  19004:                     if (($src ne '') && ($status eq 'res')) {
1.1391    raeburn  19005:                         my $id = $mapnum.':'.$idx;
                   19006:                         push(@{$suppids->{$src}},$id);
                   19007:                         if (($hidden) || (&get_supp_parameter($resparms[$idx],'parameter_hiddenresource') =~ /^yes/i)) {
                   19008:                             $hiddensupp->{$id} = 1;
                   19009:                         }
1.1146    raeburn  19010:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
1.1391    raeburn  19011:                             $errors = &recurse_supplemental($cnum,$cdom,$1,$errors,$possdel,$suppids,
                   19012:                                                             $hiddensupp,$hiddensupp->{$id});
1.1143    raeburn  19013:                         } else {
1.1391    raeburn  19014:                             my $allowed;
                   19015:                             if (($env{'request.role.adv'}) || (!$hiddensupp->{$id})) {
                   19016:                                 $allowed = 1;
                   19017:                             } elsif ($possdel) {
                   19018:                                 foreach my $item (@{$suppids->{$src}}) {
                   19019:                                     next if ($item eq $id);
                   19020:                                     unless ($hiddensupp->{$item}) {
                   19021:                                        $allowed = 1;
                   19022:                                        last;
                   19023:                                     }
                   19024:                                 }
                   19025:                                 if ((!$allowed) && (exists($env{'httpref.'.$src}))) {
                   19026:                                     &Apache::lonnet::delenv('httpref.'.$src);
                   19027:                                 }
                   19028:                             }
                   19029:                             if ($allowed && (!exists($env{'httpref.'.$src}))) {
                   19030:                                 &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
1.1308    raeburn  19031:                             }
1.1143    raeburn  19032:                         }
                   19033:                     }
                   19034:                 }
                   19035:             }
                   19036:         }
                   19037:     }
1.1391    raeburn  19038:     return $errors;
                   19039: }
                   19040: 
                   19041: sub set_supp_httprefs {
                   19042:     my ($cnum,$cdom,$supplemental,$possdel) = @_;
                   19043:     if (ref($supplemental) eq 'HASH') {
                   19044:         if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {
                   19045:             foreach my $src (keys(%{$supplemental->{'ids'}})) {
                   19046:                 next if ($src =~ /\.sequence$/);
                   19047:                 if (ref($supplemental->{'ids'}->{$src}) eq 'ARRAY') {
                   19048:                     my $allowed;
                   19049:                     if ($env{'request.role.adv'}) {
                   19050:                         $allowed = 1;
                   19051:                     } else {
                   19052:                         foreach my $id (@{$supplemental->{'ids'}->{$src}}) {
                   19053:                             unless ($supplemental->{'hidden'}->{$id}) {
                   19054:                                 $allowed = 1;
                   19055:                                 last;
                   19056:                             }
                   19057:                         }
                   19058:                     }
                   19059:                     if (exists($env{'httpref.'.$src})) {
                   19060:                         if ($possdel) {
                   19061:                             unless ($allowed) {
                   19062:                                 &Apache::lonnet::delenv('httpref.'.$src);
                   19063:                             }
                   19064:                         }
                   19065:                     } elsif ($allowed) {
                   19066:                         &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
                   19067:                     }
                   19068:                 }
                   19069:             }
                   19070:             if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
                   19071:                 &Apache::lonnet::appenv({'request.course.suppupdated' => time});
                   19072:             }
                   19073:         }
                   19074:     }
                   19075: }
                   19076: 
                   19077: sub get_supp_parameter {
                   19078:     my ($resparm,$name)=@_;
                   19079:     return if ($resparm eq '');
                   19080:     my $value=undef;
                   19081:     my $ptype=undef;
                   19082:     foreach (split('&&&',$resparm)) {
                   19083:         my ($thistype,$thisname,$thisvalue)=split('___',$_);
                   19084:         if ($thisname eq $name) {
                   19085:             $value=$thisvalue;
                   19086:             $ptype=$thistype;
                   19087:         }
                   19088:     }
                   19089:     return $value;
1.1143    raeburn  19090: }
                   19091: 
1.1101    raeburn  19092: sub symb_to_docspath {
1.1267    raeburn  19093:     my ($symb,$navmapref) = @_;
                   19094:     return unless ($symb && ref($navmapref));
1.1101    raeburn  19095:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   19096:     if ($resurl=~/\.(sequence|page)$/) {
                   19097:         $mapurl=$resurl;
                   19098:     } elsif ($resurl eq 'adm/navmaps') {
                   19099:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   19100:     }
                   19101:     my $mapresobj;
1.1267    raeburn  19102:     unless (ref($$navmapref)) {
                   19103:         $$navmapref = Apache::lonnavmaps::navmap->new();
                   19104:     }
                   19105:     if (ref($$navmapref)) {
                   19106:         $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1101    raeburn  19107:     }
                   19108:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   19109:     my $type=$2;
                   19110:     my $path;
                   19111:     if (ref($mapresobj)) {
                   19112:         my $pcslist = $mapresobj->map_hierarchy();
                   19113:         if ($pcslist ne '') {
                   19114:             foreach my $pc (split(/,/,$pcslist)) {
                   19115:                 next if ($pc <= 1);
1.1267    raeburn  19116:                 my $res = $$navmapref->getByMapPc($pc);
1.1101    raeburn  19117:                 if (ref($res)) {
                   19118:                     my $thisurl = $res->src();
                   19119:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   19120:                     my $thistitle = $res->title();
                   19121:                     $path .= '&'.
                   19122:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146    raeburn  19123:                              &escape($thistitle).
1.1101    raeburn  19124:                              ':'.$res->randompick().
                   19125:                              ':'.$res->randomout().
                   19126:                              ':'.$res->encrypted().
                   19127:                              ':'.$res->randomorder().
                   19128:                              ':'.$res->is_page();
                   19129:                 }
                   19130:             }
                   19131:         }
                   19132:         $path =~ s/^\&//;
                   19133:         my $maptitle = $mapresobj->title();
                   19134:         if ($mapurl eq 'default') {
1.1129    raeburn  19135:             $maptitle = 'Main Content';
1.1101    raeburn  19136:         }
                   19137:         $path .= (($path ne '')? '&' : '').
                   19138:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  19139:                  &escape($maptitle).
1.1101    raeburn  19140:                  ':'.$mapresobj->randompick().
                   19141:                  ':'.$mapresobj->randomout().
                   19142:                  ':'.$mapresobj->encrypted().
                   19143:                  ':'.$mapresobj->randomorder().
                   19144:                  ':'.$mapresobj->is_page();
                   19145:     } else {
                   19146:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   19147:         my $ispage = (($type eq 'page')? 1 : '');
                   19148:         if ($mapurl eq 'default') {
1.1129    raeburn  19149:             $maptitle = 'Main Content';
1.1101    raeburn  19150:         }
                   19151:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  19152:                 &escape($maptitle).':::::'.$ispage;
1.1101    raeburn  19153:     }
                   19154:     unless ($mapurl eq 'default') {
                   19155:         $path = 'default&'.
1.1146    raeburn  19156:                 &escape('Main Content').
1.1101    raeburn  19157:                 ':::::&'.$path;
                   19158:     }
                   19159:     return $path;
                   19160: }
                   19161: 
1.1393    raeburn  19162: sub validate_folderpath {
                   19163:     my ($supplementalflag,$allowed,$coursenum,$coursedom) = @_;
                   19164:     if ($env{'form.folderpath'} ne '') {
                   19165:         my @items = split(/\&/,$env{'form.folderpath'});
1.1394    raeburn  19166:         my ($badpath,$changed,$got_supp,$supppath,%supphidden,%suppids);
1.1393    raeburn  19167:         for (my $i=0; $i<@items; $i++) {
                   19168:             my $odd = $i%2;
                   19169:             if (($odd) && (!$supplementalflag) && ($items[$i] !~ /^[^:]*:(|\d+):(|1):(|1):(|1):(|1)$/)) {
                   19170:                 $badpath = 1;
1.1394    raeburn  19171:             } elsif ($odd && $supplementalflag) {
1.1393    raeburn  19172:                 my $idx = $i-1;
1.1394    raeburn  19173:                 if ($items[$i] =~ /^([^:]*)::(|1):::$/) {
                   19174:                     my $esc_name = $1;
                   19175:                     if ((!$allowed) || ($items[$idx] eq 'supplemental')) {
                   19176:                         $supppath .= '&'.$esc_name;
                   19177:                         $changed = 1;
                   19178:                     } else {
                   19179:                         $supppath .= '&'.$items[$i];
                   19180:                     }
                   19181:                 } elsif (($allowed) && ($items[$idx] ne 'supplemental')) {
                   19182:                     $changed = 1;
1.1393    raeburn  19183:                     my $is_hidden;
                   19184:                     unless ($got_supp) {
1.1395    raeburn  19185:                         my ($supplemental) = &get_supplemental($coursenum,$coursedom);
1.1393    raeburn  19186:                         if (ref($supplemental) eq 'HASH') {
                   19187:                             if (ref($supplemental->{'hidden'}) eq 'HASH') {
                   19188:                                 %supphidden = %{$supplemental->{'hidden'}};
                   19189:                             }
                   19190:                             if (ref($supplemental->{'ids'}) eq 'HASH') {
                   19191:                                 %suppids = %{$supplemental->{'ids'}};
                   19192:                             }
                   19193:                         }
                   19194:                         $got_supp = 1;
                   19195:                     }
                   19196:                     if (ref($suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}) eq 'ARRAY') {
                   19197:                         my $mapid = $suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}->[0];
                   19198:                         if ($supphidden{$mapid}) {
                   19199:                             $is_hidden = 1;
                   19200:                         }
                   19201:                     }
1.1394    raeburn  19202:                     $supppath .= '&'.$items[$i].'::'.$is_hidden.':::';
                   19203:                 } else {
                   19204:                     $supppath .= '&'.$items[$i];
1.1393    raeburn  19205:                 }
                   19206:             } elsif ((!$odd) && ($items[$i] !~ /^(default|supplemental)(|_\d+)$/)) {
                   19207:                 $badpath = 1;
1.1394    raeburn  19208:             } elsif ($supplementalflag) {
1.1393    raeburn  19209:                 $supppath .= '&'.$items[$i];
                   19210:             }
                   19211:             last if ($badpath);
                   19212:         }
                   19213:         if ($badpath) {
                   19214:             delete($env{'form.folderpath'});
1.1394    raeburn  19215:         } elsif ($changed && $supplementalflag) {
1.1393    raeburn  19216:             $supppath =~ s/^\&//;
                   19217:             $env{'form.folderpath'} = $supppath;
                   19218:         }
                   19219:     }
                   19220:     return;
                   19221: }
                   19222: 
1.1094    raeburn  19223: sub captcha_display {
1.1327    raeburn  19224:     my ($context,$lonhost,$defdom) = @_;
1.1094    raeburn  19225:     my ($output,$error);
1.1234    raeburn  19226:     my ($captcha,$pubkey,$privkey,$version) = 
1.1327    raeburn  19227:         &get_captcha_config($context,$lonhost,$defdom);
1.1095    raeburn  19228:     if ($captcha eq 'original') {
1.1094    raeburn  19229:         $output = &create_captcha();
                   19230:         unless ($output) {
1.1172    raeburn  19231:             $error = 'captcha';
1.1094    raeburn  19232:         }
                   19233:     } elsif ($captcha eq 'recaptcha') {
1.1234    raeburn  19234:         $output = &create_recaptcha($pubkey,$version);
1.1094    raeburn  19235:         unless ($output) {
1.1172    raeburn  19236:             $error = 'recaptcha';
1.1094    raeburn  19237:         }
                   19238:     }
1.1234    raeburn  19239:     return ($output,$error,$captcha,$version);
1.1094    raeburn  19240: }
                   19241: 
                   19242: sub captcha_response {
1.1327    raeburn  19243:     my ($context,$lonhost,$defdom) = @_;
1.1094    raeburn  19244:     my ($captcha_chk,$captcha_error);
1.1327    raeburn  19245:     my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
1.1095    raeburn  19246:     if ($captcha eq 'original') {
1.1094    raeburn  19247:         ($captcha_chk,$captcha_error) = &check_captcha();
                   19248:     } elsif ($captcha eq 'recaptcha') {
1.1234    raeburn  19249:         $captcha_chk = &check_recaptcha($privkey,$version);
1.1094    raeburn  19250:     } else {
                   19251:         $captcha_chk = 1;
                   19252:     }
                   19253:     return ($captcha_chk,$captcha_error);
                   19254: }
                   19255: 
                   19256: sub get_captcha_config {
1.1327    raeburn  19257:     my ($context,$lonhost,$dom_in_effect) = @_;
1.1234    raeburn  19258:     my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094    raeburn  19259:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   19260:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   19261:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095    raeburn  19262:     if ($context eq 'usercreation') {
                   19263:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   19264:         if (ref($domconfig{$context}) eq 'HASH') {
                   19265:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   19266:             if (ref($hashtocheck) eq 'HASH') {
                   19267:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   19268:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   19269:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   19270:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   19271:                     }
                   19272:                     if ($privkey && $pubkey) {
                   19273:                         $captcha = 'recaptcha';
1.1234    raeburn  19274:                         $version = $hashtocheck->{'recaptchaversion'};
                   19275:                         if ($version ne '2') {
                   19276:                             $version = 1;
                   19277:                         }
1.1095    raeburn  19278:                     } else {
                   19279:                         $captcha = 'original';
                   19280:                     }
                   19281:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   19282:                     $captcha = 'original';
                   19283:                 }
1.1094    raeburn  19284:             }
1.1095    raeburn  19285:         } else {
                   19286:             $captcha = 'captcha';
                   19287:         }
                   19288:     } elsif ($context eq 'login') {
                   19289:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   19290:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   19291:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   19292:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094    raeburn  19293:             if ($privkey && $pubkey) {
                   19294:                 $captcha = 'recaptcha';
1.1234    raeburn  19295:                 $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
                   19296:                 if ($version ne '2') {
                   19297:                     $version = 1; 
                   19298:                 }
1.1095    raeburn  19299:             } else {
                   19300:                 $captcha = 'original';
1.1094    raeburn  19301:             }
1.1095    raeburn  19302:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   19303:             $captcha = 'original';
1.1094    raeburn  19304:         }
1.1327    raeburn  19305:     } elsif ($context eq 'passwords') {
                   19306:         if ($dom_in_effect) {
                   19307:             my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
                   19308:             if ($passwdconf{'captcha'} eq 'recaptcha') {
                   19309:                 if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
                   19310:                     $pubkey = $passwdconf{'recaptchakeys'}{'public'};
                   19311:                     $privkey = $passwdconf{'recaptchakeys'}{'private'};
                   19312:                 }
                   19313:                 if ($privkey && $pubkey) {
                   19314:                     $captcha = 'recaptcha';
                   19315:                     $version = $passwdconf{'recaptchaversion'};
                   19316:                     if ($version ne '2') {
                   19317:                         $version = 1;
                   19318:                     }
                   19319:                 } else {
                   19320:                     $captcha = 'original';
                   19321:                 }
                   19322:             } elsif ($passwdconf{'captcha'} ne 'notused') {
                   19323:                 $captcha = 'original';
                   19324:             }
                   19325:         }
                   19326:     } 
1.1234    raeburn  19327:     return ($captcha,$pubkey,$privkey,$version);
1.1094    raeburn  19328: }
                   19329: 
                   19330: sub create_captcha {
                   19331:     my %captcha_params = &captcha_settings();
                   19332:     my ($output,$maxtries,$tries) = ('',10,0);
                   19333:     while ($tries < $maxtries) {
                   19334:         $tries ++;
                   19335:         my $captcha = Authen::Captcha->new (
                   19336:                                            output_folder => $captcha_params{'output_dir'},
                   19337:                                            data_folder   => $captcha_params{'db_dir'},
                   19338:                                           );
                   19339:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   19340: 
                   19341:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   19342:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
1.1367    raeburn  19343:                       '<span class="LC_nobreak">'.
1.1094    raeburn  19344:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
1.1390    raeburn  19345:                       '<input type="text" size="5" name="code" value="" autocomplete="new-password" />'.
1.1367    raeburn  19346:                       '</span><br />'.
1.1176    raeburn  19347:                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094    raeburn  19348:             last;
                   19349:         }
                   19350:     }
1.1323    raeburn  19351:     if ($output eq '') {
                   19352:         &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
                   19353:     }
1.1094    raeburn  19354:     return $output;
                   19355: }
                   19356: 
                   19357: sub captcha_settings {
                   19358:     my %captcha_params = (
                   19359:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   19360:                            www_output_dir => "/captchaspool",
                   19361:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   19362:                            numchars       => '5',
                   19363:                          );
                   19364:     return %captcha_params;
                   19365: }
                   19366: 
                   19367: sub check_captcha {
                   19368:     my ($captcha_chk,$captcha_error);
                   19369:     my $code = $env{'form.code'};
                   19370:     my $md5sum = $env{'form.crypt'};
                   19371:     my %captcha_params = &captcha_settings();
                   19372:     my $captcha = Authen::Captcha->new(
                   19373:                       output_folder => $captcha_params{'output_dir'},
                   19374:                       data_folder   => $captcha_params{'db_dir'},
                   19375:                   );
1.1109    raeburn  19376:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094    raeburn  19377:     my %captcha_hash = (
                   19378:                         0       => 'Code not checked (file error)',
                   19379:                        -1      => 'Failed: code expired',
                   19380:                        -2      => 'Failed: invalid code (not in database)',
                   19381:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   19382:     );
                   19383:     if ($captcha_chk != 1) {
                   19384:         $captcha_error = $captcha_hash{$captcha_chk}
                   19385:     }
                   19386:     return ($captcha_chk,$captcha_error);
                   19387: }
                   19388: 
                   19389: sub create_recaptcha {
1.1234    raeburn  19390:     my ($pubkey,$version) = @_;
                   19391:     if ($version >= 2) {
1.1367    raeburn  19392:         return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>'.
                   19393:                '<div style="padding:0;clear:both;margin:0;border:0"></div>';
1.1234    raeburn  19394:     } else {
                   19395:         my $use_ssl;
                   19396:         if ($ENV{'SERVER_PORT'} == 443) {
                   19397:             $use_ssl = 1;
                   19398:         }
                   19399:         my $captcha = Captcha::reCAPTCHA->new;
                   19400:         return $captcha->get_options_setter({theme => 'white'})."\n".
                   19401:                $captcha->get_html($pubkey,undef,$use_ssl).
                   19402:                &mt('If the text is hard to read, [_1] will replace them.',
                   19403:                    '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
                   19404:                '<br /><br />';
                   19405:     }
1.1094    raeburn  19406: }
                   19407: 
                   19408: sub check_recaptcha {
1.1234    raeburn  19409:     my ($privkey,$version) = @_;
1.1094    raeburn  19410:     my $captcha_chk;
1.1350    raeburn  19411:     my $ip = &Apache::lonnet::get_requestor_ip();
1.1234    raeburn  19412:     if ($version >= 2) {
                   19413:         my %info = (
                   19414:                      secret   => $privkey, 
                   19415:                      response => $env{'form.g-recaptcha-response'},
1.1350    raeburn  19416:                      remoteip => $ip,
1.1234    raeburn  19417:                    );
1.1280    raeburn  19418:         my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
                   19419:         $request->content(join('&',map {
                   19420:                          my $name = escape($_);
                   19421:                          "$name=" . ( ref($info{$_}) eq 'ARRAY'
                   19422:                          ? join("&$name=", map {escape($_) } @{$info{$_}})
                   19423:                          : &escape($info{$_}) );
                   19424:         } keys(%info)));
                   19425:         my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1);
1.1234    raeburn  19426:         if ($response->is_success)  {
                   19427:             my $data = JSON::DWIW->from_json($response->decoded_content);
                   19428:             if (ref($data) eq 'HASH') {
                   19429:                 if ($data->{'success'}) {
                   19430:                     $captcha_chk = 1;
                   19431:                 }
                   19432:             }
                   19433:         }
                   19434:     } else {
                   19435:         my $captcha = Captcha::reCAPTCHA->new;
                   19436:         my $captcha_result =
                   19437:             $captcha->check_answer(
                   19438:                                     $privkey,
1.1350    raeburn  19439:                                     $ip,
1.1234    raeburn  19440:                                     $env{'form.recaptcha_challenge_field'},
                   19441:                                     $env{'form.recaptcha_response_field'},
                   19442:                                   );
                   19443:         if ($captcha_result->{is_valid}) {
                   19444:             $captcha_chk = 1;
                   19445:         }
1.1094    raeburn  19446:     }
                   19447:     return $captcha_chk;
                   19448: }
                   19449: 
1.1174    raeburn  19450: sub emailusername_info {
1.1244    raeburn  19451:     my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1174    raeburn  19452:     my %titles = &Apache::lonlocal::texthash (
                   19453:                      lastname      => 'Last Name',
                   19454:                      firstname     => 'First Name',
                   19455:                      institution   => 'School/college/university',
                   19456:                      location      => "School's city, state/province, country",
                   19457:                      web           => "School's web address",
                   19458:                      officialemail => 'E-mail address at institution (if different)',
1.1244    raeburn  19459:                      id            => 'Student/Employee ID',
1.1174    raeburn  19460:                  );
                   19461:     return (\@fields,\%titles);
                   19462: }
                   19463: 
1.1161    raeburn  19464: sub cleanup_html {
                   19465:     my ($incoming) = @_;
                   19466:     my $outgoing;
                   19467:     if ($incoming ne '') {
                   19468:         $outgoing = $incoming;
                   19469:         $outgoing =~ s/;/&#059;/g;
                   19470:         $outgoing =~ s/\#/&#035;/g;
                   19471:         $outgoing =~ s/\&/&#038;/g;
                   19472:         $outgoing =~ s/</&#060;/g;
                   19473:         $outgoing =~ s/>/&#062;/g;
                   19474:         $outgoing =~ s/\(/&#040/g;
                   19475:         $outgoing =~ s/\)/&#041;/g;
                   19476:         $outgoing =~ s/"/&#034;/g;
                   19477:         $outgoing =~ s/'/&#039;/g;
                   19478:         $outgoing =~ s/\$/&#036;/g;
                   19479:         $outgoing =~ s{/}{&#047;}g;
                   19480:         $outgoing =~ s/=/&#061;/g;
                   19481:         $outgoing =~ s/\\/&#092;/g
                   19482:     }
                   19483:     return $outgoing;
                   19484: }
                   19485: 
1.1190    musolffc 19486: # Checks for critical messages and returns a redirect url if one exists.
                   19487: # $interval indicates how often to check for messages.
1.1282    raeburn  19488: # $context is the calling context -- roles, grades, contents, menu or flip. 
1.1190    musolffc 19489: sub critical_redirect {
1.1282    raeburn  19490:     my ($interval,$context) = @_;
1.1356    raeburn  19491:     unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
                   19492:         return ();
                   19493:     }
1.1190    musolffc 19494:     if ((time-$env{'user.criticalcheck.time'})>$interval) {
1.1282    raeburn  19495:         if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
                   19496:             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   19497:             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1372    raeburn  19498:             my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1);
1.1282    raeburn  19499:             if ($blocked) {
                   19500:                 my $checkrole = "cm./$cdom/$cnum";
                   19501:                 if ($env{'request.course.sec'} ne '') {
                   19502:                     $checkrole .= "/$env{'request.course.sec'}";
                   19503:                 }
                   19504:                 unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   19505:                         ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   19506:                     return;
                   19507:                 }
                   19508:             }
                   19509:         }
1.1190    musolffc 19510:         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, 
                   19511:                                         $env{'user.name'});
                   19512:         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191    raeburn  19513:         my $redirecturl;
1.1190    musolffc 19514:         if ($what[0]) {
1.1356    raeburn  19515: 	    if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
1.1190    musolffc 19516: 	        $redirecturl='/adm/email?critical=display';
1.1191    raeburn  19517: 	        my $url=&Apache::lonnet::absolute_url().$redirecturl;
                   19518:                 return (1, $url);
1.1190    musolffc 19519:             }
1.1191    raeburn  19520:         }
                   19521:     } 
                   19522:     return ();
1.1190    musolffc 19523: }
                   19524: 
1.1174    raeburn  19525: # Use:
                   19526: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                   19527: #
                   19528: ##################################################
                   19529: #          password associated functions         #
                   19530: ##################################################
                   19531: sub des_keys {
                   19532:     # Make a new key for DES encryption.
                   19533:     # Each key has two parts which are returned separately.
                   19534:     # Please note:  Each key must be passed through the &hex function
                   19535:     # before it is output to the web browser.  The hex versions cannot
                   19536:     # be used to decrypt.
                   19537:     my @hexstr=('0','1','2','3','4','5','6','7',
                   19538:                 '8','9','a','b','c','d','e','f');
                   19539:     my $lkey='';
                   19540:     for (0..7) {
                   19541:         $lkey.=$hexstr[rand(15)];
                   19542:     }
                   19543:     my $ukey='';
                   19544:     for (0..7) {
                   19545:         $ukey.=$hexstr[rand(15)];
                   19546:     }
                   19547:     return ($lkey,$ukey);
                   19548: }
                   19549: 
                   19550: sub des_decrypt {
                   19551:     my ($key,$cyphertext) = @_;
                   19552:     my $keybin=pack("H16",$key);
                   19553:     my $cypher;
                   19554:     if ($Crypt::DES::VERSION>=2.03) {
                   19555:         $cypher=new Crypt::DES $keybin;
                   19556:     } else {
                   19557:         $cypher=new DES $keybin;
                   19558:     }
1.1233    raeburn  19559:     my $plaintext='';
                   19560:     my $cypherlength = length($cyphertext);
                   19561:     my $numchunks = int($cypherlength/32);
                   19562:     for (my $j=0; $j<$numchunks; $j++) {
                   19563:         my $start = $j*32;
                   19564:         my $cypherblock = substr($cyphertext,$start,32);
                   19565:         my $chunk =
                   19566:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
                   19567:         $chunk .=
                   19568:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
                   19569:         $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
                   19570:         $plaintext .= $chunk;
                   19571:     }
1.1174    raeburn  19572:     return $plaintext;
                   19573: }
                   19574: 
1.1344    raeburn  19575: sub get_requested_shorturls {
1.1309    raeburn  19576:     my ($cdom,$cnum,$navmap) = @_;
                   19577:     return unless (ref($navmap));
1.1344    raeburn  19578:     my ($numnew,$errors);
1.1309    raeburn  19579:     my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
                   19580:     if (@toshorten) {
                   19581:         my (%maps,%resources,%titles);
                   19582:         &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
                   19583:                                                                'shorturls',$cdom,$cnum);
                   19584:         if (keys(%resources)) {
1.1344    raeburn  19585:             my %tocreate;
1.1309    raeburn  19586:             foreach my $item (sort {$a <=> $b} (@toshorten)) {
                   19587:                 my $symb = $resources{$item};
                   19588:                 if ($symb) {
                   19589:                     $tocreate{$cnum.'&'.$symb} = 1;
                   19590:                 }
                   19591:             }
1.1344    raeburn  19592:             if (keys(%tocreate)) {
                   19593:                 ($numnew,$errors) = &make_short_symbs($cdom,$cnum,
                   19594:                                                       \%tocreate);
                   19595:             }
1.1309    raeburn  19596:         }
1.1344    raeburn  19597:     }
                   19598:     return ($numnew,$errors);
                   19599: }
                   19600: 
                   19601: sub make_short_symbs {
                   19602:     my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
                   19603:     my ($numnew,@errors);
                   19604:     if (ref($tocreateref) eq 'HASH') {
                   19605:         my %tocreate = %{$tocreateref};
1.1309    raeburn  19606:         if (keys(%tocreate)) {
                   19607:             my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
                   19608:             my $su = Short::URL->new(no_vowels => 1);
                   19609:             my $init = '';
                   19610:             my (%newunique,%addcourse,%courseonly,%failed);
                   19611:             # get lock on tiny db
                   19612:             my $now = time;
1.1344    raeburn  19613:             if ($lockuser eq '') {
                   19614:                 $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
                   19615:             }
1.1309    raeburn  19616:             my $lockhash = {
1.1344    raeburn  19617:                                 "lock\0$now" => $lockuser,
1.1309    raeburn  19618:                             };
                   19619:             my $tries = 0;
                   19620:             my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
                   19621:             my ($code,$error);
                   19622:             while (($gotlock ne 'ok') && ($tries<3)) {
                   19623:                 $tries ++;
                   19624:                 sleep 1;
1.1319    raeburn  19625:                 $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
1.1309    raeburn  19626:             }
                   19627:             if ($gotlock eq 'ok') {
                   19628:                 $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
                   19629:                                        \%addcourse,\%courseonly,\%failed);
                   19630:                 if (keys(%failed)) {
                   19631:                     my $numfailed = scalar(keys(%failed));
                   19632:                     push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
                   19633:                 }
                   19634:                 if (keys(%newunique)) {
                   19635:                     my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
                   19636:                     if ($putres eq 'ok') {
                   19637:                         $numnew = scalar(keys(%newunique));
                   19638:                         my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
                   19639:                         unless ($newputres eq 'ok') {
                   19640:                             push(@errors,&mt('error: could not store course look-up of short URLs'));
                   19641:                         }
                   19642:                     } else {
                   19643:                         push(@errors,&mt('error: could not store unique six character URLs'));
                   19644:                     }
                   19645:                 }
                   19646:                 my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
                   19647:                 unless ($dellockres eq 'ok') {
                   19648:                     push(@errors,&mt('error: could not release lockfile'));
                   19649:                 }
                   19650:             } else {
                   19651:                 push(@errors,&mt('error: could not obtain lockfile'));
                   19652:             }
                   19653:             if (keys(%courseonly)) {
                   19654:                 my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
                   19655:                 if ($result ne 'ok') {
                   19656:                     push(@errors,&mt('error: could not update course look-up of short URLs'));
                   19657:                 }
                   19658:             }
                   19659:         }
                   19660:     }
                   19661:     return ($numnew,\@errors);
                   19662: }
                   19663: 
                   19664: sub shorten_symbs {
                   19665:     my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
                   19666:     return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
                   19667:                    (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
                   19668:                    (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
                   19669:     my (%possibles,%collisions);
                   19670:     foreach my $key (keys(%{$tocreate})) {
                   19671:         my $num = String::CRC32::crc32($key);
                   19672:         my $tiny = $su->encode($num,$init);
                   19673:         if ($tiny) {
                   19674:             $possibles{$tiny} = $key;
                   19675:         }
                   19676:     }
                   19677:     if (!$init) {
                   19678:         $init = 1;
                   19679:     } else {
                   19680:         $init ++;
                   19681:     }
                   19682:     if (keys(%possibles)) {
                   19683:         my @posstiny = keys(%possibles);
                   19684:         my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
                   19685:         my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
                   19686:         if (keys(%currtiny)) {
                   19687:             foreach my $key (keys(%currtiny)) {
                   19688:                 next if ($currtiny{$key} eq '');
                   19689:                 if ($currtiny{$key} eq $possibles{$key}) {
                   19690:                     my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
                   19691:                     unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
                   19692:                         $courseonly->{$tsymb} = $key;
                   19693:                     }
                   19694:                 } else {
                   19695:                     $collisions{$possibles{$key}} = 1;
                   19696:                 }
                   19697:                 delete($possibles{$key});
                   19698:             }
                   19699:         }
                   19700:         foreach my $key (keys(%possibles)) {
                   19701:             $newunique->{$key} = $possibles{$key};
                   19702:             my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
                   19703:             unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
                   19704:                 $addcourse->{$tsymb} = $key;
                   19705:             }
                   19706:         }
                   19707:     }
                   19708:     if (keys(%collisions)) {
                   19709:         if ($init <5) {
                   19710:             if (!$init) {
                   19711:                 $init = 1;
                   19712:             } else {
                   19713:                 $init ++;
                   19714:             }
                   19715:             $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
                   19716:                                    $newunique,$addcourse,$courseonly,$failed);
                   19717:         } else {
                   19718:             foreach my $key (keys(%collisions)) {
                   19719:                 $failed->{$key} = 1;
                   19720:             }
                   19721:         }
                   19722:     }
                   19723:     return $init;
                   19724: }
                   19725: 
1.1328    raeburn  19726: sub is_nonframeable {
1.1329    raeburn  19727:     my ($url,$absolute,$hostname,$ip,$nocache) = @_;
                   19728:     my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
1.1330    raeburn  19729:     return if (($remprotocol eq '') || ($remhost eq ''));
1.1329    raeburn  19730: 
                   19731:     $remprotocol = lc($remprotocol);
                   19732:     $remhost = lc($remhost);
                   19733:     my $remport = 80;
                   19734:     if ($remprotocol eq 'https') {
                   19735:         $remport = 443;
                   19736:     }
1.1330    raeburn  19737:     my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
1.1329    raeburn  19738:     if ($cached) {
                   19739:         unless ($nocache) {
                   19740:             if ($result) {
                   19741:                 return 1;
                   19742:             } else {
                   19743:                 return 0;
                   19744:             }
                   19745:         }
                   19746:     }
1.1328    raeburn  19747:     my $uselink;
                   19748:     my $request = new HTTP::Request('HEAD',$url);
                   19749:     my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);
                   19750:     if ($response->is_success()) {
                   19751:         my $secpolicy = lc($response->header('content-security-policy'));
                   19752:         my $xframeop = lc($response->header('x-frame-options'));
                   19753:         $secpolicy =~ s/^\s+|\s+$//g;
                   19754:         $xframeop =~ s/^\s+|\s+$//g;
                   19755:         if (($secpolicy ne '') || ($xframeop ne '')) {
1.1329    raeburn  19756:             my $remotehost = $remprotocol.'://'.$remhost;
1.1328    raeburn  19757:             my ($origin,$protocol,$port);
                   19758:             if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
                   19759:                 $port = $ENV{'SERVER_PORT'};
                   19760:             } else {
                   19761:                 $port = 80;
                   19762:             }
                   19763:             if ($absolute eq '') {
                   19764:                 $protocol = 'http:';
                   19765:                 if ($port == 443) {
                   19766:                     $protocol = 'https:';
                   19767:                 }
                   19768:                 $origin = $protocol.'//'.lc($hostname);
                   19769:             } else {
                   19770:                 $origin = lc($absolute);
                   19771:                 ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
                   19772:             }
                   19773:             if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
                   19774:                 my $framepolicy = $1;
                   19775:                 $framepolicy =~ s/^\s+|\s+$//g;
                   19776:                 my @policies = split(/\s+/,$framepolicy);
                   19777:                 if (@policies) {
                   19778:                     if (grep(/^\Q'none'\E$/,@policies)) {
                   19779:                         $uselink = 1;
                   19780:                     } else {
                   19781:                         $uselink = 1;
                   19782:                         if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
                   19783:                                 (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
                   19784:                                 (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
                   19785:                             undef($uselink);
                   19786:                         }
                   19787:                         if ($uselink) {
                   19788:                             if (grep(/^\Q'self'\E$/,@policies)) {
                   19789:                                 if (($origin ne '') && ($remotehost eq $origin)) {
                   19790:                                     undef($uselink);
                   19791:                                 }
                   19792:                             }
                   19793:                         }
                   19794:                         if ($uselink) {
                   19795:                             my @possok;
                   19796:                             if ($ip ne '') {
                   19797:                                 push(@possok,$ip);
                   19798:                             }
                   19799:                             my $hoststr = '';
                   19800:                             foreach my $part (reverse(split(/\./,$hostname))) {
                   19801:                                 if ($hoststr eq '') {
                   19802:                                     $hoststr = $part;
                   19803:                                 } else {
                   19804:                                     $hoststr = "$part.$hoststr";
                   19805:                                 }
                   19806:                                 if ($hoststr eq $hostname) {
                   19807:                                     push(@possok,$hostname);
                   19808:                                 } else {
                   19809:                                     push(@possok,"*.$hoststr");
                   19810:                                 }
                   19811:                             }
                   19812:                             if (@possok) {
                   19813:                                 foreach my $poss (@possok) {
                   19814:                                     last if (!$uselink);
                   19815:                                     foreach my $policy (@policies) {
                   19816:                                         if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
                   19817:                                             undef($uselink);
                   19818:                                             last;
                   19819:                                         }
                   19820:                                     }
                   19821:                                 }
                   19822:                             }
                   19823:                         }
                   19824:                     }
                   19825:                 }
                   19826:             } elsif ($xframeop ne '') {
                   19827:                 $uselink = 1;
                   19828:                 my @policies = split(/\s*,\s*/,$xframeop);
                   19829:                 if (@policies) {
                   19830:                     unless (grep(/^deny$/,@policies)) {
                   19831:                         if ($origin ne '') {
                   19832:                             if (grep(/^sameorigin$/,@policies)) {
                   19833:                                 if ($remotehost eq $origin) {
                   19834:                                     undef($uselink);
                   19835:                                 }
                   19836:                             }
                   19837:                             if ($uselink) {
                   19838:                                 foreach my $policy (@policies) {
                   19839:                                     if ($policy =~ /^allow-from\s*(.+)$/) {
                   19840:                                         my $allowfrom = $1;
                   19841:                                         if (($allowfrom ne '') && ($allowfrom eq $origin)) {
                   19842:                                             undef($uselink);
                   19843:                                             last;
                   19844:                                         }
                   19845:                                     }
                   19846:                                 }
                   19847:                             }
                   19848:                         }
                   19849:                     }
                   19850:                 }
                   19851:             }
                   19852:         }
                   19853:     }
1.1329    raeburn  19854:     if ($nocache) {
                   19855:         if ($cached) {
                   19856:             my $devalidate;
                   19857:             if ($uselink && !$result) {
                   19858:                 $devalidate = 1;
                   19859:             } elsif (!$uselink && $result) {
                   19860:                 $devalidate = 1;
                   19861:             }
                   19862:             if ($devalidate) {
                   19863:                 &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
                   19864:             }
                   19865:         }
                   19866:     } else {
                   19867:         if ($uselink) {
                   19868:             $result = 1;
                   19869:         } else {
                   19870:             $result = 0;
                   19871:         }
                   19872:         &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
                   19873:     }
1.1328    raeburn  19874:     return $uselink;
                   19875: }
                   19876: 
1.1359    raeburn  19877: sub page_menu {
                   19878:     my ($menucolls,$menunum) = @_;
                   19879:     my %menu;
                   19880:     foreach my $item (split(/;/,$menucolls)) {
                   19881:         my ($num,$value) = split(/\%/,$item);
                   19882:         if ($num eq $menunum) {
                   19883:             my @entries = split(/\&/,$value);
                   19884:             foreach my $entry (@entries) {
                   19885:                 my ($name,$fields) = split(/=/,$entry);
1.1368    raeburn  19886:                 if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) {
1.1359    raeburn  19887:                     $menu{$name} = $fields;
                   19888:                 } else {
                   19889:                     my @shown;
                   19890:                     if ($fields =~ /,/) {
                   19891:                         @shown = split(/,/,$fields);
                   19892:                     } else {
                   19893:                         @shown = ($fields);
                   19894:                     }
                   19895:                     if (@shown) {
                   19896:                         foreach my $field (@shown) {
                   19897:                             next if ($field eq '');
                   19898:                             $menu{$field} = 1;
                   19899:                         }
                   19900:                     }
                   19901:                 }
                   19902:             }
                   19903:         }
                   19904:     }
                   19905:     return %menu;
                   19906: }
                   19907: 
1.112     bowersj2 19908: 1;
                   19909: __END__;
1.41      ng       19910: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>