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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1075.2.160! raeburn     4: # $Id: loncommon.pm,v 1.1075.2.159 2021/12/17 19:59:39 raeburn Exp $
1.10      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.1       albertel   28: 
                     29: # Makes a table out of the previous attempts
1.2       albertel   30: # Inputs result_from_symbread, user, domain, course_id
1.16      harris41   31: # Reads in non-network-related .tab files
1.1       albertel   32: 
1.35      matthew    33: # POD header:
                     34: 
1.45      matthew    35: =pod
                     36: 
1.35      matthew    37: =head1 NAME
                     38: 
                     39: Apache::loncommon - pile of common routines
                     40: 
                     41: =head1 SYNOPSIS
                     42: 
1.112     bowersj2   43: Common routines for manipulating connections, student answers,
                     44:     domains, common Javascript fragments, etc.
1.35      matthew    45: 
1.112     bowersj2   46: =head1 OVERVIEW
1.35      matthew    47: 
1.112     bowersj2   48: A collection of commonly used subroutines that don't have a natural
                     49: home anywhere else. This collection helps remove
1.35      matthew    50: redundancy from other modules and increase efficiency of memory usage.
                     51: 
                     52: =cut 
                     53: 
                     54: # End of POD header
1.1       albertel   55: package Apache::loncommon;
                     56: 
                     57: use strict;
1.258     albertel   58: use Apache::lonnet;
1.46      matthew    59: use GDBM_File;
1.51      www        60: use POSIX qw(strftime mktime);
1.82      www        61: use Apache::lonmenu();
1.498     albertel   62: use Apache::lonenc();
1.117     www        63: use Apache::lonlocal;
1.685     tempelho   64: use Apache::lonnet();
1.139     matthew    65: use HTML::Entities;
1.334     albertel   66: use Apache::lonhtmlcommon();
                     67: use Apache::loncoursedata();
1.344     albertel   68: use Apache::lontexconvert();
1.444     albertel   69: use Apache::lonclonecourse();
1.1075.2.25  raeburn    70: use Apache::lonuserutils();
1.1075.2.27  raeburn    71: use Apache::lonuserstate();
1.1075.2.69  raeburn    72: use Apache::courseclassifier();
1.479     albertel   73: use LONCAPA qw(:DEFAULT :match);
1.1075.2.135  raeburn    74: use HTTP::Request;
1.657     raeburn    75: use DateTime::TimeZone;
1.1075.2.102  raeburn    76: use DateTime::Locale;
1.1075.2.94  raeburn    77: use Encode();
1.1075.2.14  raeburn    78: use Authen::Captcha;
                     79: use Captcha::reCAPTCHA;
1.1075.2.107  raeburn    80: use JSON::DWIW;
                     81: use LWP::UserAgent;
1.1075.2.64  raeburn    82: use Crypt::DES;
                     83: use DynaLoader; # for Crypt::DES version
1.1075.2.128  raeburn    84: use File::Copy();
                     85: use File::Path();
1.117     www        86: 
1.517     raeburn    87: # ---------------------------------------------- Designs
                     88: use vars qw(%defaultdesign);
                     89: 
1.22      www        90: my $readit;
                     91: 
1.517     raeburn    92: 
1.157     matthew    93: ##
                     94: ## Global Variables
                     95: ##
1.46      matthew    96: 
1.643     foxr       97: 
                     98: # ----------------------------------------------- SSI with retries:
                     99: #
                    100: 
                    101: =pod
                    102: 
1.648     raeburn   103: =head1 Server Side include with retries:
1.643     foxr      104: 
                    105: =over 4
                    106: 
1.648     raeburn   107: =item * &ssi_with_retries(resource,retries form)
1.643     foxr      108: 
                    109: Performs an ssi with some number of retries.  Retries continue either
                    110: until the result is ok or until the retry count supplied by the
                    111: caller is exhausted.  
                    112: 
                    113: Inputs:
1.648     raeburn   114: 
                    115: =over 4
                    116: 
1.643     foxr      117: resource   - Identifies the resource to insert.
1.648     raeburn   118: 
1.643     foxr      119: retries    - Count of the number of retries allowed.
1.648     raeburn   120: 
1.643     foxr      121: form       - Hash that identifies the rendering options.
                    122: 
1.648     raeburn   123: =back
                    124: 
                    125: Returns:
                    126: 
                    127: =over 4
                    128: 
1.643     foxr      129: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   130: 
1.643     foxr      131: response   - The response from the last attempt (which may or may not have been successful.
                    132: 
1.648     raeburn   133: =back
                    134: 
                    135: =back
                    136: 
1.643     foxr      137: =cut
                    138: 
                    139: sub ssi_with_retries {
                    140:     my ($resource, $retries, %form) = @_;
                    141: 
                    142: 
                    143:     my $ok = 0;			# True if we got a good response.
                    144:     my $content;
                    145:     my $response;
                    146: 
                    147:     # Try to get the ssi done. within the retries count:
                    148: 
                    149:     do {
                    150: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    151: 	$ok      = $response->is_success;
1.650     www       152:         if (!$ok) {
                    153:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    154:         }
1.643     foxr      155: 	$retries--;
                    156:     } while (!$ok && ($retries > 0));
                    157: 
                    158:     if (!$ok) {
                    159: 	$content = '';		# On error return an empty content.
                    160:     }
                    161:     return ($content, $response);
                    162: 
                    163: }
                    164: 
                    165: 
                    166: 
1.20      www       167: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  168: my %language;
1.124     www       169: my %supported_language;
1.1048    foxr      170: my %latex_language;		# For choosing hyphenation in <transl..>
                    171: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  172: my %cprtag;
1.192     taceyjo1  173: my %scprtag;
1.351     www       174: my %fe; my %fd; my %fm;
1.41      ng        175: my %category_extensions;
1.12      harris41  176: 
1.46      matthew   177: # ---------------------------------------------- Thesaurus variables
1.144     matthew   178: #
                    179: # %Keywords:
                    180: #      A hash used by &keyword to determine if a word is considered a keyword.
                    181: # $thesaurus_db_file 
                    182: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   183: 
                    184: my %Keywords;
                    185: my $thesaurus_db_file;
                    186: 
1.144     matthew   187: #
                    188: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    189: # thesaurus.tab, and filecategories.tab.
                    190: #
1.18      www       191: BEGIN {
1.46      matthew   192:     # Variable initialization
                    193:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    194:     #
1.22      www       195:     unless ($readit) {
1.12      harris41  196: # ------------------------------------------------------------------- languages
                    197:     {
1.158     raeburn   198:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    199:                                    '/language.tab';
1.1075.2.128  raeburn   200:         if ( open(my $fh,'<',$langtabfile) ) {
1.356     albertel  201:             while (my $line = <$fh>) {
                    202:                 next if ($line=~/^\#/);
                    203:                 chomp($line);
1.1048    foxr      204:                 my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   205:                 $language{$key}=$val.' - '.$enc;
                    206:                 if ($sup) {
                    207:                     $supported_language{$key}=$sup;
                    208:                 }
1.1048    foxr      209: 		if ($latex) {
                    210: 		    $latex_language_bykey{$key} = $latex;
                    211: 		    $latex_language{$two} = $latex;
                    212: 		}
1.158     raeburn   213:             }
                    214:             close($fh);
                    215:         }
1.12      harris41  216:     }
                    217: # ------------------------------------------------------------------ copyrights
                    218:     {
1.158     raeburn   219:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    220:                                   '/copyright.tab';
1.1075.2.128  raeburn   221:         if ( open (my $fh,'<',$copyrightfile) ) {
1.356     albertel  222:             while (my $line = <$fh>) {
                    223:                 next if ($line=~/^\#/);
                    224:                 chomp($line);
                    225:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   226:                 $cprtag{$key}=$val;
                    227:             }
                    228:             close($fh);
                    229:         }
1.12      harris41  230:     }
1.351     www       231: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  232:     {
                    233:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    234:                                   '/source_copyright.tab';
1.1075.2.128  raeburn   235:         if ( open (my $fh,'<',$sourcecopyrightfile) ) {
1.356     albertel  236:             while (my $line = <$fh>) {
                    237:                 next if ($line =~ /^\#/);
                    238:                 chomp($line);
                    239:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  240:                 $scprtag{$key}=$val;
                    241:             }
                    242:             close($fh);
                    243:         }
                    244:     }
1.63      www       245: 
1.517     raeburn   246: # -------------------------------------------------------------- default domain designs
1.63      www       247:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   248:     my $designfile = $designdir.'/default.tab';
1.1075.2.128  raeburn   249:     if ( open (my $fh,'<',$designfile) ) {
1.517     raeburn   250:         while (my $line = <$fh>) {
                    251:             next if ($line =~ /^\#/);
                    252:             chomp($line);
                    253:             my ($key,$val)=(split(/\=/,$line));
                    254:             if ($val) { $defaultdesign{$key}=$val; }
                    255:         }
                    256:         close($fh);
1.63      www       257:     }
                    258: 
1.15      harris41  259: # ------------------------------------------------------------- file categories
                    260:     {
1.158     raeburn   261:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    262:                                   '/filecategories.tab';
1.1075.2.128  raeburn   263:         if ( open (my $fh,'<',$categoryfile) ) {
1.356     albertel  264: 	    while (my $line = <$fh>) {
                    265: 		next if ($line =~ /^\#/);
                    266: 		chomp($line);
                    267:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.1075.2.119  raeburn   268:                 push(@{$category_extensions{lc($category)}},$extension);
1.158     raeburn   269:             }
                    270:             close($fh);
                    271:         }
                    272: 
1.15      harris41  273:     }
1.12      harris41  274: # ------------------------------------------------------------------ file types
                    275:     {
1.158     raeburn   276:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    277:                '/filetypes.tab';
1.1075.2.128  raeburn   278:         if ( open (my $fh,'<',$typesfile) ) {
1.356     albertel  279:             while (my $line = <$fh>) {
                    280: 		next if ($line =~ /^\#/);
                    281: 		chomp($line);
                    282:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   283:                 if ($descr ne '') {
                    284:                     $fe{$ending}=lc($emb);
                    285:                     $fd{$ending}=$descr;
1.351     www       286:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   287:                 }
                    288:             }
                    289:             close($fh);
                    290:         }
1.12      harris41  291:     }
1.22      www       292:     &Apache::lonnet::logthis(
1.705     tempelho  293:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       294:     $readit=1;
1.46      matthew   295:     }  # end of unless($readit) 
1.32      matthew   296:     
                    297: }
1.112     bowersj2  298: 
1.42      matthew   299: ###############################################################
                    300: ##           HTML and Javascript Helper Functions            ##
                    301: ###############################################################
                    302: 
                    303: =pod 
                    304: 
1.112     bowersj2  305: =head1 HTML and Javascript Functions
1.42      matthew   306: 
1.112     bowersj2  307: =over 4
                    308: 
1.648     raeburn   309: =item * &browser_and_searcher_javascript()
1.112     bowersj2  310: 
                    311: X<browsing, javascript>X<searching, javascript>Returns a string
                    312: containing javascript with two functions, C<openbrowser> and
                    313: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    314: tags.
1.42      matthew   315: 
1.648     raeburn   316: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   317: 
                    318: inputs: formname, elementname, only, omit
                    319: 
                    320: formname and elementname indicate the name of the html form and name of
                    321: the element that the results of the browsing selection are to be placed in. 
                    322: 
                    323: Specifying 'only' will restrict the browser to displaying only files
1.185     www       324: with the given extension.  Can be a comma separated list.
1.42      matthew   325: 
                    326: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       327: with the given extension.  Can be a comma separated list.
1.42      matthew   328: 
1.648     raeburn   329: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   330: 
                    331: Inputs: formname, elementname
                    332: 
                    333: formname and elementname specify the name of the html form and the name
                    334: of the element the selection from the search results will be placed in.
1.542     raeburn   335: 
1.42      matthew   336: =cut
                    337: 
                    338: sub browser_and_searcher_javascript {
1.199     albertel  339:     my ($mode)=@_;
                    340:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  341:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   342:     return <<END;
1.219     albertel  343: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   344:     var editbrowser = null;
1.135     albertel  345:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       346:         var url = '$resurl/?';
1.42      matthew   347:         if (editbrowser == null) {
                    348:             url += 'launch=1&';
                    349:         }
                    350:         url += 'catalogmode=interactive&';
1.199     albertel  351:         url += 'mode=$mode&';
1.611     albertel  352:         url += 'inhibitmenu=yes&';
1.42      matthew   353:         url += 'form=' + formname + '&';
                    354:         if (only != null) {
                    355:             url += 'only=' + only + '&';
1.217     albertel  356:         } else {
                    357:             url += 'only=&';
                    358: 	}
1.42      matthew   359:         if (omit != null) {
                    360:             url += 'omit=' + omit + '&';
1.217     albertel  361:         } else {
                    362:             url += 'omit=&';
                    363: 	}
1.135     albertel  364:         if (titleelement != null) {
                    365:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  366:         } else {
                    367: 	    url += 'titleelement=&';
                    368: 	}
1.42      matthew   369:         url += 'element=' + elementname + '';
                    370:         var title = 'Browser';
1.435     albertel  371:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   372:         options += ',width=700,height=600';
                    373:         editbrowser = open(url,title,options,'1');
                    374:         editbrowser.focus();
                    375:     }
                    376:     var editsearcher;
1.135     albertel  377:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   378:         var url = '/adm/searchcat?';
                    379:         if (editsearcher == null) {
                    380:             url += 'launch=1&';
                    381:         }
                    382:         url += 'catalogmode=interactive&';
1.199     albertel  383:         url += 'mode=$mode&';
1.42      matthew   384:         url += 'form=' + formname + '&';
1.135     albertel  385:         if (titleelement != null) {
                    386:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  387:         } else {
                    388: 	    url += 'titleelement=&';
                    389: 	}
1.42      matthew   390:         url += 'element=' + elementname + '';
                    391:         var title = 'Search';
1.435     albertel  392:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   393:         options += ',width=700,height=600';
                    394:         editsearcher = open(url,title,options,'1');
                    395:         editsearcher.focus();
                    396:     }
1.219     albertel  397: // END LON-CAPA Internal -->
1.42      matthew   398: END
1.170     www       399: }
                    400: 
                    401: sub lastresurl {
1.258     albertel  402:     if ($env{'environment.lastresurl'}) {
                    403: 	return $env{'environment.lastresurl'}
1.170     www       404:     } else {
                    405: 	return '/res';
                    406:     }
                    407: }
                    408: 
                    409: sub storeresurl {
                    410:     my $resurl=&Apache::lonnet::clutter(shift);
                    411:     unless ($resurl=~/^\/res/) { return 0; }
                    412:     $resurl=~s/\/$//;
                    413:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   414:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       415:     return 1;
1.42      matthew   416: }
                    417: 
1.74      www       418: sub studentbrowser_javascript {
1.111     www       419:    unless (
1.258     albertel  420:             (($env{'request.course.id'}) && 
1.302     albertel  421:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    422: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    423: 					  '/'.$env{'request.course.sec'})
                    424: 	      ))
1.258     albertel  425:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       426:           ) { return ''; }  
1.74      www       427:    return (<<'ENDSTDBRW');
1.776     bisitz    428: <script type="text/javascript" language="Javascript">
1.824     bisitz    429: // <![CDATA[
1.74      www       430:     var stdeditbrowser;
1.1075.2.143  raeburn   431:     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) {
1.74      www       432:         var url = '/adm/pickstudent?';
                    433:         var filter;
1.558     albertel  434: 	if (!ignorefilter) {
                    435: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    436: 	}
1.74      www       437:         if (filter != null) {
                    438:            if (filter != '') {
                    439:                url += 'filter='+filter+'&';
                    440: 	   }
                    441:         }
                    442:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       443:                                     '&udomelement='+udom+
                    444:                                     '&clicker='+clicker;
1.111     www       445: 	if (roleflag) { url+="&roles=1"; }
1.1075.2.143  raeburn   446:         if (courseadv == 'condition') {
                    447:             if (document.getElementById('courseadv')) {
                    448:                 courseadv = document.getElementById('courseadv').value;
                    449:             }
                    450:         }
                    451:         if ((courseadv == 'only') || (courseadv == 'none')) { url+="&courseadv="+courseadv; }
1.102     www       452:         var title = 'Student_Browser';
1.74      www       453:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    454:         options += ',width=700,height=600';
                    455:         stdeditbrowser = open(url,title,options,'1');
                    456:         stdeditbrowser.focus();
                    457:     }
1.824     bisitz    458: // ]]>
1.74      www       459: </script>
                    460: ENDSTDBRW
                    461: }
1.42      matthew   462: 
1.1003    www       463: sub resourcebrowser_javascript {
                    464:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       465:    return (<<'ENDRESBRW');
1.1003    www       466: <script type="text/javascript" language="Javascript">
                    467: // <![CDATA[
                    468:     var reseditbrowser;
1.1004    www       469:     function openresbrowser(formname,reslink) {
1.1005    www       470:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       471:         var title = 'Resource_Browser';
                    472:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       473:         options += ',width=700,height=500';
1.1004    www       474:         reseditbrowser = open(url,title,options,'1');
                    475:         reseditbrowser.focus();
1.1003    www       476:     }
                    477: // ]]>
                    478: </script>
1.1004    www       479: ENDRESBRW
1.1003    www       480: }
                    481: 
1.74      www       482: sub selectstudent_link {
1.1075.2.143  raeburn   483:    my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_;
1.999     www       484:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    485:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    486:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  487:    if ($env{'request.course.id'}) {  
1.302     albertel  488:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    489: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    490: 					'/'.$env{'request.course.sec'})) {
1.111     www       491: 	   return '';
                    492:        }
1.999     www       493:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.1075.2.143  raeburn   494:        if ($courseadv eq 'only') {
                    495:            $callargs .= ",'',1,'$courseadv'";
                    496:        } elsif ($courseadv eq 'none') {
                    497:            $callargs .= ",'','','$courseadv'";
                    498:        } elsif ($courseadv eq 'condition') {
                    499:            $callargs .= ",'','','$courseadv'";
1.793     raeburn   500:        }
                    501:        return '<span class="LC_nobreak">'.
                    502:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    503:               &mt('Select User').'</a></span>';
1.74      www       504:    }
1.258     albertel  505:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       506:        $callargs .= ",'',1"; 
1.793     raeburn   507:        return '<span class="LC_nobreak">'.
                    508:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    509:               &mt('Select User').'</a></span>';
1.111     www       510:    }
                    511:    return '';
1.91      www       512: }
                    513: 
1.1004    www       514: sub selectresource_link {
                    515:    my ($form,$reslink,$arg)=@_;
                    516:    
                    517:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    518:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    519:    unless ($env{'request.course.id'}) { return $arg; }
                    520:    return '<span class="LC_nobreak">'.
                    521:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    522:               $arg.'</a></span>';
                    523: }
                    524: 
                    525: 
                    526: 
1.653     raeburn   527: sub authorbrowser_javascript {
                    528:     return <<"ENDAUTHORBRW";
1.776     bisitz    529: <script type="text/javascript" language="JavaScript">
1.824     bisitz    530: // <![CDATA[
1.653     raeburn   531: var stdeditbrowser;
                    532: 
                    533: function openauthorbrowser(formname,udom) {
                    534:     var url = '/adm/pickauthor?';
                    535:     url += 'form='+formname+'&roledom='+udom;
                    536:     var title = 'Author_Browser';
                    537:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    538:     options += ',width=700,height=600';
                    539:     stdeditbrowser = open(url,title,options,'1');
                    540:     stdeditbrowser.focus();
                    541: }
                    542: 
1.824     bisitz    543: // ]]>
1.653     raeburn   544: </script>
                    545: ENDAUTHORBRW
                    546: }
                    547: 
1.91      www       548: sub coursebrowser_javascript {
1.1075.2.31  raeburn   549:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1075.2.95  raeburn   550:         $credits_element,$instcode) = @_;
1.932     raeburn   551:     my $wintitle = 'Course_Browser';
1.931     raeburn   552:     if ($crstype eq 'Community') {
1.932     raeburn   553:         $wintitle = 'Community_Browser';
1.909     raeburn   554:     }
1.876     raeburn   555:     my $id_functions = &javascript_index_functions();
                    556:     my $output = '
1.776     bisitz    557: <script type="text/javascript" language="JavaScript">
1.824     bisitz    558: // <![CDATA[
1.468     raeburn   559:     var stdeditbrowser;'."\n";
1.876     raeburn   560: 
                    561:     $output .= <<"ENDSTDBRW";
1.909     raeburn   562:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       563:         var url = '/adm/pickcourse?';
1.895     raeburn   564:         var formid = getFormIdByName(formname);
1.876     raeburn   565:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  566:         if (domainfilter != null) {
                    567:            if (domainfilter != '') {
                    568:                url += 'domainfilter='+domainfilter+'&';
                    569: 	   }
                    570:         }
1.91      www       571:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  572: 	                            '&cdomelement='+udom+
                    573:                                     '&cnameelement='+desc;
1.468     raeburn   574:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   575:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   576:                 url += '&roleelement='+extra_element;
                    577:                 if (domainfilter == null || domainfilter == '') {
                    578:                     url += '&domainfilter='+extra_element;
                    579:                 }
1.234     raeburn   580:             }
1.468     raeburn   581:             else {
                    582:                 if (formname == 'portform') {
                    583:                     url += '&setroles='+extra_element;
1.800     raeburn   584:                 } else {
                    585:                     if (formname == 'rules') {
                    586:                         url += '&fixeddom='+extra_element; 
                    587:                     }
1.468     raeburn   588:                 }
                    589:             }     
1.230     raeburn   590:         }
1.909     raeburn   591:         if (type != null && type != '') {
                    592:             url += '&type='+type;
                    593:         }
                    594:         if (type_elem != null && type_elem != '') {
                    595:             url += '&typeelement='+type_elem;
                    596:         }
1.872     raeburn   597:         if (formname == 'ccrs') {
                    598:             var ownername = document.forms[formid].ccuname.value;
                    599:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1075.2.101  raeburn   600:             url += '&cloner='+ownername+':'+ownerdom;
                    601:             if (type == 'Course') {
                    602:                 url += '&crscode='+document.forms[formid].crscode.value;
                    603:             }
1.1075.2.95  raeburn   604:         }
                    605:         if (formname == 'requestcrs') {
                    606:             url += '&crsdom=$domainfilter&crscode=$instcode';
1.872     raeburn   607:         }
1.293     raeburn   608:         if (multflag !=null && multflag != '') {
                    609:             url += '&multiple='+multflag;
                    610:         }
1.909     raeburn   611:         var title = '$wintitle';
1.91      www       612:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    613:         options += ',width=700,height=600';
                    614:         stdeditbrowser = open(url,title,options,'1');
                    615:         stdeditbrowser.focus();
                    616:     }
1.876     raeburn   617: $id_functions
                    618: ENDSTDBRW
1.1075.2.31  raeburn   619:     if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
                    620:         $output .= &setsec_javascript($sec_element,$formname,$role_element,
                    621:                                       $credits_element);
1.876     raeburn   622:     }
                    623:     $output .= '
                    624: // ]]>
                    625: </script>';
                    626:     return $output;
                    627: }
                    628: 
                    629: sub javascript_index_functions {
                    630:     return <<"ENDJS";
                    631: 
                    632: function getFormIdByName(formname) {
                    633:     for (var i=0;i<document.forms.length;i++) {
                    634:         if (document.forms[i].name == formname) {
                    635:             return i;
                    636:         }
                    637:     }
                    638:     return -1;
                    639: }
                    640: 
                    641: function getIndexByName(formid,item) {
                    642:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    643:         if (document.forms[formid].elements[i].name == item) {
                    644:             return i;
                    645:         }
                    646:     }
                    647:     return -1;
                    648: }
1.468     raeburn   649: 
1.876     raeburn   650: function getDomainFromSelectbox(formname,udom) {
                    651:     var userdom;
                    652:     var formid = getFormIdByName(formname);
                    653:     if (formid > -1) {
                    654:         var domid = getIndexByName(formid,udom);
                    655:         if (domid > -1) {
                    656:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    657:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    658:             }
                    659:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    660:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   661:             }
                    662:         }
                    663:     }
1.876     raeburn   664:     return userdom;
                    665: }
                    666: 
                    667: ENDJS
1.468     raeburn   668: 
1.876     raeburn   669: }
                    670: 
1.1017    raeburn   671: sub javascript_array_indexof {
1.1018    raeburn   672:     return <<ENDJS;
1.1017    raeburn   673: <script type="text/javascript" language="JavaScript">
                    674: // <![CDATA[
                    675: 
                    676: if (!Array.prototype.indexOf) {
                    677:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    678:         "use strict";
                    679:         if (this === void 0 || this === null) {
                    680:             throw new TypeError();
                    681:         }
                    682:         var t = Object(this);
                    683:         var len = t.length >>> 0;
                    684:         if (len === 0) {
                    685:             return -1;
                    686:         }
                    687:         var n = 0;
                    688:         if (arguments.length > 0) {
                    689:             n = Number(arguments[1]);
                    690:             if (n !== n) { // shortcut for verifying if it's NaN
                    691:                 n = 0;
                    692:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    693:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    694:             }
                    695:         }
                    696:         if (n >= len) {
                    697:             return -1;
                    698:         }
                    699:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    700:         for (; k < len; k++) {
                    701:             if (k in t && t[k] === searchElement) {
                    702:                 return k;
                    703:             }
                    704:         }
                    705:         return -1;
                    706:     }
                    707: }
                    708: 
                    709: // ]]>
                    710: </script>
                    711: 
                    712: ENDJS
                    713: 
                    714: }
                    715: 
1.876     raeburn   716: sub userbrowser_javascript {
                    717:     my $id_functions = &javascript_index_functions();
                    718:     return <<"ENDUSERBRW";
                    719: 
1.888     raeburn   720: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   721:     var url = '/adm/pickuser?';
                    722:     var userdom = getDomainFromSelectbox(formname,udom);
                    723:     if (userdom != null) {
                    724:        if (userdom != '') {
                    725:            url += 'srchdom='+userdom+'&';
                    726:        }
                    727:     }
                    728:     url += 'form=' + formname + '&unameelement='+uname+
                    729:                                 '&udomelement='+udom+
                    730:                                 '&ulastelement='+ulast+
                    731:                                 '&ufirstelement='+ufirst+
                    732:                                 '&uemailelement='+uemail+
1.881     raeburn   733:                                 '&hideudomelement='+hideudom+
                    734:                                 '&coursedom='+crsdom;
1.888     raeburn   735:     if ((caller != null) && (caller != undefined)) {
                    736:         url += '&caller='+caller;
                    737:     }
1.876     raeburn   738:     var title = 'User_Browser';
                    739:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    740:     options += ',width=700,height=600';
                    741:     var stdeditbrowser = open(url,title,options,'1');
                    742:     stdeditbrowser.focus();
                    743: }
                    744: 
1.888     raeburn   745: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   746:     var formid = getFormIdByName(formname);
                    747:     if (formid > -1) {
1.888     raeburn   748:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   749:         var domid = getIndexByName(formid,udom);
                    750:         var hidedomid = getIndexByName(formid,origdom);
                    751:         if (hidedomid > -1) {
                    752:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   753:             var unameval = document.forms[formid].elements[unameid].value;
                    754:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    755:                 if (domid > -1) {
                    756:                     var slct = document.forms[formid].elements[domid];
                    757:                     if (slct.type == 'select-one') {
                    758:                         var i;
                    759:                         for (i=0;i<slct.length;i++) {
                    760:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    761:                         }
                    762:                     }
                    763:                     if (slct.type == 'hidden') {
                    764:                         slct.value = fixeddom;
1.876     raeburn   765:                     }
                    766:                 }
1.468     raeburn   767:             }
                    768:         }
                    769:     }
1.876     raeburn   770:     return;
                    771: }
                    772: 
                    773: $id_functions
                    774: ENDUSERBRW
1.468     raeburn   775: }
                    776: 
                    777: sub setsec_javascript {
1.1075.2.31  raeburn   778:     my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905     raeburn   779:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    780:         $communityrolestr);
                    781:     if ($role_element ne '') {
                    782:         my @allroles = ('st','ta','ep','in','ad');
                    783:         foreach my $crstype ('Course','Community') {
                    784:             if ($crstype eq 'Community') {
                    785:                 foreach my $role (@allroles) {
                    786:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    787:                 }
                    788:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    789:             } else {
                    790:                 foreach my $role (@allroles) {
                    791:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    792:                 }
                    793:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    794:             }
                    795:         }
                    796:         $rolestr = '"'.join('","',@allroles).'"';
                    797:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    798:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    799:     }
1.468     raeburn   800:     my $setsections = qq|
                    801: function setSect(sectionlist) {
1.629     raeburn   802:     var sectionsArray = new Array();
                    803:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    804:         sectionsArray = sectionlist.split(",");
                    805:     }
1.468     raeburn   806:     var numSections = sectionsArray.length;
                    807:     document.$formname.$sec_element.length = 0;
                    808:     if (numSections == 0) {
                    809:         document.$formname.$sec_element.multiple=false;
                    810:         document.$formname.$sec_element.size=1;
                    811:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    812:     } else {
                    813:         if (numSections == 1) {
                    814:             document.$formname.$sec_element.multiple=false;
                    815:             document.$formname.$sec_element.size=1;
                    816:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    817:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    818:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    819:         } else {
                    820:             for (var i=0; i<numSections; i++) {
                    821:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    822:             }
                    823:             document.$formname.$sec_element.multiple=true
                    824:             if (numSections < 3) {
                    825:                 document.$formname.$sec_element.size=numSections;
                    826:             } else {
                    827:                 document.$formname.$sec_element.size=3;
                    828:             }
                    829:             document.$formname.$sec_element.options[0].selected = false
                    830:         }
                    831:     }
1.91      www       832: }
1.905     raeburn   833: 
                    834: function setRole(crstype) {
1.468     raeburn   835: |;
1.905     raeburn   836:     if ($role_element eq '') {
                    837:         $setsections .= '    return;
                    838: }
                    839: ';
                    840:     } else {
                    841:         $setsections .= qq|
                    842:     var elementLength = document.$formname.$role_element.length;
                    843:     var allroles = Array($rolestr);
                    844:     var courserolenames = Array($courserolestr);
                    845:     var communityrolenames = Array($communityrolestr);
                    846:     if (elementLength != undefined) {
                    847:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    848:             if (crstype == 'Course') {
                    849:                 return;
                    850:             } else {
                    851:                 allroles[5] = 'co';
                    852:                 for (var i=0; i<6; i++) {
                    853:                     document.$formname.$role_element.options[i].value = allroles[i];
                    854:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    855:                 }
                    856:             }
                    857:         } else {
                    858:             if (crstype == 'Community') {
                    859:                 return;
                    860:             } else {
                    861:                 allroles[5] = 'cc';
                    862:                 for (var i=0; i<6; i++) {
                    863:                     document.$formname.$role_element.options[i].value = allroles[i];
                    864:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    865:                 }
                    866:             }
                    867:         }
                    868:     }
                    869:     return;
                    870: }
                    871: |;
                    872:     }
1.1075.2.31  raeburn   873:     if ($credits_element) {
                    874:         $setsections .= qq|
                    875: function setCredits(defaultcredits) {
                    876:     document.$formname.$credits_element.value = defaultcredits;
                    877:     return;
                    878: }
                    879: |;
                    880:     }
1.468     raeburn   881:     return $setsections;
                    882: }
                    883: 
1.91      www       884: sub selectcourse_link {
1.909     raeburn   885:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    886:        $typeelement) = @_;
                    887:    my $type = $selecttype;
1.871     raeburn   888:    my $linktext = &mt('Select Course');
                    889:    if ($selecttype eq 'Community') {
1.909     raeburn   890:        $linktext = &mt('Select Community');
1.906     raeburn   891:    } elsif ($selecttype eq 'Course/Community') {
                    892:        $linktext = &mt('Select Course/Community');
1.909     raeburn   893:        $type = '';
1.1019    raeburn   894:    } elsif ($selecttype eq 'Select') {
                    895:        $linktext = &mt('Select');
                    896:        $type = '';
1.871     raeburn   897:    }
1.787     bisitz    898:    return '<span class="LC_nobreak">'
                    899:          ."<a href='"
                    900:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    901:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   902:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   903:          ."'>".$linktext.'</a>'
1.787     bisitz    904:          .'</span>';
1.74      www       905: }
1.42      matthew   906: 
1.653     raeburn   907: sub selectauthor_link {
                    908:    my ($form,$udom)=@_;
                    909:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    910:           &mt('Select Author').'</a>';
                    911: }
                    912: 
1.876     raeburn   913: sub selectuser_link {
1.881     raeburn   914:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   915:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   916:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   917:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   918:            ');">'.$linktext.'</a>';
1.876     raeburn   919: }
                    920: 
1.273     raeburn   921: sub check_uncheck_jscript {
                    922:     my $jscript = <<"ENDSCRT";
                    923: function checkAll(field) {
                    924:     if (field.length > 0) {
                    925:         for (i = 0; i < field.length; i++) {
1.1075.2.14  raeburn   926:             if (!field[i].disabled) {
                    927:                 field[i].checked = true;
                    928:             }
1.273     raeburn   929:         }
                    930:     } else {
1.1075.2.14  raeburn   931:         if (!field.disabled) {
                    932:             field.checked = true;
                    933:         }
1.273     raeburn   934:     }
                    935: }
                    936:  
                    937: function uncheckAll(field) {
                    938:     if (field.length > 0) {
                    939:         for (i = 0; i < field.length; i++) {
                    940:             field[i].checked = false ;
1.543     albertel  941:         }
                    942:     } else {
1.273     raeburn   943:         field.checked = false ;
                    944:     }
                    945: }
                    946: ENDSCRT
                    947:     return $jscript;
                    948: }
                    949: 
1.656     www       950: sub select_timezone {
1.1075.2.115  raeburn   951:    my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
                    952:    my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.659     raeburn   953:    if ($includeempty) {
                    954:        $output .= '<option value=""';
                    955:        if (($selected eq '') || ($selected eq 'local')) {
                    956:            $output .= ' selected="selected" ';
                    957:        }
                    958:        $output .= '> </option>';
                    959:    }
1.657     raeburn   960:    my @timezones = DateTime::TimeZone->all_names;
                    961:    foreach my $tzone (@timezones) {
                    962:        $output.= '<option value="'.$tzone.'"';
                    963:        if ($tzone eq $selected) {
                    964:            $output.=' selected="selected"';
                    965:        }
                    966:        $output.=">$tzone</option>\n";
1.656     www       967:    }
                    968:    $output.="</select>";
                    969:    return $output;
                    970: }
1.273     raeburn   971: 
1.687     raeburn   972: sub select_datelocale {
1.1075.2.115  raeburn   973:     my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
                    974:     my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.687     raeburn   975:     if ($includeempty) {
                    976:         $output .= '<option value=""';
                    977:         if ($selected eq '') {
                    978:             $output .= ' selected="selected" ';
                    979:         }
                    980:         $output .= '> </option>';
                    981:     }
1.1075.2.102  raeburn   982:     my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   983:     my (@possibles,%locale_names);
1.1075.2.102  raeburn   984:     my @locales = DateTime::Locale->ids();
                    985:     foreach my $id (@locales) {
                    986:         if ($id ne '') {
                    987:             my ($en_terr,$native_terr);
                    988:             my $loc = DateTime::Locale->load($id);
                    989:             if (ref($loc)) {
                    990:                 $en_terr = $loc->name();
                    991:                 $native_terr = $loc->native_name();
1.687     raeburn   992:                 if (grep(/^en$/,@languages) || !@languages) {
                    993:                     if ($en_terr ne '') {
                    994:                         $locale_names{$id} = '('.$en_terr.')';
                    995:                     } elsif ($native_terr ne '') {
                    996:                         $locale_names{$id} = $native_terr;
                    997:                     }
                    998:                 } else {
                    999:                     if ($native_terr ne '') {
                   1000:                         $locale_names{$id} = $native_terr.' ';
                   1001:                     } elsif ($en_terr ne '') {
                   1002:                         $locale_names{$id} = '('.$en_terr.')';
                   1003:                     }
                   1004:                 }
1.1075.2.94  raeburn  1005:                 $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1075.2.102  raeburn  1006:                 push(@possibles,$id);
1.687     raeburn  1007:             }
                   1008:         }
                   1009:     }
                   1010:     foreach my $item (sort(@possibles)) {
                   1011:         $output.= '<option value="'.$item.'"';
                   1012:         if ($item eq $selected) {
                   1013:             $output.=' selected="selected"';
                   1014:         }
                   1015:         $output.=">$item";
                   1016:         if ($locale_names{$item} ne '') {
1.1075.2.94  raeburn  1017:             $output.='  '.$locale_names{$item};
1.687     raeburn  1018:         }
                   1019:         $output.="</option>\n";
                   1020:     }
                   1021:     $output.="</select>";
                   1022:     return $output;
                   1023: }
                   1024: 
1.792     raeburn  1025: sub select_language {
1.1075.2.115  raeburn  1026:     my ($name,$selected,$includeempty,$noedit) = @_;
1.792     raeburn  1027:     my %langchoices;
                   1028:     if ($includeempty) {
1.1075.2.32  raeburn  1029:         %langchoices = ('' => 'No language preference');
1.792     raeburn  1030:     }
                   1031:     foreach my $id (&languageids()) {
                   1032:         my $code = &supportedlanguagecode($id);
                   1033:         if ($code) {
                   1034:             $langchoices{$code} = &plainlanguagedescription($id);
                   1035:         }
                   1036:     }
1.1075.2.32  raeburn  1037:     %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.1075.2.115  raeburn  1038:     return &select_form($selected,$name,\%langchoices,undef,$noedit);
1.792     raeburn  1039: }
                   1040: 
1.42      matthew  1041: =pod
1.36      matthew  1042: 
1.648     raeburn  1043: =item * &linked_select_forms(...)
1.36      matthew  1044: 
                   1045: linked_select_forms returns a string containing a <script></script> block
                   1046: and html for two <select> menus.  The select menus will be linked in that
                   1047: changing the value of the first menu will result in new values being placed
                   1048: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1049: order unless a defined order is provided.
1.36      matthew  1050: 
                   1051: linked_select_forms takes the following ordered inputs:
                   1052: 
                   1053: =over 4
                   1054: 
1.112     bowersj2 1055: =item * $formname, the name of the <form> tag
1.36      matthew  1056: 
1.112     bowersj2 1057: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1058: 
1.112     bowersj2 1059: =item * $firstdefault, the default value for the first menu
1.36      matthew  1060: 
1.112     bowersj2 1061: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1062: 
1.112     bowersj2 1063: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1064: 
1.112     bowersj2 1065: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1066: 
1.609     raeburn  1067: =item * $menuorder, the order of values in the first menu
                   1068: 
1.1075.2.31  raeburn  1069: =item * $onchangefirst, additional javascript call to execute for an onchange
                   1070:         event for the first <select> tag
                   1071: 
                   1072: =item * $onchangesecond, additional javascript call to execute for an onchange
                   1073:         event for the second <select> tag
                   1074: 
1.41      ng       1075: =back 
                   1076: 
1.36      matthew  1077: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1078: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1079: values for the first select menu.  The text that coincides with the 
1.41      ng       1080: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1081: and text for the second menu are given in the hash pointed to by 
                   1082: $menu{$choice1}->{'select2'}.  
                   1083: 
1.112     bowersj2 1084:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1085:                        default => "B3",
                   1086:                        select2 => { 
                   1087:                            B1 => "Choice B1",
                   1088:                            B2 => "Choice B2",
                   1089:                            B3 => "Choice B3",
                   1090:                            B4 => "Choice B4"
1.609     raeburn  1091:                            },
                   1092:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1093:                    },
                   1094:                A2 => { text =>"Choice A2" ,
                   1095:                        default => "C2",
                   1096:                        select2 => { 
                   1097:                            C1 => "Choice C1",
                   1098:                            C2 => "Choice C2",
                   1099:                            C3 => "Choice C3"
1.609     raeburn  1100:                            },
                   1101:                        order => ['C2','C1','C3'],
1.112     bowersj2 1102:                    },
                   1103:                A3 => { text =>"Choice A3" ,
                   1104:                        default => "D6",
                   1105:                        select2 => { 
                   1106:                            D1 => "Choice D1",
                   1107:                            D2 => "Choice D2",
                   1108:                            D3 => "Choice D3",
                   1109:                            D4 => "Choice D4",
                   1110:                            D5 => "Choice D5",
                   1111:                            D6 => "Choice D6",
                   1112:                            D7 => "Choice D7"
1.609     raeburn  1113:                            },
                   1114:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1115:                    }
                   1116:                );
1.36      matthew  1117: 
                   1118: =cut
                   1119: 
                   1120: sub linked_select_forms {
                   1121:     my ($formname,
                   1122:         $middletext,
                   1123:         $firstdefault,
                   1124:         $firstselectname,
                   1125:         $secondselectname, 
1.609     raeburn  1126:         $hashref,
                   1127:         $menuorder,
1.1075.2.31  raeburn  1128:         $onchangefirst,
                   1129:         $onchangesecond
1.36      matthew  1130:         ) = @_;
                   1131:     my $second = "document.$formname.$secondselectname";
                   1132:     my $first = "document.$formname.$firstselectname";
                   1133:     # output the javascript to do the changing
                   1134:     my $result = '';
1.776     bisitz   1135:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1136:     $result.="// <![CDATA[\n";
1.36      matthew  1137:     $result.="var select2data = new Object();\n";
                   1138:     $" = '","';
                   1139:     my $debug = '';
                   1140:     foreach my $s1 (sort(keys(%$hashref))) {
                   1141:         $result.="select2data.d_$s1 = new Object();\n";        
                   1142:         $result.="select2data.d_$s1.def = new String('".
                   1143:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1144:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1145:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1146:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1147:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1148:         }
1.36      matthew  1149:         $result.="\"@s2values\");\n";
                   1150:         $result.="select2data.d_$s1.texts = new Array(";        
                   1151:         my @s2texts;
                   1152:         foreach my $value (@s2values) {
1.1075.2.119  raeburn  1153:             push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
1.36      matthew  1154:         }
                   1155:         $result.="\"@s2texts\");\n";
                   1156:     }
                   1157:     $"=' ';
                   1158:     $result.= <<"END";
                   1159: 
                   1160: function select1_changed() {
                   1161:     // Determine new choice
                   1162:     var newvalue = "d_" + $first.value;
                   1163:     // update select2
                   1164:     var values     = select2data[newvalue].values;
                   1165:     var texts      = select2data[newvalue].texts;
                   1166:     var select2def = select2data[newvalue].def;
                   1167:     var i;
                   1168:     // out with the old
                   1169:     for (i = 0; i < $second.options.length; i++) {
                   1170:         $second.options[i] = null;
                   1171:     }
                   1172:     // in with the nuclear
                   1173:     for (i=0;i<values.length; i++) {
                   1174:         $second.options[i] = new Option(values[i]);
1.143     matthew  1175:         $second.options[i].value = values[i];
1.36      matthew  1176:         $second.options[i].text = texts[i];
                   1177:         if (values[i] == select2def) {
                   1178:             $second.options[i].selected = true;
                   1179:         }
                   1180:     }
                   1181: }
1.824     bisitz   1182: // ]]>
1.36      matthew  1183: </script>
                   1184: END
                   1185:     # output the initial values for the selection lists
1.1075.2.31  raeburn  1186:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609     raeburn  1187:     my @order = sort(keys(%{$hashref}));
                   1188:     if (ref($menuorder) eq 'ARRAY') {
                   1189:         @order = @{$menuorder};
                   1190:     }
                   1191:     foreach my $value (@order) {
1.36      matthew  1192:         $result.="    <option value=\"$value\" ";
1.253     albertel 1193:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1194:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1195:     }
                   1196:     $result .= "</select>\n";
                   1197:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1198:     $result .= $middletext;
1.1075.2.31  raeburn  1199:     $result .= "<select size=\"1\" name=\"$secondselectname\"";
                   1200:     if ($onchangesecond) {
                   1201:         $result .= ' onchange="'.$onchangesecond.'"';
                   1202:     }
                   1203:     $result .= ">\n";
1.36      matthew  1204:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1205:     
                   1206:     my @secondorder = sort(keys(%select2));
                   1207:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1208:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1209:     }
                   1210:     foreach my $value (@secondorder) {
1.36      matthew  1211:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1212:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1213:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1214:     }
                   1215:     $result .= "</select>\n";
                   1216:     #    return $debug;
                   1217:     return $result;
                   1218: }   #  end of sub linked_select_forms {
                   1219: 
1.45      matthew  1220: =pod
1.44      bowersj2 1221: 
1.973     raeburn  1222: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1223: 
1.112     bowersj2 1224: Returns a string corresponding to an HTML link to the given help
                   1225: $topic, where $topic corresponds to the name of a .tex file in
                   1226: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1227: spaces. 
                   1228: 
                   1229: $text will optionally be linked to the same topic, allowing you to
                   1230: link text in addition to the graphic. If you do not want to link
                   1231: text, but wish to specify one of the later parameters, pass an
                   1232: empty string. 
                   1233: 
                   1234: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1235: the link will not open a new window. If false, the link will open
                   1236: a new window using Javascript. (Default is false.) 
                   1237: 
                   1238: $width and $height are optional numerical parameters that will
                   1239: override the width and height of the popped up window, which may
1.973     raeburn  1240: be useful for certain help topics with big pictures included.
                   1241: 
                   1242: $imgid is the id of the img tag used for the help icon. This may be
                   1243: used in a javascript call to switch the image src.  See 
                   1244: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1245: 
                   1246: =cut
                   1247: 
                   1248: sub help_open_topic {
1.973     raeburn  1249:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1250:     $text = "" if (not defined $text);
1.44      bowersj2 1251:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1252:     $width = 500 if (not defined $width);
1.44      bowersj2 1253:     $height = 400 if (not defined $height);
                   1254:     my $filename = $topic;
                   1255:     $filename =~ s/ /_/g;
                   1256: 
1.48      bowersj2 1257:     my $template = "";
                   1258:     my $link;
1.572     banghart 1259:     
1.159     www      1260:     $topic=~s/\W/\_/g;
1.44      bowersj2 1261: 
1.572     banghart 1262:     if (!$stayOnPage) {
1.1075.2.50  raeburn  1263:         if ($env{'browser.mobile'}) {
                   1264: 	    $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
                   1265:         } else {
                   1266:             $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1267:         }
1.1037    www      1268:     } elsif ($stayOnPage eq 'popup') {
                   1269:         $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 1270:     } else {
1.48      bowersj2 1271: 	$link = "/adm/help/${filename}.hlp";
                   1272:     }
                   1273: 
                   1274:     # Add the text
1.755     neumanie 1275:     if ($text ne "") {	
1.763     bisitz   1276: 	$template.='<span class="LC_help_open_topic">'
                   1277:                   .'<a target="_top" href="'.$link.'">'
                   1278:                   .$text.'</a>';
1.48      bowersj2 1279:     }
                   1280: 
1.763     bisitz   1281:     # (Always) Add the graphic
1.179     matthew  1282:     my $title = &mt('Online Help');
1.667     raeburn  1283:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1284:     if ($imgid ne '') {
                   1285:         $imgid = ' id="'.$imgid.'"';
                   1286:     }
1.763     bisitz   1287:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1288:               .'<img src="'.$helpicon.'" border="0"'
                   1289:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1290:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1291:               .' /></a>';
                   1292:     if ($text ne "") {	
                   1293:         $template.='</span>';
                   1294:     }
1.44      bowersj2 1295:     return $template;
                   1296: 
1.106     bowersj2 1297: }
                   1298: 
                   1299: # This is a quicky function for Latex cheatsheet editing, since it 
                   1300: # appears in at least four places
                   1301: sub helpLatexCheatsheet {
1.1037    www      1302:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1303:     my $out;
1.106     bowersj2 1304:     my $addOther = '';
1.732     raeburn  1305:     if ($topic) {
1.1037    www      1306: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1307:     }
                   1308:     $out = '<span>' # Start cheatsheet
                   1309: 	  .$addOther
                   1310:           .'<span>'
1.1037    www      1311: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1312: 	  .'</span> <span>'
1.1037    www      1313: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1314: 	  .'</span>';
1.732     raeburn  1315:     unless ($not_author) {
1.763     bisitz   1316:         $out .= ' <span>'
1.1037    www      1317: 	       .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.1075.2.71  raeburn  1318: 	       .'</span> <span>'
1.1075.2.78  raeburn  1319:                .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
1.1075.2.71  raeburn  1320:                .'</span>';
1.732     raeburn  1321:     }
1.763     bisitz   1322:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1323:     return $out;
1.172     www      1324: }
                   1325: 
1.430     albertel 1326: sub general_help {
                   1327:     my $helptopic='Student_Intro';
                   1328:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1329: 	$helptopic='Authoring_Intro';
1.907     raeburn  1330:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1331: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1332:     } elsif ($env{'request.role'}=~/^dc/) {
                   1333:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1334:     }
                   1335:     return $helptopic;
                   1336: }
                   1337: 
                   1338: sub update_help_link {
                   1339:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1340:     my $origurl = $ENV{'REQUEST_URI'};
                   1341:     $origurl=~s|^/~|/priv/|;
                   1342:     my $timestamp = time;
                   1343:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1344:         $$datum = &escape($$datum);
                   1345:     }
                   1346: 
                   1347:     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";
                   1348:     my $output .= <<"ENDOUTPUT";
                   1349: <script type="text/javascript">
1.824     bisitz   1350: // <![CDATA[
1.430     albertel 1351: banner_link = '$banner_link';
1.824     bisitz   1352: // ]]>
1.430     albertel 1353: </script>
                   1354: ENDOUTPUT
                   1355:     return $output;
                   1356: }
                   1357: 
                   1358: # now just updates the help link and generates a blue icon
1.193     raeburn  1359: sub help_open_menu {
1.430     albertel 1360:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1361: 	= @_;    
1.949     droeschl 1362:     $stayOnPage = 1;
1.430     albertel 1363:     my $output;
                   1364:     if ($component_help) {
                   1365: 	if (!$text) {
                   1366: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1367: 				       $width,$height);
                   1368: 	} else {
                   1369: 	    my $help_text;
                   1370: 	    $help_text=&unescape($topic);
                   1371: 	    $output='<table><tr><td>'.
                   1372: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1373: 				 $width,$height).'</td></tr></table>';
                   1374: 	}
                   1375:     }
                   1376:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1377:     return $output.$banner_link;
                   1378: }
                   1379: 
                   1380: sub top_nav_help {
1.1075.2.158  raeburn  1381:     my ($text,$linkattr) = @_;
1.436     albertel 1382:     $text = &mt($text);
1.1075.2.60  raeburn  1383:     my $stay_on_page;
                   1384:     unless ($env{'environment.remote'} eq 'on') {
                   1385:         $stay_on_page = 1;
                   1386:     }
1.1075.2.61  raeburn  1387:     my ($link,$banner_link);
                   1388:     unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
                   1389:         $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                   1390: 	                         : "javascript:helpMenu('open')";
                   1391:         $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
                   1392:     }
1.201     raeburn  1393:     my $title = &mt('Get help');
1.1075.2.61  raeburn  1394:     if ($link) {
                   1395:         return <<"END";
1.436     albertel 1396: $banner_link
1.1075.2.158  raeburn  1397: <a href="$link" title="$title" $linkattr>$text</a>
1.436     albertel 1398: END
1.1075.2.61  raeburn  1399:     } else {
                   1400:         return '&nbsp;'.$text.'&nbsp;';
                   1401:     }
1.436     albertel 1402: }
                   1403: 
                   1404: sub help_menu_js {
1.1075.2.52  raeburn  1405:     my ($httphost) = @_;
1.949     droeschl 1406:     my $stayOnPage = 1;
1.436     albertel 1407:     my $width = 620;
                   1408:     my $height = 600;
1.430     albertel 1409:     my $helptopic=&general_help();
1.1075.2.52  raeburn  1410:     my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1411:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1412:     my $start_page =
                   1413:         &Apache::loncommon::start_page('Help Menu', undef,
                   1414: 				       {'frameset'    => 1,
                   1415: 					'js_ready'    => 1,
1.1075.2.136  raeburn  1416:                                         'use_absolute' => $httphost,
1.331     albertel 1417: 					'add_entries' => {
                   1418: 					    'border' => '0',
1.579     raeburn  1419: 					    'rows'   => "110,*",},});
1.331     albertel 1420:     my $end_page =
                   1421:         &Apache::loncommon::end_page({'frameset' => 1,
                   1422: 				      'js_ready' => 1,});
                   1423: 
1.436     albertel 1424:     my $template .= <<"ENDTEMPLATE";
                   1425: <script type="text/javascript">
1.877     bisitz   1426: // <![CDATA[
1.253     albertel 1427: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1428: var banner_link = '';
1.243     raeburn  1429: function helpMenu(target) {
                   1430:     var caller = this;
                   1431:     if (target == 'open') {
                   1432:         var newWindow = null;
                   1433:         try {
1.262     albertel 1434:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1435:         }
                   1436:         catch(error) {
                   1437:             writeHelp(caller);
                   1438:             return;
                   1439:         }
                   1440:         if (newWindow) {
                   1441:             caller = newWindow;
                   1442:         }
1.193     raeburn  1443:     }
1.243     raeburn  1444:     writeHelp(caller);
                   1445:     return;
                   1446: }
                   1447: function writeHelp(caller) {
1.1075.2.61  raeburn  1448:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
                   1449:     caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
                   1450:     caller.document.close();
                   1451:     caller.focus();
1.193     raeburn  1452: }
1.877     bisitz   1453: // END LON-CAPA Internal -->
1.253     albertel 1454: // ]]>
1.436     albertel 1455: </script>
1.193     raeburn  1456: ENDTEMPLATE
                   1457:     return $template;
                   1458: }
                   1459: 
1.172     www      1460: sub help_open_bug {
                   1461:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1462:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1463:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1464:     $text = "" if (not defined $text);
                   1465: 	$stayOnPage=1;
1.184     albertel 1466:     $width = 600 if (not defined $width);
                   1467:     $height = 600 if (not defined $height);
1.172     www      1468: 
                   1469:     $topic=~s/\W+/\+/g;
                   1470:     my $link='';
                   1471:     my $template='';
1.379     albertel 1472:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1473: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1474:     if (!$stayOnPage)
                   1475:     {
                   1476: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1477:     }
                   1478:     else
                   1479:     {
                   1480: 	$link = $url;
                   1481:     }
                   1482:     # Add the text
                   1483:     if ($text ne "")
                   1484:     {
                   1485: 	$template .= 
                   1486:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1487:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1488:     }
                   1489: 
                   1490:     # Add the graphic
1.179     matthew  1491:     my $title = &mt('Report a Bug');
1.215     albertel 1492:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1493:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1494:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1495: ENDTEMPLATE
                   1496:     if ($text ne '') { $template.='</td></tr></table>' };
                   1497:     return $template;
                   1498: 
                   1499: }
                   1500: 
                   1501: sub help_open_faq {
                   1502:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1503:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1504:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1505:     $text = "" if (not defined $text);
                   1506: 	$stayOnPage=1;
                   1507:     $width = 350 if (not defined $width);
                   1508:     $height = 400 if (not defined $height);
                   1509: 
                   1510:     $topic=~s/\W+/\+/g;
                   1511:     my $link='';
                   1512:     my $template='';
                   1513:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1514:     if (!$stayOnPage)
                   1515:     {
                   1516: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1517:     }
                   1518:     else
                   1519:     {
                   1520: 	$link = $url;
                   1521:     }
                   1522: 
                   1523:     # Add the text
                   1524:     if ($text ne "")
                   1525:     {
                   1526: 	$template .= 
1.173     www      1527:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1528:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1529:     }
                   1530: 
                   1531:     # Add the graphic
1.179     matthew  1532:     my $title = &mt('View the FAQ');
1.215     albertel 1533:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1534:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1535:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1536: ENDTEMPLATE
                   1537:     if ($text ne '') { $template.='</td></tr></table>' };
                   1538:     return $template;
                   1539: 
1.44      bowersj2 1540: }
1.37      matthew  1541: 
1.180     matthew  1542: ###############################################################
                   1543: ###############################################################
                   1544: 
1.45      matthew  1545: =pod
                   1546: 
1.648     raeburn  1547: =item * &change_content_javascript():
1.256     matthew  1548: 
                   1549: This and the next function allow you to create small sections of an
                   1550: otherwise static HTML page that you can update on the fly with
                   1551: Javascript, even in Netscape 4.
                   1552: 
                   1553: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1554: must be written to the HTML page once. It will prove the Javascript
                   1555: function "change(name, content)". Calling the change function with the
                   1556: name of the section 
                   1557: you want to update, matching the name passed to C<changable_area>, and
                   1558: the new content you want to put in there, will put the content into
                   1559: that area.
                   1560: 
                   1561: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1562: to contain room for the original contents. You need to "make space"
                   1563: for whatever changes you wish to make, and be B<sure> to check your
                   1564: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1565: it's adequate for updating a one-line status display, but little more.
                   1566: This script will set the space to 100% width, so you only need to
                   1567: worry about height in Netscape 4.
                   1568: 
                   1569: Modern browsers are much less limiting, and if you can commit to the
                   1570: user not using Netscape 4, this feature may be used freely with
                   1571: pretty much any HTML.
                   1572: 
                   1573: =cut
                   1574: 
                   1575: sub change_content_javascript {
                   1576:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1577:     if ($env{'browser.type'} eq 'netscape' &&
                   1578: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1579: 	return (<<NETSCAPE4);
                   1580: 	function change(name, content) {
                   1581: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1582: 	    doc.open();
                   1583: 	    doc.write(content);
                   1584: 	    doc.close();
                   1585: 	}
                   1586: NETSCAPE4
                   1587:     } else {
                   1588: 	# Otherwise, we need to use semi-standards-compliant code
                   1589: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1590: 	# is really scary, and every useful browser supports it
                   1591: 	return (<<DOMBASED);
                   1592: 	function change(name, content) {
                   1593: 	    element = document.getElementById(name);
                   1594: 	    element.innerHTML = content;
                   1595: 	}
                   1596: DOMBASED
                   1597:     }
                   1598: }
                   1599: 
                   1600: =pod
                   1601: 
1.648     raeburn  1602: =item * &changable_area($name,$origContent):
1.256     matthew  1603: 
                   1604: This provides a "changable area" that can be modified on the fly via
                   1605: the Javascript code provided in C<change_content_javascript>. $name is
                   1606: the name you will use to reference the area later; do not repeat the
                   1607: same name on a given HTML page more then once. $origContent is what
                   1608: the area will originally contain, which can be left blank.
                   1609: 
                   1610: =cut
                   1611: 
                   1612: sub changable_area {
                   1613:     my ($name, $origContent) = @_;
                   1614: 
1.258     albertel 1615:     if ($env{'browser.type'} eq 'netscape' &&
                   1616: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1617: 	# If this is netscape 4, we need to use the Layer tag
                   1618: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1619:     } else {
                   1620: 	return "<span id='$name'>$origContent</span>";
                   1621:     }
                   1622: }
                   1623: 
                   1624: =pod
                   1625: 
1.648     raeburn  1626: =item * &viewport_geometry_js 
1.590     raeburn  1627: 
                   1628: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1629: 
                   1630: =cut
                   1631: 
                   1632: 
                   1633: sub viewport_geometry_js { 
                   1634:     return <<"GEOMETRY";
                   1635: var Geometry = {};
                   1636: function init_geometry() {
                   1637:     if (Geometry.init) { return };
                   1638:     Geometry.init=1;
                   1639:     if (window.innerHeight) {
                   1640:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1641:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1642:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1643:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1644:     }
                   1645:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1646:         Geometry.getViewportHeight =
                   1647:             function() { return document.documentElement.clientHeight; };
                   1648:         Geometry.getViewportWidth =
                   1649:             function() { return document.documentElement.clientWidth; };
                   1650: 
                   1651:         Geometry.getHorizontalScroll =
                   1652:             function() { return document.documentElement.scrollLeft; };
                   1653:         Geometry.getVerticalScroll =
                   1654:             function() { return document.documentElement.scrollTop; };
                   1655:     }
                   1656:     else if (document.body.clientHeight) {
                   1657:         Geometry.getViewportHeight =
                   1658:             function() { return document.body.clientHeight; };
                   1659:         Geometry.getViewportWidth =
                   1660:             function() { return document.body.clientWidth; };
                   1661:         Geometry.getHorizontalScroll =
                   1662:             function() { return document.body.scrollLeft; };
                   1663:         Geometry.getVerticalScroll =
                   1664:             function() { return document.body.scrollTop; };
                   1665:     }
                   1666: }
                   1667: 
                   1668: GEOMETRY
                   1669: }
                   1670: 
                   1671: =pod
                   1672: 
1.648     raeburn  1673: =item * &viewport_size_js()
1.590     raeburn  1674: 
                   1675: 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. 
                   1676: 
                   1677: =cut
                   1678: 
                   1679: sub viewport_size_js {
                   1680:     my $geometry = &viewport_geometry_js();
                   1681:     return <<"DIMS";
                   1682: 
                   1683: $geometry
                   1684: 
                   1685: function getViewportDims(width,height) {
                   1686:     init_geometry();
                   1687:     width.value = Geometry.getViewportWidth();
                   1688:     height.value = Geometry.getViewportHeight();
                   1689:     return;
                   1690: }
                   1691: 
                   1692: DIMS
                   1693: }
                   1694: 
                   1695: =pod
                   1696: 
1.648     raeburn  1697: =item * &resize_textarea_js()
1.565     albertel 1698: 
                   1699: emits the needed javascript to resize a textarea to be as big as possible
                   1700: 
                   1701: creates a function resize_textrea that takes two IDs first should be
                   1702: the id of the element to resize, second should be the id of a div that
                   1703: surrounds everything that comes after the textarea, this routine needs
                   1704: to be attached to the <body> for the onload and onresize events.
                   1705: 
1.648     raeburn  1706: =back
1.565     albertel 1707: 
                   1708: =cut
                   1709: 
                   1710: sub resize_textarea_js {
1.590     raeburn  1711:     my $geometry = &viewport_geometry_js();
1.565     albertel 1712:     return <<"RESIZE";
                   1713:     <script type="text/javascript">
1.824     bisitz   1714: // <![CDATA[
1.590     raeburn  1715: $geometry
1.565     albertel 1716: 
1.588     albertel 1717: function getX(element) {
                   1718:     var x = 0;
                   1719:     while (element) {
                   1720: 	x += element.offsetLeft;
                   1721: 	element = element.offsetParent;
                   1722:     }
                   1723:     return x;
                   1724: }
                   1725: function getY(element) {
                   1726:     var y = 0;
                   1727:     while (element) {
                   1728: 	y += element.offsetTop;
                   1729: 	element = element.offsetParent;
                   1730:     }
                   1731:     return y;
                   1732: }
                   1733: 
                   1734: 
1.565     albertel 1735: function resize_textarea(textarea_id,bottom_id) {
                   1736:     init_geometry();
                   1737:     var textarea        = document.getElementById(textarea_id);
                   1738:     //alert(textarea);
                   1739: 
1.588     albertel 1740:     var textarea_top    = getY(textarea);
1.565     albertel 1741:     var textarea_height = textarea.offsetHeight;
                   1742:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1743:     var bottom_top      = getY(bottom);
1.565     albertel 1744:     var bottom_height   = bottom.offsetHeight;
                   1745:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1746:     var fudge           = 23;
1.565     albertel 1747:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1748:     if (new_height < 300) {
                   1749: 	new_height = 300;
                   1750:     }
                   1751:     textarea.style.height=new_height+'px';
                   1752: }
1.824     bisitz   1753: // ]]>
1.565     albertel 1754: </script>
                   1755: RESIZE
                   1756: 
                   1757: }
                   1758: 
1.1075.2.112  raeburn  1759: sub colorfuleditor_js {
                   1760:     return <<"COLORFULEDIT"
                   1761: <script type="text/javascript">
                   1762: // <![CDATA[>
                   1763:     function fold_box(curDepth, lastresource){
                   1764: 
                   1765:     // we need a list because there can be several blocks you need to fold in one tag
                   1766:         var block = document.getElementsByName('foldblock_'+curDepth);
                   1767:     // but there is only one folding button per tag
                   1768:         var foldbutton = document.getElementById('folding_btn_'+curDepth);
                   1769: 
                   1770:         if(block.item(0).style.display == 'none'){
                   1771: 
                   1772:             foldbutton.value = '@{[&mt("Hide")]}';
                   1773:             for (i = 0; i < block.length; i++){
                   1774:                 block.item(i).style.display = '';
                   1775:             }
                   1776:         }else{
                   1777: 
                   1778:             foldbutton.value = '@{[&mt("Show")]}';
                   1779:             for (i = 0; i < block.length; i++){
                   1780:                 // block.item(i).style.visibility = 'collapse';
                   1781:                 block.item(i).style.display = 'none';
                   1782:             }
                   1783:         };
                   1784:         saveState(lastresource);
                   1785:     }
                   1786: 
                   1787:     function saveState (lastresource) {
                   1788: 
                   1789:         var tag_list = getTagList();
                   1790:         if(tag_list != null){
                   1791:             var timestamp = new Date().getTime();
                   1792:             var key = lastresource;
                   1793: 
                   1794:             // the value pattern is: 'time;key1,value1;key2,value2; ... '
                   1795:             // starting with timestamp
                   1796:             var value = timestamp+';';
                   1797: 
                   1798:             // building the list of key-value pairs
                   1799:             for(var i = 0; i < tag_list.length; i++){
                   1800:                 value += tag_list[i]+',';
                   1801:                 value += document.getElementsByName(tag_list[i])[0].style.display+';';
                   1802:             }
                   1803: 
                   1804:             // only iterate whole storage if nothing to override
                   1805:             if(localStorage.getItem(key) == null){
                   1806: 
                   1807:                 // prevent storage from growing large
                   1808:                 if(localStorage.length > 50){
                   1809:                     var regex_getTimestamp = /^(?:\d)+;/;
                   1810:                     var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
                   1811:                     var oldest_key;
                   1812: 
                   1813:                     for(var i = 1; i < localStorage.length; i++){
                   1814:                         if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
                   1815:                             oldest_key = localStorage.key(i);
                   1816:                             oldest_timestamp = regex_getTimestamp.exec(oldest_key);
                   1817:                         }
                   1818:                     }
                   1819:                     localStorage.removeItem(oldest_key);
                   1820:                 }
                   1821:             }
                   1822:             localStorage.setItem(key,value);
                   1823:         }
                   1824:     }
                   1825: 
                   1826:     // restore folding status of blocks (on page load)
                   1827:     function restoreState (lastresource) {
                   1828:         if(localStorage.getItem(lastresource) != null){
                   1829:             var key = lastresource;
                   1830:             var value = localStorage.getItem(key);
                   1831:             var regex_delTimestamp = /^\d+;/;
                   1832: 
                   1833:             value.replace(regex_delTimestamp, '');
                   1834: 
                   1835:             var valueArr = value.split(';');
                   1836:             var pairs;
                   1837:             var elements;
                   1838:             for (var i = 0; i < valueArr.length; i++){
                   1839:                 pairs = valueArr[i].split(',');
                   1840:                 elements = document.getElementsByName(pairs[0]);
                   1841: 
                   1842:                 for (var j = 0; j < elements.length; j++){
                   1843:                     elements[j].style.display = pairs[1];
                   1844:                     if (pairs[1] == "none"){
                   1845:                         var regex_id = /([_\\d]+)\$/;
                   1846:                         regex_id.exec(pairs[0]);
                   1847:                         document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
                   1848:                     }
                   1849:                 }
                   1850:             }
                   1851:         }
                   1852:     }
                   1853: 
                   1854:     function getTagList () {
                   1855: 
                   1856:         var stringToSearch = document.lonhomework.innerHTML;
                   1857: 
                   1858:         var ret = new Array();
                   1859:         var regex_findBlock = /(foldblock_.*?)"/g;
                   1860:         var tag_list = stringToSearch.match(regex_findBlock);
                   1861: 
                   1862:         if(tag_list != null){
                   1863:             for(var i = 0; i < tag_list.length; i++){
                   1864:                 ret.push(tag_list[i].replace(/"/, ''));
                   1865:             }
                   1866:         }
                   1867:         return ret;
                   1868:     }
                   1869: 
                   1870:     function saveScrollPosition (resource) {
                   1871:         var tag_list = getTagList();
                   1872: 
                   1873:         // we dont always want to jump to the first block
                   1874:         // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
                   1875:         if(\$(window).scrollTop() > 170){
                   1876:             if(tag_list != null){
                   1877:                 var result;
                   1878:                 for(var i = 0; i < tag_list.length; i++){
                   1879:                     if(isElementInViewport(tag_list[i])){
                   1880:                         result += tag_list[i]+';';
                   1881:                     }
                   1882:                 }
                   1883:                 sessionStorage.setItem('anchor_'+resource, result);
                   1884:             }
                   1885:         } else {
                   1886:             // we dont need to save zero, just delete the item to leave everything tidy
                   1887:             sessionStorage.removeItem('anchor_'+resource);
                   1888:         }
                   1889:     }
                   1890: 
                   1891:     function restoreScrollPosition(resource){
                   1892: 
                   1893:         var elem = sessionStorage.getItem('anchor_'+resource);
                   1894:         if(elem != null){
                   1895:             var tag_list = elem.split(';');
                   1896:             var elem_list;
                   1897: 
                   1898:             for(var i = 0; i < tag_list.length; i++){
                   1899:                 elem_list = document.getElementsByName(tag_list[i]);
                   1900: 
                   1901:                 if(elem_list.length > 0){
                   1902:                     elem = elem_list[0];
                   1903:                     break;
                   1904:                 }
                   1905:             }
                   1906:             elem.scrollIntoView();
                   1907:         }
                   1908:     }
                   1909: 
                   1910:     function isElementInViewport(el) {
                   1911: 
                   1912:         // change to last element instead of first
                   1913:         var elem = document.getElementsByName(el);
                   1914:         var rect = elem[0].getBoundingClientRect();
                   1915: 
                   1916:         return (
                   1917:             rect.top >= 0 &&
                   1918:             rect.left >= 0 &&
                   1919:             rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
                   1920:             rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
                   1921:         );
                   1922:     }
                   1923: 
                   1924:     function autosize(depth){
                   1925:         var cmInst = window['cm'+depth];
                   1926:         var fitsizeButton = document.getElementById('fitsize'+depth);
                   1927: 
                   1928:         // is fixed size, switching to dynamic
                   1929:         if (sessionStorage.getItem("autosized_"+depth) == null) {
                   1930:             cmInst.setSize("","auto");
                   1931:             fitsizeButton.value = "@{[&mt('Fixed size')]}";
                   1932:             sessionStorage.setItem("autosized_"+depth, "yes");
                   1933: 
                   1934:         // is dynamic size, switching to fixed
                   1935:         } else {
                   1936:             cmInst.setSize("","300px");
                   1937:             fitsizeButton.value = "@{[&mt('Dynamic size')]}";
                   1938:             sessionStorage.removeItem("autosized_"+depth);
                   1939:         }
                   1940:     }
                   1941: 
                   1942: 
                   1943: 
                   1944: // ]]>
                   1945: </script>
                   1946: COLORFULEDIT
                   1947: }
                   1948: 
                   1949: sub xmleditor_js {
                   1950:     return <<XMLEDIT
                   1951: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
                   1952: <script type="text/javascript">
                   1953: // <![CDATA[>
                   1954: 
                   1955:     function saveScrollPosition (resource) {
                   1956: 
                   1957:         var scrollPos = \$(window).scrollTop();
                   1958:         sessionStorage.setItem(resource,scrollPos);
                   1959:     }
                   1960: 
                   1961:     function restoreScrollPosition(resource){
                   1962: 
                   1963:         var scrollPos = sessionStorage.getItem(resource);
                   1964:         \$(window).scrollTop(scrollPos);
                   1965:     }
                   1966: 
                   1967:     // unless internet explorer
                   1968:     if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
                   1969: 
                   1970:         \$(document).ready(function() {
                   1971:              \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
                   1972:         });
                   1973:     }
                   1974: 
                   1975:     // inserts text at cursor position into codemirror (xml editor only)
                   1976:     function insertText(text){
                   1977:         cm.focus();
                   1978:         var curPos = cm.getCursor();
                   1979:         cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
                   1980:     }
                   1981: // ]]>
                   1982: </script>
                   1983: XMLEDIT
                   1984: }
                   1985: 
                   1986: sub insert_folding_button {
                   1987:     my $curDepth = $Apache::lonxml::curdepth;
                   1988:     my $lastresource = $env{'request.ambiguous'};
                   1989: 
                   1990:     return "<input type=\"button\" id=\"folding_btn_$curDepth\"
                   1991:             value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
                   1992: }
                   1993: 
                   1994: 
1.565     albertel 1995: =pod
                   1996: 
1.256     matthew  1997: =head1 Excel and CSV file utility routines
                   1998: 
                   1999: =cut
                   2000: 
                   2001: ###############################################################
                   2002: ###############################################################
                   2003: 
                   2004: =pod
                   2005: 
1.1075.2.56  raeburn  2006: =over 4
                   2007: 
1.648     raeburn  2008: =item * &csv_translate($text) 
1.37      matthew  2009: 
1.185     www      2010: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  2011: format.
                   2012: 
                   2013: =cut
                   2014: 
1.180     matthew  2015: ###############################################################
                   2016: ###############################################################
1.37      matthew  2017: sub csv_translate {
                   2018:     my $text = shift;
                   2019:     $text =~ s/\"/\"\"/g;
1.209     albertel 2020:     $text =~ s/\n/ /g;
1.37      matthew  2021:     return $text;
                   2022: }
1.180     matthew  2023: 
                   2024: ###############################################################
                   2025: ###############################################################
                   2026: 
                   2027: =pod
                   2028: 
1.648     raeburn  2029: =item * &define_excel_formats()
1.180     matthew  2030: 
                   2031: Define some commonly used Excel cell formats.
                   2032: 
                   2033: Currently supported formats:
                   2034: 
                   2035: =over 4
                   2036: 
                   2037: =item header
                   2038: 
                   2039: =item bold
                   2040: 
                   2041: =item h1
                   2042: 
                   2043: =item h2
                   2044: 
                   2045: =item h3
                   2046: 
1.256     matthew  2047: =item h4
                   2048: 
                   2049: =item i
                   2050: 
1.180     matthew  2051: =item date
                   2052: 
                   2053: =back
                   2054: 
                   2055: Inputs: $workbook
                   2056: 
                   2057: Returns: $format, a hash reference.
                   2058: 
1.1057    foxr     2059: 
1.180     matthew  2060: =cut
                   2061: 
                   2062: ###############################################################
                   2063: ###############################################################
                   2064: sub define_excel_formats {
                   2065:     my ($workbook) = @_;
                   2066:     my $format;
                   2067:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   2068:                                                 bottom    => 1,
                   2069:                                                 align     => 'center');
                   2070:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   2071:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   2072:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   2073:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  2074:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  2075:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  2076:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  2077:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  2078:     return $format;
                   2079: }
                   2080: 
                   2081: ###############################################################
                   2082: ###############################################################
1.113     bowersj2 2083: 
                   2084: =pod
                   2085: 
1.648     raeburn  2086: =item * &create_workbook()
1.255     matthew  2087: 
                   2088: Create an Excel worksheet.  If it fails, output message on the
                   2089: request object and return undefs.
                   2090: 
                   2091: Inputs: Apache request object
                   2092: 
                   2093: Returns (undef) on failure, 
                   2094:     Excel worksheet object, scalar with filename, and formats 
                   2095:     from &Apache::loncommon::define_excel_formats on success
                   2096: 
                   2097: =cut
                   2098: 
                   2099: ###############################################################
                   2100: ###############################################################
                   2101: sub create_workbook {
                   2102:     my ($r) = @_;
                   2103:         #
                   2104:     # Create the excel spreadsheet
                   2105:     my $filename = '/prtspool/'.
1.258     albertel 2106:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  2107:         time.'_'.rand(1000000000).'.xls';
                   2108:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   2109:     if (! defined($workbook)) {
                   2110:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   2111:         $r->print(
                   2112:             '<p class="LC_error">'
                   2113:            .&mt('Problems occurred in creating the new Excel file.')
                   2114:            .' '.&mt('This error has been logged.')
                   2115:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2116:            .'</p>'
                   2117:         );
1.255     matthew  2118:         return (undef);
                   2119:     }
                   2120:     #
1.1014    foxr     2121:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  2122:     #
                   2123:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   2124:     return ($workbook,$filename,$format);
                   2125: }
                   2126: 
                   2127: ###############################################################
                   2128: ###############################################################
                   2129: 
                   2130: =pod
                   2131: 
1.648     raeburn  2132: =item * &create_text_file()
1.113     bowersj2 2133: 
1.542     raeburn  2134: Create a file to write to and eventually make available to the user.
1.256     matthew  2135: If file creation fails, outputs an error message on the request object and 
                   2136: return undefs.
1.113     bowersj2 2137: 
1.256     matthew  2138: Inputs: Apache request object, and file suffix
1.113     bowersj2 2139: 
1.256     matthew  2140: Returns (undef) on failure, 
                   2141:     Filehandle and filename on success.
1.113     bowersj2 2142: 
                   2143: =cut
                   2144: 
1.256     matthew  2145: ###############################################################
                   2146: ###############################################################
                   2147: sub create_text_file {
                   2148:     my ($r,$suffix) = @_;
                   2149:     if (! defined($suffix)) { $suffix = 'txt'; };
                   2150:     my $fh;
                   2151:     my $filename = '/prtspool/'.
1.258     albertel 2152:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  2153:         time.'_'.rand(1000000000).'.'.$suffix;
                   2154:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   2155:     if (! defined($fh)) {
                   2156:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   2157:         $r->print(
                   2158:             '<p class="LC_error">'
                   2159:            .&mt('Problems occurred in creating the output file.')
                   2160:            .' '.&mt('This error has been logged.')
                   2161:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2162:            .'</p>'
                   2163:         );
1.113     bowersj2 2164:     }
1.256     matthew  2165:     return ($fh,$filename)
1.113     bowersj2 2166: }
                   2167: 
                   2168: 
1.256     matthew  2169: =pod 
1.113     bowersj2 2170: 
                   2171: =back
                   2172: 
                   2173: =cut
1.37      matthew  2174: 
                   2175: ###############################################################
1.33      matthew  2176: ##        Home server <option> list generating code          ##
                   2177: ###############################################################
1.35      matthew  2178: 
1.169     www      2179: # ------------------------------------------
                   2180: 
                   2181: sub domain_select {
                   2182:     my ($name,$value,$multiple)=@_;
                   2183:     my %domains=map { 
1.514     albertel 2184: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 2185:     } &Apache::lonnet::all_domains();
1.169     www      2186:     if ($multiple) {
                   2187: 	$domains{''}=&mt('Any domain');
1.550     albertel 2188: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 2189: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      2190:     } else {
1.550     albertel 2191: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  2192: 	return &select_form($name,$value,\%domains);
1.169     www      2193:     }
                   2194: }
                   2195: 
1.282     albertel 2196: #-------------------------------------------
                   2197: 
                   2198: =pod
                   2199: 
1.519     raeburn  2200: =head1 Routines for form select boxes
                   2201: 
                   2202: =over 4
                   2203: 
1.648     raeburn  2204: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 2205: 
                   2206: Returns a string containing a <select> element int multiple mode
                   2207: 
                   2208: 
                   2209: Args:
                   2210:   $name - name of the <select> element
1.506     raeburn  2211:   $value - scalar or array ref of values that should already be selected
1.282     albertel 2212:   $size - number of rows long the select element is
1.283     albertel 2213:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 2214:           (shown text should already have been &mt())
1.506     raeburn  2215:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 2216: 
1.282     albertel 2217: =cut
                   2218: 
                   2219: #-------------------------------------------
1.169     www      2220: sub multiple_select_form {
1.284     albertel 2221:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      2222:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   2223:     my $output='';
1.191     matthew  2224:     if (! defined($size)) {
                   2225:         $size = 4;
1.283     albertel 2226:         if (scalar(keys(%$hash))<4) {
                   2227:             $size = scalar(keys(%$hash));
1.191     matthew  2228:         }
                   2229:     }
1.734     bisitz   2230:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 2231:     my @order;
1.506     raeburn  2232:     if (ref($order) eq 'ARRAY')  {
                   2233:         @order = @{$order};
                   2234:     } else {
                   2235:         @order = sort(keys(%$hash));
1.501     banghart 2236:     }
                   2237:     if (exists($$hash{'select_form_order'})) {
                   2238:         @order = @{$$hash{'select_form_order'}};
                   2239:     }
                   2240:         
1.284     albertel 2241:     foreach my $key (@order) {
1.356     albertel 2242:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 2243:         $output.='selected="selected" ' if ($selected{$key});
                   2244:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      2245:     }
                   2246:     $output.="</select>\n";
                   2247:     return $output;
                   2248: }
                   2249: 
1.88      www      2250: #-------------------------------------------
                   2251: 
                   2252: =pod
                   2253: 
1.1075.2.115  raeburn  2254: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88      www      2255: 
                   2256: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  2257: allow a user to select options from a ref to a hash containing:
                   2258: option_name => displayed text. An optional $onchange can include
1.1075.2.115  raeburn  2259: a javascript onchange item, e.g., onchange="this.form.submit();".
                   2260: An optional arg -- $readonly -- if true will cause the select form
                   2261: to be disabled, e.g., for the case where an instructor has a section-
                   2262: specific role, and is viewing/modifying parameters.  
1.970     raeburn  2263: 
1.88      www      2264: See lonrights.pm for an example invocation and use.
                   2265: 
                   2266: =cut
                   2267: 
                   2268: #-------------------------------------------
                   2269: sub select_form {
1.1075.2.115  raeburn  2270:     my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970     raeburn  2271:     return unless (ref($hashref) eq 'HASH');
                   2272:     if ($onchange) {
                   2273:         $onchange = ' onchange="'.$onchange.'"';
                   2274:     }
1.1075.2.129  raeburn  2275:     my $disabled;
                   2276:     if ($readonly) {
                   2277:         $disabled = ' disabled="disabled"';
                   2278:     }
                   2279:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128     albertel 2280:     my @keys;
1.970     raeburn  2281:     if (exists($hashref->{'select_form_order'})) {
                   2282: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2283:     } else {
1.970     raeburn  2284: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2285:     }
1.356     albertel 2286:     foreach my $key (@keys) {
                   2287:         $selectform.=
                   2288: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2289:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2290:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2291:     }
                   2292:     $selectform.="</select>";
                   2293:     return $selectform;
                   2294: }
                   2295: 
1.475     www      2296: # For display filters
                   2297: 
                   2298: sub display_filter {
1.1074    raeburn  2299:     my ($context) = @_;
1.475     www      2300:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2301:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2302:     my $phraseinput = 'hidden';
                   2303:     my $includeinput = 'hidden';
                   2304:     my ($checked,$includetypestext);
                   2305:     if ($env{'form.displayfilter'} eq 'containing') {
                   2306:         $phraseinput = 'text'; 
                   2307:         if ($context eq 'parmslog') {
                   2308:             $includeinput = 'checkbox';
                   2309:             if ($env{'form.includetypes'}) {
                   2310:                 $checked = ' checked="checked"';
                   2311:             }
                   2312:             $includetypestext = &mt('Include parameter types');
                   2313:         }
                   2314:     } else {
                   2315:         $includetypestext = '&nbsp;';
                   2316:     }
                   2317:     my ($additional,$secondid,$thirdid);
                   2318:     if ($context eq 'parmslog') {
                   2319:         $additional = 
                   2320:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2321:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2322:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2323:             '</label>';
                   2324:         $secondid = 'includetypes';
                   2325:         $thirdid = 'includetypestext';
                   2326:     }
                   2327:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2328:                                                     '$secondid','$thirdid')";
                   2329:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2330: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2331: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2332: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2333:            &mt('Filter: [_1]',
1.477     www      2334: 	   &select_form($env{'form.displayfilter'},
                   2335: 			'displayfilter',
1.970     raeburn  2336: 			{'currentfolder' => 'Current folder/page',
1.477     www      2337: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2338: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2339: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2340:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2341:                          '" />'.$additional;
                   2342: }
                   2343: 
                   2344: sub display_filter_js {
                   2345:     my $includetext = &mt('Include parameter types');
                   2346:     return <<"ENDJS";
                   2347:   
                   2348: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2349:     var firstType = 'hidden';
                   2350:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2351:         firstType = 'text';
                   2352:     }
                   2353:     firstObject = document.getElementById(firstid);
                   2354:     if (typeof(firstObject) == 'object') {
                   2355:         if (firstObject.type != firstType) {
                   2356:             changeInputType(firstObject,firstType);
                   2357:         }
                   2358:     }
                   2359:     if (context == 'parmslog') {
                   2360:         var secondType = 'hidden';
                   2361:         if (firstType == 'text') {
                   2362:             secondType = 'checkbox';
                   2363:         }
                   2364:         secondObject = document.getElementById(secondid);  
                   2365:         if (typeof(secondObject) == 'object') {
                   2366:             if (secondObject.type != secondType) {
                   2367:                 changeInputType(secondObject,secondType);
                   2368:             }
                   2369:         }
                   2370:         var textItem = document.getElementById(thirdid);
                   2371:         var currtext = textItem.innerHTML;
                   2372:         var newtext;
                   2373:         if (firstType == 'text') {
                   2374:             newtext = '$includetext';
                   2375:         } else {
                   2376:             newtext = '&nbsp;';
                   2377:         }
                   2378:         if (currtext != newtext) {
                   2379:             textItem.innerHTML = newtext;
                   2380:         }
                   2381:     }
                   2382:     return;
                   2383: }
                   2384: 
                   2385: function changeInputType(oldObject,newType) {
                   2386:     var newObject = document.createElement('input');
                   2387:     newObject.type = newType;
                   2388:     if (oldObject.size) {
                   2389:         newObject.size = oldObject.size;
                   2390:     }
                   2391:     if (oldObject.value) {
                   2392:         newObject.value = oldObject.value;
                   2393:     }
                   2394:     if (oldObject.name) {
                   2395:         newObject.name = oldObject.name;
                   2396:     }
                   2397:     if (oldObject.id) {
                   2398:         newObject.id = oldObject.id;
                   2399:     }
                   2400:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2401:     return;
                   2402: }
                   2403: 
                   2404: ENDJS
1.475     www      2405: }
                   2406: 
1.167     www      2407: sub gradeleveldescription {
                   2408:     my $gradelevel=shift;
                   2409:     my %gradelevels=(0 => 'Not specified',
                   2410: 		     1 => 'Grade 1',
                   2411: 		     2 => 'Grade 2',
                   2412: 		     3 => 'Grade 3',
                   2413: 		     4 => 'Grade 4',
                   2414: 		     5 => 'Grade 5',
                   2415: 		     6 => 'Grade 6',
                   2416: 		     7 => 'Grade 7',
                   2417: 		     8 => 'Grade 8',
                   2418: 		     9 => 'Grade 9',
                   2419: 		     10 => 'Grade 10',
                   2420: 		     11 => 'Grade 11',
                   2421: 		     12 => 'Grade 12',
                   2422: 		     13 => 'Grade 13',
                   2423: 		     14 => '100 Level',
                   2424: 		     15 => '200 Level',
                   2425: 		     16 => '300 Level',
                   2426: 		     17 => '400 Level',
                   2427: 		     18 => 'Graduate Level');
                   2428:     return &mt($gradelevels{$gradelevel});
                   2429: }
                   2430: 
1.163     www      2431: sub select_level_form {
                   2432:     my ($deflevel,$name)=@_;
                   2433:     unless ($deflevel) { $deflevel=0; }
1.167     www      2434:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2435:     for (my $i=0; $i<=18; $i++) {
                   2436:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2437:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2438:                 ">".&gradeleveldescription($i)."</option>\n";
                   2439:     }
                   2440:     $selectform.="</select>";
                   2441:     return $selectform;
1.163     www      2442: }
1.167     www      2443: 
1.35      matthew  2444: #-------------------------------------------
                   2445: 
1.45      matthew  2446: =pod
                   2447: 
1.1075.2.115  raeburn  2448: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35      matthew  2449: 
                   2450: Returns a string containing a <select name='$name' size='1'> form to 
                   2451: allow a user to select the domain to preform an operation in.  
                   2452: See loncreateuser.pm for an example invocation and use.
                   2453: 
1.90      www      2454: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2455: selected");
                   2456: 
1.743     raeburn  2457: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2458: 
1.910     raeburn  2459: 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.
                   2460: 
1.1075.2.36  raeburn  2461: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2462: 
1.1075.2.115  raeburn  2463: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
                   2464: 
                   2465: The optional $disabled argument, if true, adds the disabled attribute to the select tag. 
1.563     raeburn  2466: 
1.35      matthew  2467: =cut
                   2468: 
                   2469: #-------------------------------------------
1.34      matthew  2470: sub select_dom_form {
1.1075.2.115  raeburn  2471:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872     raeburn  2472:     if ($onchange) {
1.874     raeburn  2473:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2474:     }
1.1075.2.115  raeburn  2475:     if ($disabled) {
                   2476:         $disabled = ' disabled="disabled"';
                   2477:     }
1.1075.2.36  raeburn  2478:     my (@domains,%exclude);
1.910     raeburn  2479:     if (ref($incdoms) eq 'ARRAY') {
                   2480:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2481:     } else {
                   2482:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2483:     }
1.90      www      2484:     if ($includeempty) { @domains=('',@domains); }
1.1075.2.36  raeburn  2485:     if (ref($excdoms) eq 'ARRAY') {
                   2486:         map { $exclude{$_} = 1; } @{$excdoms};
                   2487:     }
1.1075.2.115  raeburn  2488:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356     albertel 2489:     foreach my $dom (@domains) {
1.1075.2.36  raeburn  2490:         next if ($exclude{$dom});
1.356     albertel 2491:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2492:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2493:         if ($showdomdesc) {
                   2494:             if ($dom ne '') {
                   2495:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2496:                 if ($domdesc ne '') {
                   2497:                     $selectdomain .= ' ('.$domdesc.')';
                   2498:                 }
                   2499:             } 
                   2500:         }
                   2501:         $selectdomain .= "</option>\n";
1.34      matthew  2502:     }
                   2503:     $selectdomain.="</select>";
                   2504:     return $selectdomain;
                   2505: }
                   2506: 
1.35      matthew  2507: #-------------------------------------------
                   2508: 
1.45      matthew  2509: =pod
                   2510: 
1.648     raeburn  2511: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2512: 
1.586     raeburn  2513: input: 4 arguments (two required, two optional) - 
                   2514:     $domain - domain of new user
                   2515:     $name - name of form element
                   2516:     $default - Value of 'default' causes a default item to be first 
                   2517:                             option, and selected by default. 
                   2518:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2519:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2520: output: returns 2 items: 
1.586     raeburn  2521: (a) form element which contains either:
                   2522:    (i) <select name="$name">
                   2523:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2524:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2525:        </select>
                   2526:        form item if there are multiple library servers in $domain, or
                   2527:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2528:        if there is only one library server in $domain.
                   2529: 
                   2530: (b) number of library servers found.
                   2531: 
                   2532: See loncreateuser.pm for example of use.
1.35      matthew  2533: 
                   2534: =cut
                   2535: 
                   2536: #-------------------------------------------
1.586     raeburn  2537: sub home_server_form_item {
                   2538:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2539:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2540:     my $result;
                   2541:     my $numlib = keys(%servers);
                   2542:     if ($numlib > 1) {
                   2543:         $result .= '<select name="'.$name.'" />'."\n";
                   2544:         if ($default) {
1.804     bisitz   2545:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2546:                        '</option>'."\n";
                   2547:         }
                   2548:         foreach my $hostid (sort(keys(%servers))) {
                   2549:             $result.= '<option value="'.$hostid.'">'.
                   2550: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2551:         }
                   2552:         $result .= '</select>'."\n";
                   2553:     } elsif ($numlib == 1) {
                   2554:         my $hostid;
                   2555:         foreach my $item (keys(%servers)) {
                   2556:             $hostid = $item;
                   2557:         }
                   2558:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2559:                    $hostid.'" />';
                   2560:                    if (!$hide) {
                   2561:                        $result .= $hostid.' '.$servers{$hostid};
                   2562:                    }
                   2563:                    $result .= "\n";
                   2564:     } elsif ($default) {
                   2565:         $result .= '<input type="hidden" name="'.$name.
                   2566:                    '" value="default" />';
                   2567:                    if (!$hide) {
                   2568:                        $result .= &mt('default');
                   2569:                    }
                   2570:                    $result .= "\n";
1.33      matthew  2571:     }
1.586     raeburn  2572:     return ($result,$numlib);
1.33      matthew  2573: }
1.112     bowersj2 2574: 
                   2575: =pod
                   2576: 
1.534     albertel 2577: =back 
                   2578: 
1.112     bowersj2 2579: =cut
1.87      matthew  2580: 
                   2581: ###############################################################
1.112     bowersj2 2582: ##                  Decoding User Agent                      ##
1.87      matthew  2583: ###############################################################
                   2584: 
                   2585: =pod
                   2586: 
1.112     bowersj2 2587: =head1 Decoding the User Agent
                   2588: 
                   2589: =over 4
                   2590: 
                   2591: =item * &decode_user_agent()
1.87      matthew  2592: 
                   2593: Inputs: $r
                   2594: 
                   2595: Outputs:
                   2596: 
                   2597: =over 4
                   2598: 
1.112     bowersj2 2599: =item * $httpbrowser
1.87      matthew  2600: 
1.112     bowersj2 2601: =item * $clientbrowser
1.87      matthew  2602: 
1.112     bowersj2 2603: =item * $clientversion
1.87      matthew  2604: 
1.112     bowersj2 2605: =item * $clientmathml
1.87      matthew  2606: 
1.112     bowersj2 2607: =item * $clientunicode
1.87      matthew  2608: 
1.112     bowersj2 2609: =item * $clientos
1.87      matthew  2610: 
1.1075.2.42  raeburn  2611: =item * $clientmobile
                   2612: 
                   2613: =item * $clientinfo
                   2614: 
1.1075.2.77  raeburn  2615: =item * $clientosversion
                   2616: 
1.87      matthew  2617: =back
                   2618: 
1.157     matthew  2619: =back 
                   2620: 
1.87      matthew  2621: =cut
                   2622: 
                   2623: ###############################################################
                   2624: ###############################################################
                   2625: sub decode_user_agent {
1.247     albertel 2626:     my ($r)=@_;
1.87      matthew  2627:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2628:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2629:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2630:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2631:     my $clientbrowser='unknown';
                   2632:     my $clientversion='0';
                   2633:     my $clientmathml='';
                   2634:     my $clientunicode='0';
1.1075.2.42  raeburn  2635:     my $clientmobile=0;
1.1075.2.77  raeburn  2636:     my $clientosversion='';
1.87      matthew  2637:     for (my $i=0;$i<=$#browsertype;$i++) {
1.1075.2.76  raeburn  2638:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87      matthew  2639: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2640: 	    $clientbrowser=$bname;
                   2641:             $httpbrowser=~/$vreg/i;
                   2642: 	    $clientversion=$1;
                   2643:             $clientmathml=($clientversion>=$minv);
                   2644:             $clientunicode=($clientversion>=$univ);
                   2645: 	}
                   2646:     }
                   2647:     my $clientos='unknown';
1.1075.2.42  raeburn  2648:     my $clientinfo;
1.87      matthew  2649:     if (($httpbrowser=~/linux/i) ||
                   2650:         ($httpbrowser=~/unix/i) ||
                   2651:         ($httpbrowser=~/ux/i) ||
                   2652:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2653:     if (($httpbrowser=~/vax/i) ||
                   2654:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2655:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2656:     if (($httpbrowser=~/mac/i) ||
                   2657:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1075.2.77  raeburn  2658:     if ($httpbrowser=~/win/i) {
                   2659:         $clientos='win';
                   2660:         if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
                   2661:             $clientosversion = $1;
                   2662:         }
                   2663:     }
1.87      matthew  2664:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42  raeburn  2665:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2666:         $clientmobile=lc($1);
                   2667:     }
                   2668:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2669:         $clientinfo = 'firefox-'.$1;
                   2670:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2671:         $clientinfo = 'chromeframe-'.$1;
                   2672:     }
1.87      matthew  2673:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.77  raeburn  2674:             $clientunicode,$clientos,$clientmobile,$clientinfo,
                   2675:             $clientosversion);
1.87      matthew  2676: }
                   2677: 
1.32      matthew  2678: ###############################################################
                   2679: ##    Authentication changing form generation subroutines    ##
                   2680: ###############################################################
                   2681: ##
                   2682: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2683: ## hash, and have reasonable default values.
                   2684: ##
                   2685: ##    formname = the name given in the <form> tag.
1.35      matthew  2686: #-------------------------------------------
                   2687: 
1.45      matthew  2688: =pod
                   2689: 
1.112     bowersj2 2690: =head1 Authentication Routines
                   2691: 
                   2692: =over 4
                   2693: 
1.648     raeburn  2694: =item * &authform_xxxxxx()
1.35      matthew  2695: 
                   2696: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2697: handle some of the conveniences required for authentication forms.  
                   2698: This is not an optimal method, but it works.  
                   2699: 
                   2700: =over 4
                   2701: 
1.112     bowersj2 2702: =item * authform_header
1.35      matthew  2703: 
1.112     bowersj2 2704: =item * authform_authorwarning
1.35      matthew  2705: 
1.112     bowersj2 2706: =item * authform_nochange
1.35      matthew  2707: 
1.112     bowersj2 2708: =item * authform_kerberos
1.35      matthew  2709: 
1.112     bowersj2 2710: =item * authform_internal
1.35      matthew  2711: 
1.112     bowersj2 2712: =item * authform_filesystem
1.35      matthew  2713: 
                   2714: =back
                   2715: 
1.648     raeburn  2716: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2717: 
1.35      matthew  2718: =cut
                   2719: 
                   2720: #-------------------------------------------
1.32      matthew  2721: sub authform_header{  
                   2722:     my %in = (
                   2723:         formname => 'cu',
1.80      albertel 2724:         kerb_def_dom => '',
1.32      matthew  2725:         @_,
                   2726:     );
                   2727:     $in{'formname'} = 'document.' . $in{'formname'};
                   2728:     my $result='';
1.80      albertel 2729: 
                   2730: #---------------------------------------------- Code for upper case translation
                   2731:     my $Javascript_toUpperCase;
                   2732:     unless ($in{kerb_def_dom}) {
                   2733:         $Javascript_toUpperCase =<<"END";
                   2734:         switch (choice) {
                   2735:            case 'krb': currentform.elements[choicearg].value =
                   2736:                currentform.elements[choicearg].value.toUpperCase();
                   2737:                break;
                   2738:            default:
                   2739:         }
                   2740: END
                   2741:     } else {
                   2742:         $Javascript_toUpperCase = "";
                   2743:     }
                   2744: 
1.165     raeburn  2745:     my $radioval = "'nochange'";
1.591     raeburn  2746:     if (defined($in{'curr_authtype'})) {
                   2747:         if ($in{'curr_authtype'} ne '') {
                   2748:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2749:         }
1.174     matthew  2750:     }
1.165     raeburn  2751:     my $argfield = 'null';
1.591     raeburn  2752:     if (defined($in{'mode'})) {
1.165     raeburn  2753:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2754:             if (defined($in{'curr_autharg'})) {
                   2755:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2756:                     $argfield = "'$in{'curr_autharg'}'";
                   2757:                 }
                   2758:             }
                   2759:         }
                   2760:     }
                   2761: 
1.32      matthew  2762:     $result.=<<"END";
                   2763: var current = new Object();
1.165     raeburn  2764: current.radiovalue = $radioval;
                   2765: current.argfield = $argfield;
1.32      matthew  2766: 
                   2767: function changed_radio(choice,currentform) {
                   2768:     var choicearg = choice + 'arg';
                   2769:     // If a radio button in changed, we need to change the argfield
                   2770:     if (current.radiovalue != choice) {
                   2771:         current.radiovalue = choice;
                   2772:         if (current.argfield != null) {
                   2773:             currentform.elements[current.argfield].value = '';
                   2774:         }
                   2775:         if (choice == 'nochange') {
                   2776:             current.argfield = null;
                   2777:         } else {
                   2778:             current.argfield = choicearg;
                   2779:             switch(choice) {
                   2780:                 case 'krb': 
                   2781:                     currentform.elements[current.argfield].value = 
                   2782:                         "$in{'kerb_def_dom'}";
                   2783:                 break;
                   2784:               default:
                   2785:                 break;
                   2786:             }
                   2787:         }
                   2788:     }
                   2789:     return;
                   2790: }
1.22      www      2791: 
1.32      matthew  2792: function changed_text(choice,currentform) {
                   2793:     var choicearg = choice + 'arg';
                   2794:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2795:         $Javascript_toUpperCase
1.32      matthew  2796:         // clear old field
                   2797:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2798:             currentform.elements[current.argfield].value = '';
                   2799:         }
                   2800:         current.argfield = choicearg;
                   2801:     }
                   2802:     set_auth_radio_buttons(choice,currentform);
                   2803:     return;
1.20      www      2804: }
1.32      matthew  2805: 
                   2806: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2807:     var numauthchoices = currentform.login.length;
                   2808:     if (typeof numauthchoices  == "undefined") {
                   2809:         return;
                   2810:     } 
1.32      matthew  2811:     var i=0;
1.986     raeburn  2812:     while (i < numauthchoices) {
1.32      matthew  2813:         if (currentform.login[i].value == newvalue) { break; }
                   2814:         i++;
                   2815:     }
1.986     raeburn  2816:     if (i == numauthchoices) {
1.32      matthew  2817:         return;
                   2818:     }
                   2819:     current.radiovalue = newvalue;
                   2820:     currentform.login[i].checked = true;
                   2821:     return;
                   2822: }
                   2823: END
                   2824:     return $result;
                   2825: }
                   2826: 
1.1075.2.20  raeburn  2827: sub authform_authorwarning {
1.32      matthew  2828:     my $result='';
1.144     matthew  2829:     $result='<i>'.
                   2830:         &mt('As a general rule, only authors or co-authors should be '.
                   2831:             'filesystem authenticated '.
                   2832:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2833:     return $result;
                   2834: }
                   2835: 
1.1075.2.20  raeburn  2836: sub authform_nochange {
1.32      matthew  2837:     my %in = (
                   2838:               formname => 'document.cu',
                   2839:               kerb_def_dom => 'MSU.EDU',
                   2840:               @_,
                   2841:           );
1.1075.2.20  raeburn  2842:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); 
1.586     raeburn  2843:     my $result;
1.1075.2.20  raeburn  2844:     if (!$authnum) {
                   2845:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2846:     } else {
                   2847:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2848:                   '<input type="radio" name="login" value="nochange" '.
                   2849:                   'checked="checked" onclick="'.
1.281     albertel 2850:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2851: 	    '</label>';
1.586     raeburn  2852:     }
1.32      matthew  2853:     return $result;
                   2854: }
                   2855: 
1.591     raeburn  2856: sub authform_kerberos {
1.32      matthew  2857:     my %in = (
                   2858:               formname => 'document.cu',
                   2859:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2860:               kerb_def_auth => 'krb4',
1.32      matthew  2861:               @_,
                   2862:               );
1.586     raeburn  2863:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1075.2.117  raeburn  2864:         $autharg,$jscall,$disabled);
1.1075.2.20  raeburn  2865:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2866:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2867:        $check5 = ' checked="checked"';
1.80      albertel 2868:     } else {
1.772     bisitz   2869:        $check4 = ' checked="checked"';
1.80      albertel 2870:     }
1.1075.2.117  raeburn  2871:     if ($in{'readonly'}) {
                   2872:         $disabled = ' disabled="disabled"';
                   2873:     }
1.165     raeburn  2874:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2875:     if (defined($in{'curr_authtype'})) {
                   2876:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2877:             $krbcheck = ' checked="checked"';
1.623     raeburn  2878:             if (defined($in{'mode'})) {
                   2879:                 if ($in{'mode'} eq 'modifyuser') {
                   2880:                     $krbcheck = '';
                   2881:                 }
                   2882:             }
1.591     raeburn  2883:             if (defined($in{'curr_kerb_ver'})) {
                   2884:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2885:                     $check5 = ' checked="checked"';
1.591     raeburn  2886:                     $check4 = '';
                   2887:                 } else {
1.772     bisitz   2888:                     $check4 = ' checked="checked"';
1.591     raeburn  2889:                     $check5 = '';
                   2890:                 }
1.586     raeburn  2891:             }
1.591     raeburn  2892:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2893:                 $krbarg = $in{'curr_autharg'};
                   2894:             }
1.586     raeburn  2895:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2896:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2897:                     $result = 
                   2898:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2899:         $in{'curr_autharg'},$krbver);
                   2900:                 } else {
                   2901:                     $result =
                   2902:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2903:                 }
                   2904:                 return $result; 
                   2905:             }
                   2906:         }
                   2907:     } else {
                   2908:         if ($authnum == 1) {
1.784     bisitz   2909:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2910:         }
                   2911:     }
1.586     raeburn  2912:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2913:         return;
1.587     raeburn  2914:     } elsif ($authtype eq '') {
1.591     raeburn  2915:         if (defined($in{'mode'})) {
1.587     raeburn  2916:             if ($in{'mode'} eq 'modifycourse') {
                   2917:                 if ($authnum == 1) {
1.1075.2.117  raeburn  2918:                     $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587     raeburn  2919:                 }
                   2920:             }
                   2921:         }
1.586     raeburn  2922:     }
                   2923:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2924:     if ($authtype eq '') {
                   2925:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2926:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1075.2.117  raeburn  2927:                     $krbcheck.$disabled.' />';
1.586     raeburn  2928:     }
                   2929:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20  raeburn  2930:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2931:          $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20  raeburn  2932:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2933:          $in{'curr_authtype'} eq 'krb4')) {
                   2934:         $result .= &mt
1.144     matthew  2935:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2936:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2937:          '<label>'.$authtype,
1.281     albertel 2938:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2939:              'value="'.$krbarg.'" '.
1.1075.2.117  raeburn  2940:              'onchange="'.$jscall.'"'.$disabled.' />',
                   2941:          '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
                   2942:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281     albertel 2943: 	 '</label>');
1.586     raeburn  2944:     } elsif ($can_assign{'krb4'}) {
                   2945:         $result .= &mt
                   2946:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2947:          '[_3] Version 4 [_4]',
                   2948:          '<label>'.$authtype,
                   2949:          '</label><input type="text" size="10" name="krbarg" '.
                   2950:              'value="'.$krbarg.'" '.
1.1075.2.117  raeburn  2951:              'onchange="'.$jscall.'"'.$disabled.' />',
1.586     raeburn  2952:          '<label><input type="hidden" name="krbver" value="4" />',
                   2953:          '</label>');
                   2954:     } elsif ($can_assign{'krb5'}) {
                   2955:         $result .= &mt
                   2956:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2957:          '[_3] Version 5 [_4]',
                   2958:          '<label>'.$authtype,
                   2959:          '</label><input type="text" size="10" name="krbarg" '.
                   2960:              'value="'.$krbarg.'" '.
1.1075.2.117  raeburn  2961:              'onchange="'.$jscall.'"'.$disabled.' />',
1.586     raeburn  2962:          '<label><input type="hidden" name="krbver" value="5" />',
                   2963:          '</label>');
                   2964:     }
1.32      matthew  2965:     return $result;
                   2966: }
                   2967: 
1.1075.2.20  raeburn  2968: sub authform_internal {
1.586     raeburn  2969:     my %in = (
1.32      matthew  2970:                 formname => 'document.cu',
                   2971:                 kerb_def_dom => 'MSU.EDU',
                   2972:                 @_,
                   2973:                 );
1.1075.2.117  raeburn  2974:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20  raeburn  2975:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117  raeburn  2976:     if ($in{'readonly'}) {
                   2977:         $disabled = ' disabled="disabled"';
                   2978:     }
1.591     raeburn  2979:     if (defined($in{'curr_authtype'})) {
                   2980:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2981:             if ($can_assign{'int'}) {
1.772     bisitz   2982:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2983:                 if (defined($in{'mode'})) {
                   2984:                     if ($in{'mode'} eq 'modifyuser') {
                   2985:                         $intcheck = '';
                   2986:                     }
                   2987:                 }
1.591     raeburn  2988:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2989:                     $intarg = $in{'curr_autharg'};
                   2990:                 }
                   2991:             } else {
                   2992:                 $result = &mt('Currently internally authenticated.');
                   2993:                 return $result;
1.165     raeburn  2994:             }
                   2995:         }
1.586     raeburn  2996:     } else {
                   2997:         if ($authnum == 1) {
1.784     bisitz   2998:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2999:         }
                   3000:     }
                   3001:     if (!$can_assign{'int'}) {
                   3002:         return;
1.587     raeburn  3003:     } elsif ($authtype eq '') {
1.591     raeburn  3004:         if (defined($in{'mode'})) {
1.587     raeburn  3005:             if ($in{'mode'} eq 'modifycourse') {
                   3006:                 if ($authnum == 1) {
1.1075.2.117  raeburn  3007:                     $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587     raeburn  3008:                 }
                   3009:             }
                   3010:         }
1.165     raeburn  3011:     }
1.586     raeburn  3012:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   3013:     if ($authtype eq '') {
                   3014:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1075.2.117  raeburn  3015:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3016:     }
1.605     bisitz   3017:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1075.2.117  raeburn  3018:                $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3019:     $result = &mt
1.144     matthew  3020:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  3021:          '<label>'.$authtype,'</label>'.$autharg);
1.1075.2.118  raeburn  3022:     $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  3023:     return $result;
                   3024: }
                   3025: 
1.1075.2.20  raeburn  3026: sub authform_local {
1.32      matthew  3027:     my %in = (
                   3028:               formname => 'document.cu',
                   3029:               kerb_def_dom => 'MSU.EDU',
                   3030:               @_,
                   3031:               );
1.1075.2.117  raeburn  3032:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20  raeburn  3033:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117  raeburn  3034:     if ($in{'readonly'}) {
                   3035:         $disabled = ' disabled="disabled"';
                   3036:     }
1.591     raeburn  3037:     if (defined($in{'curr_authtype'})) {
                   3038:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  3039:             if ($can_assign{'loc'}) {
1.772     bisitz   3040:                 $loccheck = 'checked="checked" ';
1.623     raeburn  3041:                 if (defined($in{'mode'})) {
                   3042:                     if ($in{'mode'} eq 'modifyuser') {
                   3043:                         $loccheck = '';
                   3044:                     }
                   3045:                 }
1.591     raeburn  3046:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3047:                     $locarg = $in{'curr_autharg'};
                   3048:                 }
                   3049:             } else {
                   3050:                 $result = &mt('Currently using local (institutional) authentication.');
                   3051:                 return $result;
1.165     raeburn  3052:             }
                   3053:         }
1.586     raeburn  3054:     } else {
                   3055:         if ($authnum == 1) {
1.784     bisitz   3056:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  3057:         }
                   3058:     }
                   3059:     if (!$can_assign{'loc'}) {
                   3060:         return;
1.587     raeburn  3061:     } elsif ($authtype eq '') {
1.591     raeburn  3062:         if (defined($in{'mode'})) {
1.587     raeburn  3063:             if ($in{'mode'} eq 'modifycourse') {
                   3064:                 if ($authnum == 1) {
1.1075.2.117  raeburn  3065:                     $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587     raeburn  3066:                 }
                   3067:             }
                   3068:         }
1.165     raeburn  3069:     }
1.586     raeburn  3070:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   3071:     if ($authtype eq '') {
                   3072:         $authtype = '<input type="radio" name="login" value="loc" '.
                   3073:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1075.2.117  raeburn  3074:                     $jscall.'"'.$disabled.' />';
1.586     raeburn  3075:     }
                   3076:     $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1075.2.117  raeburn  3077:                $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3078:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   3079:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  3080:     return $result;
                   3081: }
                   3082: 
1.1075.2.20  raeburn  3083: sub authform_filesystem {
1.32      matthew  3084:     my %in = (
                   3085:               formname => 'document.cu',
                   3086:               kerb_def_dom => 'MSU.EDU',
                   3087:               @_,
                   3088:               );
1.1075.2.117  raeburn  3089:     my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20  raeburn  3090:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117  raeburn  3091:     if ($in{'readonly'}) {
                   3092:         $disabled = ' disabled="disabled"';
                   3093:     }
1.591     raeburn  3094:     if (defined($in{'curr_authtype'})) {
                   3095:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  3096:             if ($can_assign{'fsys'}) {
1.772     bisitz   3097:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  3098:                 if (defined($in{'mode'})) {
                   3099:                     if ($in{'mode'} eq 'modifyuser') {
                   3100:                         $fsyscheck = '';
                   3101:                     }
                   3102:                 }
1.586     raeburn  3103:             } else {
                   3104:                 $result = &mt('Currently Filesystem Authenticated.');
                   3105:                 return $result;
                   3106:             }           
                   3107:         }
                   3108:     } else {
                   3109:         if ($authnum == 1) {
1.784     bisitz   3110:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  3111:         }
                   3112:     }
                   3113:     if (!$can_assign{'fsys'}) {
                   3114:         return;
1.587     raeburn  3115:     } elsif ($authtype eq '') {
1.591     raeburn  3116:         if (defined($in{'mode'})) {
1.587     raeburn  3117:             if ($in{'mode'} eq 'modifycourse') {
                   3118:                 if ($authnum == 1) {
1.1075.2.117  raeburn  3119:                     $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587     raeburn  3120:                 }
                   3121:             }
                   3122:         }
1.586     raeburn  3123:     }
                   3124:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   3125:     if ($authtype eq '') {
                   3126:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   3127:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1075.2.117  raeburn  3128:                     $jscall.'"'.$disabled.' />';
1.586     raeburn  3129:     }
1.1075.2.158  raeburn  3130:     $autharg = '<input type="password" size="10" name="fsysarg" value=""'.
1.1075.2.117  raeburn  3131:                ' onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3132:     $result = &mt
1.144     matthew  3133:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.1075.2.158  raeburn  3134:          '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  3135:     return $result;
                   3136: }
                   3137: 
1.586     raeburn  3138: sub get_assignable_auth {
                   3139:     my ($dom) = @_;
                   3140:     if ($dom eq '') {
                   3141:         $dom = $env{'request.role.domain'};
                   3142:     }
                   3143:     my %can_assign = (
                   3144:                           krb4 => 1,
                   3145:                           krb5 => 1,
                   3146:                           int  => 1,
                   3147:                           loc  => 1,
                   3148:                      );
                   3149:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   3150:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   3151:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   3152:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   3153:             my $context;
                   3154:             if ($env{'request.role'} =~ /^au/) {
                   3155:                 $context = 'author';
1.1075.2.117  raeburn  3156:             } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586     raeburn  3157:                 $context = 'domain';
                   3158:             } elsif ($env{'request.course.id'}) {
                   3159:                 $context = 'course';
                   3160:             }
                   3161:             if ($context) {
                   3162:                 if (ref($authhash->{$context}) eq 'HASH') {
                   3163:                    %can_assign = %{$authhash->{$context}}; 
                   3164:                 }
                   3165:             }
                   3166:         }
                   3167:     }
                   3168:     my $authnum = 0;
                   3169:     foreach my $key (keys(%can_assign)) {
                   3170:         if ($can_assign{$key}) {
                   3171:             $authnum ++;
                   3172:         }
                   3173:     }
                   3174:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   3175:         $authnum --;
                   3176:     }
                   3177:     return ($authnum,%can_assign);
                   3178: }
                   3179: 
1.1075.2.137  raeburn  3180: sub check_passwd_rules {
                   3181:     my ($domain,$plainpass) = @_;
                   3182:     my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
                   3183:     my ($min,$max,@chars,@brokerule,$warning);
1.1075.2.138  raeburn  3184:     $min = $Apache::lonnet::passwdmin;
1.1075.2.137  raeburn  3185:     if (ref($passwdconf{'chars'}) eq 'ARRAY') {
                   3186:         if ($passwdconf{'min'} =~ /^\d+$/) {
1.1075.2.138  raeburn  3187:             if ($passwdconf{'min'} > $min) {
                   3188:                 $min = $passwdconf{'min'};
                   3189:             }
1.1075.2.137  raeburn  3190:         }
                   3191:         if ($passwdconf{'max'} =~ /^\d+$/) {
                   3192:             $max = $passwdconf{'max'};
                   3193:         }
                   3194:         @chars = @{$passwdconf{'chars'}};
                   3195:     }
                   3196:     if (($min) && (length($plainpass) < $min)) {
                   3197:         push(@brokerule,'min');
                   3198:     }
                   3199:     if (($max) && (length($plainpass) > $max)) {
                   3200:         push(@brokerule,'max');
                   3201:     }
                   3202:     if (@chars) {
                   3203:         my %rules;
                   3204:         map { $rules{$_} = 1; } @chars;
                   3205:         if ($rules{'uc'}) {
                   3206:             unless ($plainpass =~ /[A-Z]/) {
                   3207:                 push(@brokerule,'uc');
                   3208:             }
                   3209:         }
                   3210:         if ($rules{'lc'}) {
                   3211:             unless ($plainpass =~ /[a-z]/) {
                   3212:                 push(@brokerule,'lc');
                   3213:             }
                   3214:         }
                   3215:         if ($rules{'num'}) {
                   3216:             unless ($plainpass =~ /\d/) {
                   3217:                 push(@brokerule,'num');
                   3218:             }
                   3219:         }
                   3220:         if ($rules{'spec'}) {
                   3221:             unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
                   3222:                 push(@brokerule,'spec');
                   3223:             }
                   3224:         }
                   3225:     }
                   3226:     if (@brokerule) {
                   3227:         my %rulenames = &Apache::lonlocal::texthash(
                   3228:             uc   => 'At least one upper case letter',
                   3229:             lc   => 'At least one lower case letter',
                   3230:             num  => 'At least one number',
                   3231:             spec => 'At least one non-alphanumeric',
                   3232:         );
                   3233:         $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
                   3234:         $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
                   3235:         $rulenames{'num'} .= ': 0123456789';
                   3236:         $rulenames{'spec'} .= ': !&quot;\#$%&amp;\'()*+,-./:;&lt;=&gt;?@[\]^_\`{|}~';
                   3237:         $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
                   3238:         $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
                   3239:         $warning = &mt('Password did not satisfy the following:').'<ul>';
1.1075.2.143  raeburn  3240:         foreach my $rule ('min','max','uc','lc','num','spec') {
1.1075.2.137  raeburn  3241:             if (grep(/^$rule$/,@brokerule)) {
                   3242:                 $warning .= '<li>'.$rulenames{$rule}.'</li>';
                   3243:             }
                   3244:         }
                   3245:         $warning .= '</ul>';
                   3246:     }
                   3247:     if (wantarray) {
                   3248:         return @brokerule;
                   3249:     }
                   3250:     return $warning;
                   3251: }
                   3252: 
1.80      albertel 3253: ###############################################################
                   3254: ##    Get Kerberos Defaults for Domain                 ##
                   3255: ###############################################################
                   3256: ##
                   3257: ## Returns default kerberos version and an associated argument
                   3258: ## as listed in file domain.tab. If not listed, provides
                   3259: ## appropriate default domain and kerberos version.
                   3260: ##
                   3261: #-------------------------------------------
                   3262: 
                   3263: =pod
                   3264: 
1.648     raeburn  3265: =item * &get_kerberos_defaults()
1.80      albertel 3266: 
                   3267: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  3268: version and domain. If not found, it defaults to version 4 and the 
                   3269: domain of the server.
1.80      albertel 3270: 
1.648     raeburn  3271: =over 4
                   3272: 
1.80      albertel 3273: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   3274: 
1.648     raeburn  3275: =back
                   3276: 
                   3277: =back
                   3278: 
1.80      albertel 3279: =cut
                   3280: 
                   3281: #-------------------------------------------
                   3282: sub get_kerberos_defaults {
                   3283:     my $domain=shift;
1.641     raeburn  3284:     my ($krbdef,$krbdefdom);
                   3285:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   3286:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   3287:         $krbdef = $domdefaults{'auth_def'};
                   3288:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   3289:     } else {
1.80      albertel 3290:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   3291:         my $krbdefdom=$1;
                   3292:         $krbdefdom=~tr/a-z/A-Z/;
                   3293:         $krbdef = "krb4";
                   3294:     }
                   3295:     return ($krbdef,$krbdefdom);
                   3296: }
1.112     bowersj2 3297: 
1.32      matthew  3298: 
1.46      matthew  3299: ###############################################################
                   3300: ##                Thesaurus Functions                        ##
                   3301: ###############################################################
1.20      www      3302: 
1.46      matthew  3303: =pod
1.20      www      3304: 
1.112     bowersj2 3305: =head1 Thesaurus Functions
                   3306: 
                   3307: =over 4
                   3308: 
1.648     raeburn  3309: =item * &initialize_keywords()
1.46      matthew  3310: 
                   3311: Initializes the package variable %Keywords if it is empty.  Uses the
                   3312: package variable $thesaurus_db_file.
                   3313: 
                   3314: =cut
                   3315: 
                   3316: ###################################################
                   3317: 
                   3318: sub initialize_keywords {
                   3319:     return 1 if (scalar keys(%Keywords));
                   3320:     # If we are here, %Keywords is empty, so fill it up
                   3321:     #   Make sure the file we need exists...
                   3322:     if (! -e $thesaurus_db_file) {
                   3323:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   3324:                                  " failed because it does not exist");
                   3325:         return 0;
                   3326:     }
                   3327:     #   Set up the hash as a database
                   3328:     my %thesaurus_db;
                   3329:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3330:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3331:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   3332:                                  $thesaurus_db_file);
                   3333:         return 0;
                   3334:     } 
                   3335:     #  Get the average number of appearances of a word.
                   3336:     my $avecount = $thesaurus_db{'average.count'};
                   3337:     #  Put keywords (those that appear > average) into %Keywords
                   3338:     while (my ($word,$data)=each (%thesaurus_db)) {
                   3339:         my ($count,undef) = split /:/,$data;
                   3340:         $Keywords{$word}++ if ($count > $avecount);
                   3341:     }
                   3342:     untie %thesaurus_db;
                   3343:     # Remove special values from %Keywords.
1.356     albertel 3344:     foreach my $value ('total.count','average.count') {
                   3345:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  3346:   }
1.46      matthew  3347:     return 1;
                   3348: }
                   3349: 
                   3350: ###################################################
                   3351: 
                   3352: =pod
                   3353: 
1.648     raeburn  3354: =item * &keyword($word)
1.46      matthew  3355: 
                   3356: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   3357: than the average number of times in the thesaurus database.  Calls 
                   3358: &initialize_keywords
                   3359: 
                   3360: =cut
                   3361: 
                   3362: ###################################################
1.20      www      3363: 
                   3364: sub keyword {
1.46      matthew  3365:     return if (!&initialize_keywords());
                   3366:     my $word=lc(shift());
                   3367:     $word=~s/\W//g;
                   3368:     return exists($Keywords{$word});
1.20      www      3369: }
1.46      matthew  3370: 
                   3371: ###############################################################
                   3372: 
                   3373: =pod 
1.20      www      3374: 
1.648     raeburn  3375: =item * &get_related_words()
1.46      matthew  3376: 
1.160     matthew  3377: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  3378: an array of words.  If the keyword is not in the thesaurus, an empty array
                   3379: will be returned.  The order of the words returned is determined by the
                   3380: database which holds them.
                   3381: 
                   3382: Uses global $thesaurus_db_file.
                   3383: 
1.1057    foxr     3384: 
1.46      matthew  3385: =cut
                   3386: 
                   3387: ###############################################################
                   3388: sub get_related_words {
                   3389:     my $keyword = shift;
                   3390:     my %thesaurus_db;
                   3391:     if (! -e $thesaurus_db_file) {
                   3392:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3393:                                  "failed because the file does not exist");
                   3394:         return ();
                   3395:     }
                   3396:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3397:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3398:         return ();
                   3399:     } 
                   3400:     my @Words=();
1.429     www      3401:     my $count=0;
1.46      matthew  3402:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3403: 	# The first element is the number of times
                   3404: 	# the word appears.  We do not need it now.
1.429     www      3405: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3406: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3407: 	my $threshold=$mostfrequentcount/10;
                   3408:         foreach my $possibleword (@RelatedWords) {
                   3409:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3410:             if ($wordcount>$threshold) {
                   3411: 		push(@Words,$word);
                   3412:                 $count++;
                   3413:                 if ($count>10) { last; }
                   3414: 	    }
1.20      www      3415:         }
                   3416:     }
1.46      matthew  3417:     untie %thesaurus_db;
                   3418:     return @Words;
1.14      harris41 3419: }
1.46      matthew  3420: 
1.112     bowersj2 3421: =pod
                   3422: 
                   3423: =back
                   3424: 
                   3425: =cut
1.61      www      3426: 
                   3427: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3428: =pod
                   3429: 
1.112     bowersj2 3430: =head1 User Name Functions
                   3431: 
                   3432: =over 4
                   3433: 
1.648     raeburn  3434: =item * &plainname($uname,$udom,$first)
1.81      albertel 3435: 
1.112     bowersj2 3436: Takes a users logon name and returns it as a string in
1.226     albertel 3437: "first middle last generation" form 
                   3438: if $first is set to 'lastname' then it returns it as
                   3439: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3440: 
                   3441: =cut
1.61      www      3442: 
1.295     www      3443: 
1.81      albertel 3444: ###############################################################
1.61      www      3445: sub plainname {
1.226     albertel 3446:     my ($uname,$udom,$first)=@_;
1.537     albertel 3447:     return if (!defined($uname) || !defined($udom));
1.295     www      3448:     my %names=&getnames($uname,$udom);
1.226     albertel 3449:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3450: 					  $names{'middlename'},
                   3451: 					  $names{'lastname'},
                   3452: 					  $names{'generation'},$first);
                   3453:     $name=~s/^\s+//;
1.62      www      3454:     $name=~s/\s+$//;
                   3455:     $name=~s/\s+/ /g;
1.353     albertel 3456:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3457:     return $name;
1.61      www      3458: }
1.66      www      3459: 
                   3460: # -------------------------------------------------------------------- Nickname
1.81      albertel 3461: =pod
                   3462: 
1.648     raeburn  3463: =item * &nickname($uname,$udom)
1.81      albertel 3464: 
                   3465: Gets a users name and returns it as a string as
                   3466: 
                   3467: "&quot;nickname&quot;"
1.66      www      3468: 
1.81      albertel 3469: if the user has a nickname or
                   3470: 
                   3471: "first middle last generation"
                   3472: 
                   3473: if the user does not
                   3474: 
                   3475: =cut
1.66      www      3476: 
                   3477: sub nickname {
                   3478:     my ($uname,$udom)=@_;
1.537     albertel 3479:     return if (!defined($uname) || !defined($udom));
1.295     www      3480:     my %names=&getnames($uname,$udom);
1.68      albertel 3481:     my $name=$names{'nickname'};
1.66      www      3482:     if ($name) {
                   3483:        $name='&quot;'.$name.'&quot;'; 
                   3484:     } else {
                   3485:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3486: 	     $names{'lastname'}.' '.$names{'generation'};
                   3487:        $name=~s/\s+$//;
                   3488:        $name=~s/\s+/ /g;
                   3489:     }
                   3490:     return $name;
                   3491: }
                   3492: 
1.295     www      3493: sub getnames {
                   3494:     my ($uname,$udom)=@_;
1.537     albertel 3495:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3496:     if ($udom eq 'public' && $uname eq 'public') {
                   3497: 	return ('lastname' => &mt('Public'));
                   3498:     }
1.295     www      3499:     my $id=$uname.':'.$udom;
                   3500:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3501:     if ($cached) {
                   3502: 	return %{$names};
                   3503:     } else {
                   3504: 	my %loadnames=&Apache::lonnet::get('environment',
                   3505:                     ['firstname','middlename','lastname','generation','nickname'],
                   3506: 					 $udom,$uname);
                   3507: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3508: 	return %loadnames;
                   3509:     }
                   3510: }
1.61      www      3511: 
1.542     raeburn  3512: # -------------------------------------------------------------------- getemails
1.648     raeburn  3513: 
1.542     raeburn  3514: =pod
                   3515: 
1.648     raeburn  3516: =item * &getemails($uname,$udom)
1.542     raeburn  3517: 
                   3518: Gets a user's email information and returns it as a hash with keys:
                   3519: notification, critnotification, permanentemail
                   3520: 
                   3521: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3522: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3523:  
1.648     raeburn  3524: 
1.542     raeburn  3525: =cut
                   3526: 
1.648     raeburn  3527: 
1.466     albertel 3528: sub getemails {
                   3529:     my ($uname,$udom)=@_;
                   3530:     if ($udom eq 'public' && $uname eq 'public') {
                   3531: 	return;
                   3532:     }
1.467     www      3533:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3534:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3535:     my $id=$uname.':'.$udom;
                   3536:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3537:     if ($cached) {
                   3538: 	return %{$names};
                   3539:     } else {
                   3540: 	my %loadnames=&Apache::lonnet::get('environment',
                   3541:                     			   ['notification','critnotification',
                   3542: 					    'permanentemail'],
                   3543: 					   $udom,$uname);
                   3544: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3545: 	return %loadnames;
                   3546:     }
                   3547: }
                   3548: 
1.551     albertel 3549: sub flush_email_cache {
                   3550:     my ($uname,$udom)=@_;
                   3551:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3552:     if (!$uname) { $uname=$env{'user.name'};   }
                   3553:     return if ($udom eq 'public' && $uname eq 'public');
                   3554:     my $id=$uname.':'.$udom;
                   3555:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3556: }
                   3557: 
1.728     raeburn  3558: # -------------------------------------------------------------------- getlangs
                   3559: 
                   3560: =pod
                   3561: 
                   3562: =item * &getlangs($uname,$udom)
                   3563: 
                   3564: Gets a user's language preference and returns it as a hash with key:
                   3565: language.
                   3566: 
                   3567: =cut
                   3568: 
                   3569: 
                   3570: sub getlangs {
                   3571:     my ($uname,$udom) = @_;
                   3572:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3573:     if (!$uname) { $uname=$env{'user.name'};   }
                   3574:     my $id=$uname.':'.$udom;
                   3575:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3576:     if ($cached) {
                   3577:         return %{$langs};
                   3578:     } else {
                   3579:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3580:                                            $udom,$uname);
                   3581:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3582:         return %loadlangs;
                   3583:     }
                   3584: }
                   3585: 
                   3586: sub flush_langs_cache {
                   3587:     my ($uname,$udom)=@_;
                   3588:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3589:     if (!$uname) { $uname=$env{'user.name'};   }
                   3590:     return if ($udom eq 'public' && $uname eq 'public');
                   3591:     my $id=$uname.':'.$udom;
                   3592:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3593: }
                   3594: 
1.61      www      3595: # ------------------------------------------------------------------ Screenname
1.81      albertel 3596: 
                   3597: =pod
                   3598: 
1.648     raeburn  3599: =item * &screenname($uname,$udom)
1.81      albertel 3600: 
                   3601: Gets a users screenname and returns it as a string
                   3602: 
                   3603: =cut
1.61      www      3604: 
                   3605: sub screenname {
                   3606:     my ($uname,$udom)=@_;
1.258     albertel 3607:     if ($uname eq $env{'user.name'} &&
                   3608: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3609:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3610:     return $names{'screenname'};
1.62      www      3611: }
                   3612: 
1.212     albertel 3613: 
1.802     bisitz   3614: # ------------------------------------------------------------- Confirm Wrapper
                   3615: =pod
                   3616: 
1.1075.2.42  raeburn  3617: =item * &confirmwrapper($message)
1.802     bisitz   3618: 
                   3619: Wrap messages about completion of operation in box
                   3620: 
                   3621: =cut
                   3622: 
                   3623: sub confirmwrapper {
                   3624:     my ($message)=@_;
                   3625:     if ($message) {
                   3626:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3627:                .$message."\n"
                   3628:                .'</div>'."\n";
                   3629:     } else {
                   3630:         return $message;
                   3631:     }
                   3632: }
                   3633: 
1.62      www      3634: # ------------------------------------------------------------- Message Wrapper
                   3635: 
                   3636: sub messagewrapper {
1.369     www      3637:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3638:     return 
1.441     albertel 3639:         '<a href="/adm/email?compose=individual&amp;'.
                   3640:         'recname='.$username.'&amp;recdom='.$domain.
                   3641: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3642:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3643: }
1.802     bisitz   3644: 
1.74      www      3645: # --------------------------------------------------------------- Notes Wrapper
                   3646: 
                   3647: sub noteswrapper {
                   3648:     my ($link,$un,$do)=@_;
                   3649:     return 
1.896     amueller 3650: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3651: }
1.802     bisitz   3652: 
1.62      www      3653: # ------------------------------------------------------------- Aboutme Wrapper
                   3654: 
                   3655: sub aboutmewrapper {
1.1070    raeburn  3656:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3657:     if (!defined($username)  && !defined($domain)) {
                   3658:         return;
                   3659:     }
1.1075.2.15  raeburn  3660:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3661: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3662: }
                   3663: 
                   3664: # ------------------------------------------------------------ Syllabus Wrapper
                   3665: 
                   3666: sub syllabuswrapper {
1.707     bisitz   3667:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3668:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3669: }
1.14      harris41 3670: 
1.802     bisitz   3671: # -----------------------------------------------------------------------------
                   3672: 
1.208     matthew  3673: sub track_student_link {
1.887     raeburn  3674:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3675:     my $link ="/adm/trackstudent?";
1.208     matthew  3676:     my $title = 'View recent activity';
                   3677:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3678:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3679:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3680:         $title .= ' of this student';
1.268     albertel 3681:     } 
1.208     matthew  3682:     if (defined($target) && $target !~ /^\s*$/) {
                   3683:         $target = qq{target="$target"};
                   3684:     } else {
                   3685:         $target = '';
                   3686:     }
1.268     albertel 3687:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3688:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3689:     $title = &mt($title);
                   3690:     $linktext = &mt($linktext);
1.448     albertel 3691:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3692: 	&help_open_topic('View_recent_activity');
1.208     matthew  3693: }
                   3694: 
1.781     raeburn  3695: sub slot_reservations_link {
                   3696:     my ($linktext,$sname,$sdom,$target) = @_;
                   3697:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3698:     my $title = 'View slot reservation history';
                   3699:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3700:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3701:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3702:         $title .= ' of this student';
                   3703:     }
                   3704:     if (defined($target) && $target !~ /^\s*$/) {
                   3705:         $target = qq{target="$target"};
                   3706:     } else {
                   3707:         $target = '';
                   3708:     }
                   3709:     $title = &mt($title);
                   3710:     $linktext = &mt($linktext);
                   3711:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3712: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3713: 
                   3714: }
                   3715: 
1.508     www      3716: # ===================================================== Display a student photo
                   3717: 
                   3718: 
1.509     albertel 3719: sub student_image_tag {
1.508     www      3720:     my ($domain,$user)=@_;
                   3721:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3722:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3723: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3724:     } else {
                   3725: 	return '';
                   3726:     }
                   3727: }
                   3728: 
1.112     bowersj2 3729: =pod
                   3730: 
                   3731: =back
                   3732: 
                   3733: =head1 Access .tab File Data
                   3734: 
                   3735: =over 4
                   3736: 
1.648     raeburn  3737: =item * &languageids() 
1.112     bowersj2 3738: 
                   3739: returns list of all language ids
                   3740: 
                   3741: =cut
                   3742: 
1.14      harris41 3743: sub languageids {
1.16      harris41 3744:     return sort(keys(%language));
1.14      harris41 3745: }
                   3746: 
1.112     bowersj2 3747: =pod
                   3748: 
1.648     raeburn  3749: =item * &languagedescription() 
1.112     bowersj2 3750: 
                   3751: returns description of a specified language id
                   3752: 
                   3753: =cut
                   3754: 
1.14      harris41 3755: sub languagedescription {
1.125     www      3756:     my $code=shift;
                   3757:     return  ($supported_language{$code}?'* ':'').
                   3758:             $language{$code}.
1.126     www      3759: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3760: }
                   3761: 
1.1048    foxr     3762: =pod
                   3763: 
                   3764: =item * &plainlanguagedescription
                   3765: 
                   3766: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3767: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3768: 
                   3769: =cut
                   3770: 
1.145     www      3771: sub plainlanguagedescription {
                   3772:     my $code=shift;
                   3773:     return $language{$code};
                   3774: }
                   3775: 
1.1048    foxr     3776: =pod
                   3777: 
                   3778: =item * &supportedlanguagecode
                   3779: 
                   3780: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3781: code.
                   3782: 
                   3783: =cut
                   3784: 
1.145     www      3785: sub supportedlanguagecode {
                   3786:     my $code=shift;
                   3787:     return $supported_language{$code};
1.97      www      3788: }
                   3789: 
1.112     bowersj2 3790: =pod
                   3791: 
1.1048    foxr     3792: =item * &latexlanguage()
                   3793: 
                   3794: Given a language key code returns the correspondnig language to use
                   3795: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3796: is no supported hyphenation for the language code.
                   3797: 
                   3798: =cut
                   3799: 
                   3800: sub latexlanguage {
                   3801:     my $code = shift;
                   3802:     return $latex_language{$code};
                   3803: }
                   3804: 
                   3805: =pod
                   3806: 
                   3807: =item * &latexhyphenation()
                   3808: 
                   3809: Same as above but what's supplied is the language as it might be stored
                   3810: in the metadata.
                   3811: 
                   3812: =cut
                   3813: 
                   3814: sub latexhyphenation {
                   3815:     my $key = shift;
                   3816:     return $latex_language_bykey{$key};
                   3817: }
                   3818: 
                   3819: =pod
                   3820: 
1.648     raeburn  3821: =item * &copyrightids() 
1.112     bowersj2 3822: 
                   3823: returns list of all copyrights
                   3824: 
                   3825: =cut
                   3826: 
                   3827: sub copyrightids {
                   3828:     return sort(keys(%cprtag));
                   3829: }
                   3830: 
                   3831: =pod
                   3832: 
1.648     raeburn  3833: =item * &copyrightdescription() 
1.112     bowersj2 3834: 
                   3835: returns description of a specified copyright id
                   3836: 
                   3837: =cut
                   3838: 
                   3839: sub copyrightdescription {
1.166     www      3840:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3841: }
1.197     matthew  3842: 
                   3843: =pod
                   3844: 
1.648     raeburn  3845: =item * &source_copyrightids() 
1.192     taceyjo1 3846: 
                   3847: returns list of all source copyrights
                   3848: 
                   3849: =cut
                   3850: 
                   3851: sub source_copyrightids {
                   3852:     return sort(keys(%scprtag));
                   3853: }
                   3854: 
                   3855: =pod
                   3856: 
1.648     raeburn  3857: =item * &source_copyrightdescription() 
1.192     taceyjo1 3858: 
                   3859: returns description of a specified source copyright id
                   3860: 
                   3861: =cut
                   3862: 
                   3863: sub source_copyrightdescription {
                   3864:     return &mt($scprtag{shift(@_)});
                   3865: }
1.112     bowersj2 3866: 
                   3867: =pod
                   3868: 
1.648     raeburn  3869: =item * &filecategories() 
1.112     bowersj2 3870: 
                   3871: returns list of all file categories
                   3872: 
                   3873: =cut
                   3874: 
                   3875: sub filecategories {
                   3876:     return sort(keys(%category_extensions));
                   3877: }
                   3878: 
                   3879: =pod
                   3880: 
1.648     raeburn  3881: =item * &filecategorytypes() 
1.112     bowersj2 3882: 
                   3883: returns list of file types belonging to a given file
                   3884: category
                   3885: 
                   3886: =cut
                   3887: 
                   3888: sub filecategorytypes {
1.356     albertel 3889:     my ($cat) = @_;
                   3890:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3891: }
                   3892: 
                   3893: =pod
                   3894: 
1.648     raeburn  3895: =item * &fileembstyle() 
1.112     bowersj2 3896: 
                   3897: returns embedding style for a specified file type
                   3898: 
                   3899: =cut
                   3900: 
                   3901: sub fileembstyle {
                   3902:     return $fe{lc(shift(@_))};
1.169     www      3903: }
                   3904: 
1.351     www      3905: sub filemimetype {
                   3906:     return $fm{lc(shift(@_))};
                   3907: }
                   3908: 
1.169     www      3909: 
                   3910: sub filecategoryselect {
                   3911:     my ($name,$value)=@_;
1.189     matthew  3912:     return &select_form($value,$name,
1.970     raeburn  3913:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3914: }
                   3915: 
                   3916: =pod
                   3917: 
1.648     raeburn  3918: =item * &filedescription() 
1.112     bowersj2 3919: 
                   3920: returns description for a specified file type
                   3921: 
                   3922: =cut
                   3923: 
                   3924: sub filedescription {
1.188     matthew  3925:     my $file_description = $fd{lc(shift())};
                   3926:     $file_description =~ s:([\[\]]):~$1:g;
                   3927:     return &mt($file_description);
1.112     bowersj2 3928: }
                   3929: 
                   3930: =pod
                   3931: 
1.648     raeburn  3932: =item * &filedescriptionex() 
1.112     bowersj2 3933: 
                   3934: returns description for a specified file type with
                   3935: extra formatting
                   3936: 
                   3937: =cut
                   3938: 
                   3939: sub filedescriptionex {
                   3940:     my $ex=shift;
1.188     matthew  3941:     my $file_description = $fd{lc($ex)};
                   3942:     $file_description =~ s:([\[\]]):~$1:g;
                   3943:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3944: }
                   3945: 
                   3946: # End of .tab access
                   3947: =pod
                   3948: 
                   3949: =back
                   3950: 
                   3951: =cut
                   3952: 
                   3953: # ------------------------------------------------------------------ File Types
                   3954: sub fileextensions {
                   3955:     return sort(keys(%fe));
                   3956: }
                   3957: 
1.97      www      3958: # ----------------------------------------------------------- Display Languages
                   3959: # returns a hash with all desired display languages
                   3960: #
                   3961: 
                   3962: sub display_languages {
                   3963:     my %languages=();
1.695     raeburn  3964:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3965: 	$languages{$lang}=1;
1.97      www      3966:     }
                   3967:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3968:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3969: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3970: 	    $languages{$lang}=1;
1.97      www      3971:         }
                   3972:     }
                   3973:     return %languages;
1.14      harris41 3974: }
                   3975: 
1.582     albertel 3976: sub languages {
                   3977:     my ($possible_langs) = @_;
1.695     raeburn  3978:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3979:     if (!ref($possible_langs)) {
                   3980: 	if( wantarray ) {
                   3981: 	    return @preferred_langs;
                   3982: 	} else {
                   3983: 	    return $preferred_langs[0];
                   3984: 	}
                   3985:     }
                   3986:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3987:     my @preferred_possibilities;
                   3988:     foreach my $preferred_lang (@preferred_langs) {
                   3989: 	if (exists($possibilities{$preferred_lang})) {
                   3990: 	    push(@preferred_possibilities, $preferred_lang);
                   3991: 	}
                   3992:     }
                   3993:     if( wantarray ) {
                   3994: 	return @preferred_possibilities;
                   3995:     }
                   3996:     return $preferred_possibilities[0];
                   3997: }
                   3998: 
1.742     raeburn  3999: sub user_lang {
                   4000:     my ($touname,$toudom,$fromcid) = @_;
                   4001:     my @userlangs;
                   4002:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   4003:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   4004:                     $env{'course.'.$fromcid.'.languages'}));
                   4005:     } else {
                   4006:         my %langhash = &getlangs($touname,$toudom);
                   4007:         if ($langhash{'languages'} ne '') {
                   4008:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   4009:         } else {
                   4010:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   4011:             if ($domdefs{'lang_def'} ne '') {
                   4012:                 @userlangs = ($domdefs{'lang_def'});
                   4013:             }
                   4014:         }
                   4015:     }
                   4016:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   4017:     my $user_lh = Apache::localize->get_handle(@languages);
                   4018:     return $user_lh;
                   4019: }
                   4020: 
                   4021: 
1.112     bowersj2 4022: ###############################################################
                   4023: ##               Student Answer Attempts                     ##
                   4024: ###############################################################
                   4025: 
                   4026: =pod
                   4027: 
                   4028: =head1 Alternate Problem Views
                   4029: 
                   4030: =over 4
                   4031: 
1.648     raeburn  4032: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1075.2.86  raeburn  4033:     $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112     bowersj2 4034: 
                   4035: Return string with previous attempt on problem. Arguments:
                   4036: 
                   4037: =over 4
                   4038: 
                   4039: =item * $symb: Problem, including path
                   4040: 
                   4041: =item * $username: username of the desired student
                   4042: 
                   4043: =item * $domain: domain of the desired student
1.14      harris41 4044: 
1.112     bowersj2 4045: =item * $course: Course ID
1.14      harris41 4046: 
1.112     bowersj2 4047: =item * $getattempt: Leave blank for all attempts, otherwise put
                   4048:     something
1.14      harris41 4049: 
1.112     bowersj2 4050: =item * $regexp: if string matches this regexp, the string will be
                   4051:     sent to $gradesub
1.14      harris41 4052: 
1.112     bowersj2 4053: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 4054: 
1.1075.2.86  raeburn  4055: =item * $usec: section of the desired student
                   4056: 
                   4057: =item * $identifier: counter for student (multiple students one problem) or
                   4058:     problem (one student; whole sequence).
                   4059: 
1.112     bowersj2 4060: =back
1.14      harris41 4061: 
1.112     bowersj2 4062: The output string is a table containing all desired attempts, if any.
1.16      harris41 4063: 
1.112     bowersj2 4064: =cut
1.1       albertel 4065: 
                   4066: sub get_previous_attempt {
1.1075.2.86  raeburn  4067:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1       albertel 4068:   my $prevattempts='';
1.43      ng       4069:   no strict 'refs';
1.1       albertel 4070:   if ($symb) {
1.3       albertel 4071:     my (%returnhash)=
                   4072:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 4073:     if ($returnhash{'version'}) {
                   4074:       my %lasthash=();
                   4075:       my $version;
                   4076:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.91  raeburn  4077:         foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
                   4078:             if ($key =~ /\.rawrndseed$/) {
                   4079:                 my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
                   4080:                 $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
                   4081:             } else {
                   4082:                 $lasthash{$key}=$returnhash{$version.':'.$key};
                   4083:             }
1.19      harris41 4084:         }
1.1       albertel 4085:       }
1.596     albertel 4086:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   4087:       $prevattempts.='<th>'.&mt('History').'</th>';
1.1075.2.86  raeburn  4088:       my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945     raeburn  4089:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 4090:       foreach my $key (sort(keys(%lasthash))) {
                   4091: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       4092: 	if ($#parts > 0) {
1.31      albertel 4093: 	  my $data=$parts[-1];
1.989     raeburn  4094:           next if ($data eq 'foilorder');
1.31      albertel 4095: 	  pop(@parts);
1.1010    www      4096:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  4097:           if ($data eq 'type') {
                   4098:               unless ($showsurv) {
                   4099:                   my $id = join(',',@parts);
                   4100:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  4101:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   4102:                       $lasthidden{$ign.'.'.$id} = 1;
                   4103:                   }
1.945     raeburn  4104:               }
1.1075.2.86  raeburn  4105:               if ($identifier ne '') {
                   4106:                   my $id = join(',',@parts);
                   4107:                   if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
                   4108:                                                $domain,$username,$usec,undef,$course) =~ /^no/) {
                   4109:                       $hidestatus{$ign.'.'.$id} = 1;
                   4110:                   }
                   4111:               }
                   4112:           } elsif ($data eq 'regrader') {
                   4113:               if (($identifier ne '') && (@parts)) {
                   4114:                   my $id = join(',',@parts);
                   4115:                   $regraded{$ign.'.'.$id} = 1;
                   4116:               }
1.1010    www      4117:           } 
1.31      albertel 4118: 	} else {
1.41      ng       4119: 	  if ($#parts == 0) {
                   4120: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   4121: 	  } else {
                   4122: 	    $prevattempts.='<th>'.$ign.'</th>';
                   4123: 	  }
1.31      albertel 4124: 	}
1.16      harris41 4125:       }
1.596     albertel 4126:       $prevattempts.=&end_data_table_header_row();
1.40      ng       4127:       if ($getattempt eq '') {
1.1075.2.86  raeburn  4128:         my (%solved,%resets,%probstatus);
                   4129:         if (($identifier ne '') && (keys(%regraded) > 0)) {
                   4130:             for ($version=1;$version<=$returnhash{'version'};$version++) {
                   4131:                 foreach my $id (keys(%regraded)) {
                   4132:                     if (($returnhash{$version.':'.$id.'.regrader'}) &&
                   4133:                         ($returnhash{$version.':'.$id.'.tries'} eq '') &&
                   4134:                         ($returnhash{$version.':'.$id.'.award'} eq '')) {
                   4135:                         push(@{$resets{$id}},$version);
                   4136:                     }
                   4137:                 }
                   4138:             }
                   4139:         }
1.40      ng       4140: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.86  raeburn  4141:             my (@hidden,@unsolved);
1.945     raeburn  4142:             if (%typeparts) {
                   4143:                 foreach my $id (keys(%typeparts)) {
1.1075.2.86  raeburn  4144:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
                   4145:                         ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945     raeburn  4146:                         push(@hidden,$id);
1.1075.2.86  raeburn  4147:                     } elsif ($identifier ne '') {
                   4148:                         unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
                   4149:                                 ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
                   4150:                                 ($hidestatus{$id})) {
                   4151:                             next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
                   4152:                             if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
                   4153:                                 push(@{$solved{$id}},$version);
                   4154:                             } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
                   4155:                                      (ref($solved{$id}) eq 'ARRAY')) {
                   4156:                                 my $skip;
                   4157:                                 if (ref($resets{$id}) eq 'ARRAY') {
                   4158:                                     foreach my $reset (@{$resets{$id}}) {
                   4159:                                         if ($reset > $solved{$id}[-1]) {
                   4160:                                             $skip=1;
                   4161:                                             last;
                   4162:                                         }
                   4163:                                     }
                   4164:                                 }
                   4165:                                 unless ($skip) {
                   4166:                                     my ($ign,$partslist) = split(/\./,$id,2);
                   4167:                                     push(@unsolved,$partslist);
                   4168:                                 }
                   4169:                             }
                   4170:                         }
1.945     raeburn  4171:                     }
                   4172:                 }
                   4173:             }
                   4174:             $prevattempts.=&start_data_table_row().
1.1075.2.86  raeburn  4175:                            '<td>'.&mt('Transaction [_1]',$version);
                   4176:             if (@unsolved) {
                   4177:                 $prevattempts .= '<span class="LC_nobreak"><label>'.
                   4178:                                  '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
                   4179:                                  &mt('Hide').'</label></span>';
                   4180:             }
                   4181:             $prevattempts .= '</td>';
1.945     raeburn  4182:             if (@hidden) {
                   4183:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4184:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  4185:                     my $hide;
                   4186:                     foreach my $id (@hidden) {
                   4187:                         if ($key =~ /^\Q$id\E/) {
                   4188:                             $hide = 1;
                   4189:                             last;
                   4190:                         }
                   4191:                     }
                   4192:                     if ($hide) {
                   4193:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   4194:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   4195:                             my $value = &format_previous_attempt_value($key,
                   4196:                                              $returnhash{$version.':'.$key});
                   4197:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   4198:                         } else {
                   4199:                             $prevattempts.='<td>&nbsp;</td>';
                   4200:                         }
                   4201:                     } else {
                   4202:                         if ($key =~ /\./) {
1.1075.2.91  raeburn  4203:                             my $value = $returnhash{$version.':'.$key};
                   4204:                             if ($key =~ /\.rndseed$/) {
                   4205:                                 my ($id) = ($key =~ /^(.+)\.rndseed$/);
                   4206:                                 if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4207:                                     $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4208:                                 }
                   4209:                             }
                   4210:                             $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4211:                                            '&nbsp;</td>';
1.945     raeburn  4212:                         } else {
                   4213:                             $prevattempts.='<td>&nbsp;</td>';
                   4214:                         }
                   4215:                     }
                   4216:                 }
                   4217:             } else {
                   4218: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4219:                     next if ($key =~ /\.foilorder$/);
1.1075.2.91  raeburn  4220:                     my $value = $returnhash{$version.':'.$key};
                   4221:                     if ($key =~ /\.rndseed$/) {
                   4222:                         my ($id) = ($key =~ /^(.+)\.rndseed$/);
                   4223:                         if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4224:                             $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4225:                         }
                   4226:                     }
                   4227:                     $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4228:                                    '&nbsp;</td>';
1.945     raeburn  4229: 	        }
                   4230:             }
                   4231: 	    $prevattempts.=&end_data_table_row();
1.40      ng       4232: 	 }
1.1       albertel 4233:       }
1.945     raeburn  4234:       my @currhidden = keys(%lasthidden);
1.596     albertel 4235:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 4236:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4237:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  4238:           if (%typeparts) {
                   4239:               my $hidden;
                   4240:               foreach my $id (@currhidden) {
                   4241:                   if ($key =~ /^\Q$id\E/) {
                   4242:                       $hidden = 1;
                   4243:                       last;
                   4244:                   }
                   4245:               }
                   4246:               if ($hidden) {
                   4247:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   4248:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   4249:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4250:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4251:                           $value = &$gradesub($value);
                   4252:                       }
                   4253:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   4254:                   } else {
                   4255:                       $prevattempts.='<td>&nbsp;</td>';
                   4256:                   }
                   4257:               } else {
                   4258:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4259:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4260:                       $value = &$gradesub($value);
                   4261:                   }
                   4262:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   4263:               }
                   4264:           } else {
                   4265: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4266: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4267:                   $value = &$gradesub($value);
                   4268:               }
                   4269: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   4270:           }
1.16      harris41 4271:       }
1.596     albertel 4272:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 4273:     } else {
1.596     albertel 4274:       $prevattempts=
                   4275: 	  &start_data_table().&start_data_table_row().
                   4276: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   4277: 	  &end_data_table_row().&end_data_table();
1.1       albertel 4278:     }
                   4279:   } else {
1.596     albertel 4280:     $prevattempts=
                   4281: 	  &start_data_table().&start_data_table_row().
                   4282: 	  '<td>'.&mt('No data.').'</td>'.
                   4283: 	  &end_data_table_row().&end_data_table();
1.1       albertel 4284:   }
1.10      albertel 4285: }
                   4286: 
1.581     albertel 4287: sub format_previous_attempt_value {
                   4288:     my ($key,$value) = @_;
1.1011    www      4289:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 4290: 	$value = &Apache::lonlocal::locallocaltime($value);
                   4291:     } elsif (ref($value) eq 'ARRAY') {
                   4292: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  4293:     } elsif ($key =~ /answerstring$/) {
                   4294:         my %answers = &Apache::lonnet::str2hash($value);
                   4295:         my @anskeys = sort(keys(%answers));
                   4296:         if (@anskeys == 1) {
                   4297:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  4298:             if ($answer =~ m{\0}) {
                   4299:                 $answer =~ s{\0}{,}g;
1.988     raeburn  4300:             }
                   4301:             my $tag_internal_answer_name = 'INTERNAL';
                   4302:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   4303:                 $value = $answer; 
                   4304:             } else {
                   4305:                 $value = $anskeys[0].'='.$answer;
                   4306:             }
                   4307:         } else {
                   4308:             foreach my $ans (@anskeys) {
                   4309:                 my $answer = $answers{$ans};
1.1001    raeburn  4310:                 if ($answer =~ m{\0}) {
                   4311:                     $answer =~ s{\0}{,}g;
1.988     raeburn  4312:                 }
                   4313:                 $value .=  $ans.'='.$answer.'<br />';;
                   4314:             } 
                   4315:         }
1.581     albertel 4316:     } else {
                   4317: 	$value = &unescape($value);
                   4318:     }
                   4319:     return $value;
                   4320: }
                   4321: 
                   4322: 
1.107     albertel 4323: sub relative_to_absolute {
                   4324:     my ($url,$output)=@_;
                   4325:     my $parser=HTML::TokeParser->new(\$output);
                   4326:     my $token;
                   4327:     my $thisdir=$url;
                   4328:     my @rlinks=();
                   4329:     while ($token=$parser->get_token) {
                   4330: 	if ($token->[0] eq 'S') {
                   4331: 	    if ($token->[1] eq 'a') {
                   4332: 		if ($token->[2]->{'href'}) {
                   4333: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   4334: 		}
                   4335: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   4336: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   4337: 	    } elsif ($token->[1] eq 'base') {
                   4338: 		$thisdir=$token->[2]->{'href'};
                   4339: 	    }
                   4340: 	}
                   4341:     }
                   4342:     $thisdir=~s-/[^/]*$--;
1.356     albertel 4343:     foreach my $link (@rlinks) {
1.726     raeburn  4344: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 4345: 		($link=~/^\//) ||
                   4346: 		($link=~/^javascript:/i) ||
                   4347: 		($link=~/^mailto:/i) ||
                   4348: 		($link=~/^\#/)) {
                   4349: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   4350: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 4351: 	}
                   4352:     }
                   4353: # -------------------------------------------------- Deal with Applet codebases
                   4354:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   4355:     return $output;
                   4356: }
                   4357: 
1.112     bowersj2 4358: =pod
                   4359: 
1.648     raeburn  4360: =item * &get_student_view()
1.112     bowersj2 4361: 
                   4362: show a snapshot of what student was looking at
                   4363: 
                   4364: =cut
                   4365: 
1.10      albertel 4366: sub get_student_view {
1.186     albertel 4367:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      4368:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4369:   my (%form);
1.10      albertel 4370:   my @elements=('symb','courseid','domain','username');
                   4371:   foreach my $element (@elements) {
1.186     albertel 4372:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4373:   }
1.186     albertel 4374:   if (defined($moreenv)) {
                   4375:       %form=(%form,%{$moreenv});
                   4376:   }
1.236     albertel 4377:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 4378:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      4379:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 4380:   $userview=~s/\<body[^\>]*\>//gi;
                   4381:   $userview=~s/\<\/body\>//gi;
                   4382:   $userview=~s/\<html\>//gi;
                   4383:   $userview=~s/\<\/html\>//gi;
                   4384:   $userview=~s/\<head\>//gi;
                   4385:   $userview=~s/\<\/head\>//gi;
                   4386:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 4387:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      4388:   if (wantarray) {
                   4389:      return ($userview,$response);
                   4390:   } else {
                   4391:      return $userview;
                   4392:   }
                   4393: }
                   4394: 
                   4395: sub get_student_view_with_retries {
                   4396:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   4397: 
                   4398:     my $ok = 0;                 # True if we got a good response.
                   4399:     my $content;
                   4400:     my $response;
                   4401: 
                   4402:     # Try to get the student_view done. within the retries count:
                   4403:     
                   4404:     do {
                   4405:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   4406:          $ok      = $response->is_success;
                   4407:          if (!$ok) {
                   4408:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   4409:          }
                   4410:          $retries--;
                   4411:     } while (!$ok && ($retries > 0));
                   4412:     
                   4413:     if (!$ok) {
                   4414:        $content = '';          # On error return an empty content.
                   4415:     }
1.651     www      4416:     if (wantarray) {
                   4417:        return ($content, $response);
                   4418:     } else {
                   4419:        return $content;
                   4420:     }
1.11      albertel 4421: }
                   4422: 
1.1075.2.149  raeburn  4423: sub css_links {
                   4424:     my ($currsymb,$level) = @_;
                   4425:     my ($links,@symbs,%cssrefs,%httpref);
                   4426:     if ($level eq 'map') {
                   4427:         my $navmap = Apache::lonnavmaps::navmap->new();
                   4428:         if (ref($navmap)) {
                   4429:             my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
                   4430:             my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
                   4431:             foreach my $res (@resources) {
                   4432:                 if (ref($res) && $res->symb()) {
                   4433:                     push(@symbs,$res->symb());
                   4434:                 }
                   4435:             }
                   4436:         }
                   4437:     } else {
                   4438:         @symbs = ($currsymb);
                   4439:     }
                   4440:     foreach my $symb (@symbs) {
                   4441:         my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
                   4442:         if ($css_href =~ /\S/) {
                   4443:             unless ($css_href =~ m{https?://}) {
                   4444:                 my $url = (&Apache::lonnet::decode_symb($symb))[-1];
                   4445:                 my $proburl =  &Apache::lonnet::clutter($url);
                   4446:                 my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
                   4447:                 unless ($css_href =~ m{^/}) {
                   4448:                     $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
                   4449:                 }
                   4450:                 if ($css_href =~ m{^/(res|uploaded)/}) {
                   4451:                     unless (($httpref{'httpref.'.$css_href}) ||
                   4452:                             (&Apache::lonnet::is_on_map($css_href))) {
                   4453:                         my $thisurl = $proburl;
                   4454:                         if ($env{'httpref.'.$proburl}) {
                   4455:                             $thisurl = $env{'httpref.'.$proburl};
                   4456:                         }
                   4457:                         $httpref{'httpref.'.$css_href} = $thisurl;
                   4458:                     }
                   4459:                 }
                   4460:             }
                   4461:             $cssrefs{$css_href} = 1;
                   4462:         }
                   4463:     }
                   4464:     if (keys(%httpref)) {
                   4465:         &Apache::lonnet::appenv(\%httpref);
                   4466:     }
                   4467:     if (keys(%cssrefs)) {
                   4468:         foreach my $css_href (keys(%cssrefs)) {
                   4469:             next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});
                   4470:             $links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";
                   4471:         }
                   4472:     }
                   4473:     return $links;
                   4474: }
                   4475: 
1.112     bowersj2 4476: =pod
                   4477: 
1.648     raeburn  4478: =item * &get_student_answers() 
1.112     bowersj2 4479: 
                   4480: show a snapshot of how student was answering problem
                   4481: 
                   4482: =cut
                   4483: 
1.11      albertel 4484: sub get_student_answers {
1.100     sakharuk 4485:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      4486:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4487:   my (%moreenv);
1.11      albertel 4488:   my @elements=('symb','courseid','domain','username');
                   4489:   foreach my $element (@elements) {
1.186     albertel 4490:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4491:   }
1.186     albertel 4492:   $moreenv{'grade_target'}='answer';
                   4493:   %moreenv=(%form,%moreenv);
1.497     raeburn  4494:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4495:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4496:   return $userview;
1.1       albertel 4497: }
1.116     albertel 4498: 
                   4499: =pod
                   4500: 
                   4501: =item * &submlink()
                   4502: 
1.242     albertel 4503: Inputs: $text $uname $udom $symb $target
1.116     albertel 4504: 
                   4505: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4506: 
                   4507: =cut
                   4508: 
                   4509: ###############################################
                   4510: sub submlink {
1.242     albertel 4511:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4512:     if (!($uname && $udom)) {
                   4513: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4514: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4515: 	if (!$symb) { $symb=$cursymb; }
                   4516:     }
1.254     matthew  4517:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4518:     $symb=&escape($symb);
1.960     bisitz   4519:     if ($target) { $target=" target=\"$target\""; }
                   4520:     return
                   4521:         '<a href="/adm/grades?command=submission'.
                   4522:         '&amp;symb='.$symb.
                   4523:         '&amp;student='.$uname.
                   4524:         '&amp;userdom='.$udom.'"'.
                   4525:         $target.'>'.$text.'</a>';
1.242     albertel 4526: }
                   4527: ##############################################
                   4528: 
                   4529: =pod
                   4530: 
                   4531: =item * &pgrdlink()
                   4532: 
                   4533: Inputs: $text $uname $udom $symb $target
                   4534: 
                   4535: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4536: 
                   4537: =cut
                   4538: 
                   4539: ###############################################
                   4540: sub pgrdlink {
                   4541:     my $link=&submlink(@_);
                   4542:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4543:     return $link;
                   4544: }
                   4545: ##############################################
                   4546: 
                   4547: =pod
                   4548: 
                   4549: =item * &pprmlink()
                   4550: 
                   4551: Inputs: $text $uname $udom $symb $target
                   4552: 
                   4553: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4554: student and a specific resource
1.242     albertel 4555: 
                   4556: =cut
                   4557: 
                   4558: ###############################################
                   4559: sub pprmlink {
                   4560:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4561:     if (!($uname && $udom)) {
                   4562: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4563: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4564: 	if (!$symb) { $symb=$cursymb; }
                   4565:     }
1.254     matthew  4566:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4567:     $symb=&escape($symb);
1.242     albertel 4568:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4569:     return '<a href="/adm/parmset?command=set&amp;'.
                   4570: 	'symb='.$symb.'&amp;uname='.$uname.
                   4571: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4572: }
                   4573: ##############################################
1.37      matthew  4574: 
1.112     bowersj2 4575: =pod
                   4576: 
                   4577: =back
                   4578: 
                   4579: =cut
                   4580: 
1.37      matthew  4581: ###############################################
1.51      www      4582: 
                   4583: 
                   4584: sub timehash {
1.687     raeburn  4585:     my ($thistime) = @_;
                   4586:     my $timezone = &Apache::lonlocal::gettimezone();
                   4587:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4588:                      ->set_time_zone($timezone);
                   4589:     my $wday = $dt->day_of_week();
                   4590:     if ($wday == 7) { $wday = 0; }
                   4591:     return ( 'second' => $dt->second(),
                   4592:              'minute' => $dt->minute(),
                   4593:              'hour'   => $dt->hour(),
                   4594:              'day'     => $dt->day_of_month(),
                   4595:              'month'   => $dt->month(),
                   4596:              'year'    => $dt->year(),
                   4597:              'weekday' => $wday,
                   4598:              'dayyear' => $dt->day_of_year(),
                   4599:              'dlsav'   => $dt->is_dst() );
1.51      www      4600: }
                   4601: 
1.370     www      4602: sub utc_string {
                   4603:     my ($date)=@_;
1.371     www      4604:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4605: }
                   4606: 
1.51      www      4607: sub maketime {
                   4608:     my %th=@_;
1.687     raeburn  4609:     my ($epoch_time,$timezone,$dt);
                   4610:     $timezone = &Apache::lonlocal::gettimezone();
                   4611:     eval {
                   4612:         $dt = DateTime->new( year   => $th{'year'},
                   4613:                              month  => $th{'month'},
                   4614:                              day    => $th{'day'},
                   4615:                              hour   => $th{'hour'},
                   4616:                              minute => $th{'minute'},
                   4617:                              second => $th{'second'},
                   4618:                              time_zone => $timezone,
                   4619:                          );
                   4620:     };
                   4621:     if (!$@) {
                   4622:         $epoch_time = $dt->epoch;
                   4623:         if ($epoch_time) {
                   4624:             return $epoch_time;
                   4625:         }
                   4626:     }
1.51      www      4627:     return POSIX::mktime(
                   4628:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4629:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4630: }
                   4631: 
                   4632: #########################################
1.51      www      4633: 
                   4634: sub findallcourses {
1.482     raeburn  4635:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4636:     my %roles;
                   4637:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4638:     my %courses;
1.51      www      4639:     my $now=time;
1.482     raeburn  4640:     if (!defined($uname)) {
                   4641:         $uname = $env{'user.name'};
                   4642:     }
                   4643:     if (!defined($udom)) {
                   4644:         $udom = $env{'user.domain'};
                   4645:     }
                   4646:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4647:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4648:         if (!%roles) {
                   4649:             %roles = (
                   4650:                        cc => 1,
1.907     raeburn  4651:                        co => 1,
1.482     raeburn  4652:                        in => 1,
                   4653:                        ep => 1,
                   4654:                        ta => 1,
                   4655:                        cr => 1,
                   4656:                        st => 1,
                   4657:              );
                   4658:         }
                   4659:         foreach my $entry (keys(%roleshash)) {
                   4660:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4661:             if ($trole =~ /^cr/) { 
                   4662:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4663:             } else {
                   4664:                 next if (!exists($roles{$trole}));
                   4665:             }
                   4666:             if ($tend) {
                   4667:                 next if ($tend < $now);
                   4668:             }
                   4669:             if ($tstart) {
                   4670:                 next if ($tstart > $now);
                   4671:             }
1.1058    raeburn  4672:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4673:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4674:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4675:             if ($secpart eq '') {
                   4676:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4677:                 $sec = 'none';
1.1058    raeburn  4678:                 $value .= $cnum.'/';
1.482     raeburn  4679:             } else {
                   4680:                 $cnum = $cnumpart;
                   4681:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4682:                 $value .= $cnum.'/'.$sec;
                   4683:             }
                   4684:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4685:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4686:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4687:                 }
                   4688:             } else {
                   4689:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4690:             }
1.482     raeburn  4691:         }
                   4692:     } else {
                   4693:         foreach my $key (keys(%env)) {
1.483     albertel 4694: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4695:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4696: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4697: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4698: 	        next if (%roles && !exists($roles{$role}));
                   4699: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4700:                 my $active=1;
                   4701:                 if ($starttime) {
                   4702: 		    if ($now<$starttime) { $active=0; }
                   4703:                 }
                   4704:                 if ($endtime) {
                   4705:                     if ($now>$endtime) { $active=0; }
                   4706:                 }
                   4707:                 if ($active) {
1.1058    raeburn  4708:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4709:                     if ($sec eq '') {
                   4710:                         $sec = 'none';
1.1058    raeburn  4711:                     } else {
                   4712:                         $value .= $sec;
                   4713:                     }
                   4714:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4715:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4716:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4717:                         }
                   4718:                     } else {
                   4719:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4720:                     }
1.474     raeburn  4721:                 }
                   4722:             }
1.51      www      4723:         }
                   4724:     }
1.474     raeburn  4725:     return %courses;
1.51      www      4726: }
1.37      matthew  4727: 
1.54      www      4728: ###############################################
1.474     raeburn  4729: 
                   4730: sub blockcheck {
1.1075.2.158  raeburn  4731:     my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
1.490     raeburn  4732: 
1.1075.2.158  raeburn  4733:     unless ($activity eq 'docs') {
                   4734:         my ($has_evb,$check_ipaccess);
                   4735:         my $dom = $env{'user.domain'};
                   4736:         if ($env{'request.course.id'}) {
                   4737:             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4738:             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   4739:             my $checkrole = "cm./$cdom/$cnum";
                   4740:             my $sec = $env{'request.course.sec'};
                   4741:             if ($sec ne '') {
                   4742:                 $checkrole .= "/$sec";
                   4743:             }
                   4744:             if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   4745:                 ($env{'request.role'} !~ /^st/)) {
                   4746:                 $has_evb = 1;
                   4747:             }
                   4748:             unless ($has_evb) {
                   4749:                 if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||
                   4750:                     ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) {
                   4751:                     if ($udom eq $cdom) {
                   4752:                         $check_ipaccess = 1;
                   4753:                     }
                   4754:                 }
                   4755:             }
                   4756:         }
                   4757:         unless ($has_evb || $check_ipaccess) {
                   4758:             my @machinedoms = &Apache::lonnet::current_machine_domains();
                   4759:             if (($dom eq 'public') && ($activity eq 'port')) {
                   4760:                 $dom = $udom;
                   4761:             }
                   4762:             if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
                   4763:                 $check_ipaccess = 1;
                   4764:             } else {
                   4765:                 my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   4766:                 my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
                   4767:                 my $prim = &Apache::lonnet::domain($dom,'primary');
                   4768:                 my $intdom = &Apache::lonnet::internet_dom($prim);
                   4769:                 if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
                   4770:                     if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
                   4771:                         $check_ipaccess = 1;
                   4772:                     }
                   4773:                 }
                   4774:             }
                   4775:         }
                   4776:         if ($check_ipaccess) {
                   4777:             my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
                   4778:             unless (defined($cached)) {
                   4779:                 my %domconfig =
                   4780:                     &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
                   4781:                 $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
                   4782:             }
                   4783:             if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
                   4784:                 foreach my $id (keys(%{$ipaccessref})) {
                   4785:                     if (ref($ipaccessref->{$id}) eq 'HASH') {
                   4786:                         my $range = $ipaccessref->{$id}->{'ip'};
                   4787:                         if ($range) {
                   4788:                             if (&Apache::lonnet::ip_match($clientip,$range)) {
                   4789:                                 if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
                   4790:                                     if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
                   4791:                                         return ('','','',$id,$dom);
                   4792:                                         last;
                   4793:                                     }
                   4794:                                 }
                   4795:                             }
                   4796:                         }
                   4797:                     }
                   4798:                 }
                   4799:             }
                   4800:         }
                   4801:     }
1.1075.2.73  raeburn  4802:     if (defined($udom) && defined($uname)) {
                   4803:         # If uname and udom are for a course, check for blocks in the course.
                   4804:         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
                   4805:             my ($startblock,$endblock,$triggerblock) =
1.1075.2.147  raeburn  4806:                 &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
1.1075.2.73  raeburn  4807:             return ($startblock,$endblock,$triggerblock);
                   4808:         }
                   4809:     } else {
1.490     raeburn  4810:         $udom = $env{'user.domain'};
                   4811:         $uname = $env{'user.name'};
                   4812:     }
                   4813: 
1.502     raeburn  4814:     my $startblock = 0;
                   4815:     my $endblock = 0;
1.1062    raeburn  4816:     my $triggerblock = '';
1.1075.2.160! raeburn  4817:     my %live_courses;
        !          4818:     unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {
        !          4819:         %live_courses = &findallcourses(undef,$uname,$udom);
        !          4820:     }
1.474     raeburn  4821: 
1.490     raeburn  4822:     # If uname is for a user, and activity is course-specific, i.e.,
                   4823:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4824: 
1.490     raeburn  4825:     if (($activity eq 'boards' || $activity eq 'chat' ||
1.1075.2.73  raeburn  4826:          $activity eq 'groups' || $activity eq 'printout') &&
                   4827:         ($env{'request.course.id'})) {
1.490     raeburn  4828:         foreach my $key (keys(%live_courses)) {
                   4829:             if ($key ne $env{'request.course.id'}) {
                   4830:                 delete($live_courses{$key});
                   4831:             }
                   4832:         }
                   4833:     }
                   4834: 
                   4835:     my $otheruser = 0;
                   4836:     my %own_courses;
                   4837:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4838:         # Resource belongs to user other than current user.
                   4839:         $otheruser = 1;
                   4840:         # Gather courses for current user
                   4841:         %own_courses = 
                   4842:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4843:     }
                   4844: 
                   4845:     # Gather active course roles - course coordinator, instructor, 
                   4846:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4847: 
                   4848:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4849:         my ($cdom,$cnum);
                   4850:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4851:             $cdom = $env{'course.'.$course.'.domain'};
                   4852:             $cnum = $env{'course.'.$course.'.num'};
                   4853:         } else {
1.490     raeburn  4854:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4855:         }
                   4856:         my $no_ownblock = 0;
                   4857:         my $no_userblock = 0;
1.533     raeburn  4858:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4859:             # Check if current user has 'evb' priv for this
                   4860:             if (defined($own_courses{$course})) {
                   4861:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4862:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4863:                     if ($sec ne 'none') {
                   4864:                         $checkrole .= '/'.$sec;
                   4865:                     }
                   4866:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4867:                         $no_ownblock = 1;
                   4868:                         last;
                   4869:                     }
                   4870:                 }
                   4871:             }
                   4872:             # if they have 'evb' priv and are currently not playing student
                   4873:             next if (($no_ownblock) &&
                   4874:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4875:         }
1.474     raeburn  4876:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4877:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4878:             if ($sec ne 'none') {
1.482     raeburn  4879:                 $checkrole .= '/'.$sec;
1.474     raeburn  4880:             }
1.490     raeburn  4881:             if ($otheruser) {
                   4882:                 # Resource belongs to user other than current user.
                   4883:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4884:                 my (%allroles,%userroles);
                   4885:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4886:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4887:                         my ($trole,$tdom,$tnum,$tsec);
                   4888:                         if ($entry =~ /^cr/) {
                   4889:                             ($trole,$tdom,$tnum,$tsec) = 
                   4890:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4891:                         } else {
                   4892:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4893:                         }
                   4894:                         my ($spec,$area,$trest);
                   4895:                         $area = '/'.$tdom.'/'.$tnum;
                   4896:                         $trest = $tnum;
                   4897:                         if ($tsec ne '') {
                   4898:                             $area .= '/'.$tsec;
                   4899:                             $trest .= '/'.$tsec;
                   4900:                         }
                   4901:                         $spec = $trole.'.'.$area;
                   4902:                         if ($trole =~ /^cr/) {
                   4903:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4904:                                                               $tdom,$spec,$trest,$area);
                   4905:                         } else {
                   4906:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4907:                                                                 $tdom,$spec,$trest,$area);
                   4908:                         }
                   4909:                     }
1.1075.2.124  raeburn  4910:                     my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058    raeburn  4911:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4912:                         if ($1) {
                   4913:                             $no_userblock = 1;
                   4914:                             last;
                   4915:                         }
1.486     raeburn  4916:                     }
                   4917:                 }
1.490     raeburn  4918:             } else {
                   4919:                 # Resource belongs to current user
                   4920:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4921:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4922:                     $no_ownblock = 1;
                   4923:                     last;
                   4924:                 }
1.474     raeburn  4925:             }
                   4926:         }
                   4927:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4928:         next if (($no_ownblock) &&
1.491     albertel 4929:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4930:         next if ($no_userblock);
1.474     raeburn  4931: 
1.1075.2.128  raeburn  4932:         # Retrieve blocking times and identity of blocker for course
1.490     raeburn  4933:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4934:         
1.1062    raeburn  4935:         my ($start,$end,$trigger) = 
1.1075.2.147  raeburn  4936:             &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
1.502     raeburn  4937:         if (($start != 0) && 
                   4938:             (($startblock == 0) || ($startblock > $start))) {
                   4939:             $startblock = $start;
1.1062    raeburn  4940:             if ($trigger ne '') {
                   4941:                 $triggerblock = $trigger;
                   4942:             }
1.502     raeburn  4943:         }
                   4944:         if (($end != 0)  &&
                   4945:             (($endblock == 0) || ($endblock < $end))) {
                   4946:             $endblock = $end;
1.1062    raeburn  4947:             if ($trigger ne '') {
                   4948:                 $triggerblock = $trigger;
                   4949:             }
1.502     raeburn  4950:         }
1.490     raeburn  4951:     }
1.1062    raeburn  4952:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4953: }
                   4954: 
                   4955: sub get_blocks {
1.1075.2.147  raeburn  4956:     my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
1.490     raeburn  4957:     my $startblock = 0;
                   4958:     my $endblock = 0;
1.1062    raeburn  4959:     my $triggerblock = '';
1.490     raeburn  4960:     my $course = $cdom.'_'.$cnum;
                   4961:     $setters->{$course} = {};
                   4962:     $setters->{$course}{'staff'} = [];
                   4963:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4964:     $setters->{$course}{'triggers'} = [];
                   4965:     my (@blockers,%triggered);
                   4966:     my $now = time;
                   4967:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4968:     if ($activity eq 'docs') {
1.1075.2.148  raeburn  4969:         my ($blocked,$nosymbcache,$noenccheck);
1.1075.2.147  raeburn  4970:         if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
                   4971:             $blocked = 1;
                   4972:             $nosymbcache = 1;
1.1075.2.148  raeburn  4973:             $noenccheck = 1;
1.1075.2.147  raeburn  4974:         }
1.1075.2.148  raeburn  4975:         @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
1.1062    raeburn  4976:         foreach my $block (@blockers) {
                   4977:             if ($block =~ /^firstaccess____(.+)$/) {
                   4978:                 my $item = $1;
                   4979:                 my $type = 'map';
                   4980:                 my $timersymb = $item;
                   4981:                 if ($item eq 'course') {
                   4982:                     $type = 'course';
                   4983:                 } elsif ($item =~ /___\d+___/) {
                   4984:                     $type = 'resource';
                   4985:                 } else {
                   4986:                     $timersymb = &Apache::lonnet::symbread($item);
                   4987:                 }
                   4988:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4989:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4990:                 $triggered{$block} = {
                   4991:                                        start => $start,
                   4992:                                        end   => $end,
                   4993:                                        type  => $type,
                   4994:                                      };
                   4995:             }
                   4996:         }
                   4997:     } else {
                   4998:         foreach my $block (keys(%commblocks)) {
                   4999:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   5000:                 my ($start,$end) = ($1,$2);
                   5001:                 if ($start <= time && $end >= time) {
                   5002:                     if (ref($commblocks{$block}) eq 'HASH') {
                   5003:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   5004:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   5005:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   5006:                                     push(@blockers,$block);
                   5007:                                 }
                   5008:                             }
                   5009:                         }
                   5010:                     }
                   5011:                 }
                   5012:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   5013:                 my $item = $1;
                   5014:                 my $timersymb = $item; 
                   5015:                 my $type = 'map';
                   5016:                 if ($item eq 'course') {
                   5017:                     $type = 'course';
                   5018:                 } elsif ($item =~ /___\d+___/) {
                   5019:                     $type = 'resource';
                   5020:                 } else {
                   5021:                     $timersymb = &Apache::lonnet::symbread($item);
                   5022:                 }
                   5023:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   5024:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   5025:                 if ($start && $end) {
                   5026:                     if (($start <= time) && ($end >= time)) {
1.1075.2.158  raeburn  5027:                         if (ref($commblocks{$block}) eq 'HASH') {
                   5028:                             if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   5029:                                 if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   5030:                                     unless(grep(/^\Q$block\E$/,@blockers)) {
                   5031:                                         push(@blockers,$block);
                   5032:                                         $triggered{$block} = {
                   5033:                                                                start => $start,
                   5034:                                                                end   => $end,
                   5035:                                                                type  => $type,
                   5036:                                                              };
                   5037:                                     }
                   5038:                                 }
                   5039:                             }
1.1062    raeburn  5040:                         }
                   5041:                     }
1.490     raeburn  5042:                 }
1.1062    raeburn  5043:             }
                   5044:         }
                   5045:     }
                   5046:     foreach my $blocker (@blockers) {
                   5047:         my ($staff_name,$staff_dom,$title,$blocks) =
                   5048:             &parse_block_record($commblocks{$blocker});
                   5049:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   5050:         my ($start,$end,$triggertype);
                   5051:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   5052:             ($start,$end) = ($1,$2);
                   5053:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   5054:             $start = $triggered{$blocker}{'start'};
                   5055:             $end = $triggered{$blocker}{'end'};
                   5056:             $triggertype = $triggered{$blocker}{'type'};
                   5057:         }
                   5058:         if ($start) {
                   5059:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   5060:             if ($triggertype) {
                   5061:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   5062:             } else {
                   5063:                 push(@{$$setters{$course}{'triggers'}},0);
                   5064:             }
                   5065:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   5066:                 $startblock = $start;
                   5067:                 if ($triggertype) {
                   5068:                     $triggerblock = $blocker;
1.474     raeburn  5069:                 }
                   5070:             }
1.1062    raeburn  5071:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   5072:                $endblock = $end;
                   5073:                if ($triggertype) {
                   5074:                    $triggerblock = $blocker;
                   5075:                }
                   5076:             }
1.474     raeburn  5077:         }
                   5078:     }
1.1062    raeburn  5079:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  5080: }
                   5081: 
                   5082: sub parse_block_record {
                   5083:     my ($record) = @_;
                   5084:     my ($setuname,$setudom,$title,$blocks);
                   5085:     if (ref($record) eq 'HASH') {
                   5086:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   5087:         $title = &unescape($record->{'event'});
                   5088:         $blocks = $record->{'blocks'};
                   5089:     } else {
                   5090:         my @data = split(/:/,$record,3);
                   5091:         if (scalar(@data) eq 2) {
                   5092:             $title = $data[1];
                   5093:             ($setuname,$setudom) = split(/@/,$data[0]);
                   5094:         } else {
                   5095:             ($setuname,$setudom,$title) = @data;
                   5096:         }
                   5097:         $blocks = { 'com' => 'on' };
                   5098:     }
                   5099:     return ($setuname,$setudom,$title,$blocks);
                   5100: }
                   5101: 
1.854     kalberla 5102: sub blocking_status {
1.1075.2.158  raeburn  5103:     my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
1.1061    raeburn  5104:     my %setters;
1.890     droeschl 5105: 
1.1061    raeburn  5106: # check for active blocking
1.1075.2.158  raeburn  5107:     if ($clientip eq '') {
                   5108:         $clientip = &Apache::lonnet::get_requestor_ip();
                   5109:     }
                   5110:     my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) = 
                   5111:         &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
1.1062    raeburn  5112:     my $blocked = 0;
1.1075.2.158  raeburn  5113:     if (($startblock && $endblock) || ($by_ip)) {
1.1062    raeburn  5114:         $blocked = 1;
                   5115:     }
1.890     droeschl 5116: 
1.1061    raeburn  5117: # caller just wants to know whether a block is active
                   5118:     if (!wantarray) { return $blocked; }
                   5119: 
                   5120: # build a link to a popup window containing the details
                   5121:     my $querystring  = "?activity=$activity";
1.1075.2.158  raeburn  5122: # $uname and $udom decide whose portfolio (or information page) the user is trying to look at
                   5123:     if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) {
1.1075.2.97  raeburn  5124:         $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/);
                   5125:         $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);
1.1062    raeburn  5126:     } elsif ($activity eq 'docs') {
1.1075.2.147  raeburn  5127:         my $showurl = &Apache::lonenc::check_encrypt($url);
                   5128:         $querystring .= '&amp;url='.&HTML::Entities::encode($showurl,'\'&"<>');
                   5129:         if ($symb) {
                   5130:             my $showsymb = &Apache::lonenc::check_encrypt($symb);
                   5131:             $querystring .= '&amp;symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
                   5132:         }
1.1062    raeburn  5133:     }
1.1061    raeburn  5134: 
                   5135:     my $output .= <<'END_MYBLOCK';
                   5136: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   5137:     var options = "width=" + w + ",height=" + h + ",";
                   5138:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   5139:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   5140:     var newWin = window.open(url, wdwName, options);
                   5141:     newWin.focus();
                   5142: }
1.890     droeschl 5143: END_MYBLOCK
1.854     kalberla 5144: 
1.1061    raeburn  5145:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 5146:   
1.1061    raeburn  5147:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  5148:     my $text = &mt('Communication Blocked');
1.1075.2.93  raeburn  5149:     my $class = 'LC_comblock';
1.1062    raeburn  5150:     if ($activity eq 'docs') {
                   5151:         $text = &mt('Content Access Blocked');
1.1075.2.93  raeburn  5152:         $class = '';
1.1063    raeburn  5153:     } elsif ($activity eq 'printout') {
                   5154:         $text = &mt('Printing Blocked');
1.1075.2.97  raeburn  5155:     } elsif ($activity eq 'passwd') {
                   5156:         $text = &mt('Password Changing Blocked');
1.1075.2.158  raeburn  5157:     } elsif ($activity eq 'grades') {
                   5158:         $text = &mt('Gradebook Blocked');
                   5159:     } elsif ($activity eq 'search') {
                   5160:         $text = &mt('Search Blocked');
                   5161:     } elsif ($activity eq 'about') {
                   5162:         $text = &mt('Access to User Information Pages Blocked');
1.1075.2.160! raeburn  5163:     } elsif ($activity eq 'wishlist') {
        !          5164:         $text = &mt('Access to Stored Links Blocked');
        !          5165:     } elsif ($activity eq 'annotate') {
        !          5166:         $text = &mt('Access to Annotations Blocked');
1.1062    raeburn  5167:     }
1.1061    raeburn  5168:     $output .= <<"END_BLOCK";
1.1075.2.93  raeburn  5169: <div class='$class'>
1.869     kalberla 5170:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 5171:   title='$text'>
                   5172:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 5173:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 5174:   title='$text'>$text</a>
1.867     kalberla 5175: </div>
                   5176: 
                   5177: END_BLOCK
1.474     raeburn  5178: 
1.1061    raeburn  5179:     return ($blocked, $output);
1.854     kalberla 5180: }
1.490     raeburn  5181: 
1.60      matthew  5182: ###############################################
                   5183: 
1.682     raeburn  5184: sub check_ip_acc {
1.1075.2.105  raeburn  5185:     my ($acc,$clientip)=@_;
1.682     raeburn  5186:     &Apache::lonxml::debug("acc is $acc");
                   5187:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   5188:         return 1;
                   5189:     }
                   5190:     my $allowed=0;
1.1075.2.144  raeburn  5191:     my $ip;
                   5192:     if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
                   5193:         ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
                   5194:         $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
                   5195:     } else {
1.1075.2.150  raeburn  5196:         my $remote_ip = &Apache::lonnet::get_requestor_ip();
                   5197:         $ip = $remote_ip || $env{'request.host'} || $clientip;
1.1075.2.144  raeburn  5198:     }
1.682     raeburn  5199: 
                   5200:     my $name;
                   5201:     foreach my $pattern (split(',',$acc)) {
                   5202:         $pattern =~ s/^\s*//;
                   5203:         $pattern =~ s/\s*$//;
                   5204:         if ($pattern =~ /\*$/) {
                   5205:             #35.8.*
                   5206:             $pattern=~s/\*//;
                   5207:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   5208:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   5209:             #35.8.3.[34-56]
                   5210:             my $low=$2;
                   5211:             my $high=$3;
                   5212:             $pattern=$1;
                   5213:             if ($ip =~ /^\Q$pattern\E/) {
                   5214:                 my $last=(split(/\./,$ip))[3];
                   5215:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   5216:             }
                   5217:         } elsif ($pattern =~ /^\*/) {
                   5218:             #*.msu.edu
                   5219:             $pattern=~s/\*//;
                   5220:             if (!defined($name)) {
                   5221:                 use Socket;
                   5222:                 my $netaddr=inet_aton($ip);
                   5223:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   5224:             }
                   5225:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   5226:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   5227:             #127.0.0.1
                   5228:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   5229:         } else {
                   5230:             #some.name.com
                   5231:             if (!defined($name)) {
                   5232:                 use Socket;
                   5233:                 my $netaddr=inet_aton($ip);
                   5234:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   5235:             }
                   5236:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   5237:         }
                   5238:         if ($allowed) { last; }
                   5239:     }
                   5240:     return $allowed;
                   5241: }
                   5242: 
                   5243: ###############################################
                   5244: 
1.60      matthew  5245: =pod
                   5246: 
1.112     bowersj2 5247: =head1 Domain Template Functions
                   5248: 
                   5249: =over 4
                   5250: 
                   5251: =item * &determinedomain()
1.60      matthew  5252: 
                   5253: Inputs: $domain (usually will be undef)
                   5254: 
1.63      www      5255: Returns: Determines which domain should be used for designs
1.60      matthew  5256: 
                   5257: =cut
1.54      www      5258: 
1.60      matthew  5259: ###############################################
1.63      www      5260: sub determinedomain {
                   5261:     my $domain=shift;
1.531     albertel 5262:     if (! $domain) {
1.60      matthew  5263:         # Determine domain if we have not been given one
1.893     raeburn  5264:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 5265:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   5266:         if ($env{'request.role.domain'}) { 
                   5267:             $domain=$env{'request.role.domain'}; 
1.60      matthew  5268:         }
                   5269:     }
1.63      www      5270:     return $domain;
                   5271: }
                   5272: ###############################################
1.517     raeburn  5273: 
1.518     albertel 5274: sub devalidate_domconfig_cache {
                   5275:     my ($udom)=@_;
                   5276:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   5277: }
                   5278: 
                   5279: # ---------------------- Get domain configuration for a domain
                   5280: sub get_domainconf {
                   5281:     my ($udom) = @_;
                   5282:     my $cachetime=1800;
                   5283:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   5284:     if (defined($cached)) { return %{$result}; }
                   5285: 
                   5286:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  5287: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  5288:     my (%designhash,%legacy);
1.518     albertel 5289:     if (keys(%domconfig) > 0) {
                   5290:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  5291:             if (keys(%{$domconfig{'login'}})) {
                   5292:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  5293:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1075.2.87  raeburn  5294:                         if (($key eq 'loginvia') || ($key eq 'headtag')) {
                   5295:                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                   5296:                                 foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
                   5297:                                     if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
                   5298:                                         if ($key eq 'loginvia') {
                   5299:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   5300:                                                 my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   5301:                                                 $designhash{$udom.'.login.loginvia'} = $server;
                   5302:                                                 if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   5303:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   5304:                                                 } else {
                   5305:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
                   5306:                                                 }
1.948     raeburn  5307:                                             }
1.1075.2.87  raeburn  5308:                                         } elsif ($key eq 'headtag') {
                   5309:                                             if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
                   5310:                                                 $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948     raeburn  5311:                                             }
1.946     raeburn  5312:                                         }
1.1075.2.87  raeburn  5313:                                         if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
                   5314:                                             $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
                   5315:                                         }
1.946     raeburn  5316:                                     }
                   5317:                                 }
                   5318:                             }
1.1075.2.158  raeburn  5319:                         } elsif ($key eq 'saml') {
                   5320:                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                   5321:                                 foreach my $host (keys(%{$domconfig{'login'}{$key}})) {
                   5322:                                     if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {
                   5323:                                         $designhash{$udom.'.login.'.$key.'_'.$host} = 1;
                   5324:                                         foreach my $item ('text','img','alt','url','title','notsso') {
                   5325:                                             $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};
                   5326:                                         }
                   5327:                                     }
                   5328:                                 }
                   5329:                             }
1.946     raeburn  5330:                         } else {
                   5331:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   5332:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   5333:                                     $domconfig{'login'}{$key}{$img};
                   5334:                             }
1.699     raeburn  5335:                         }
                   5336:                     } else {
                   5337:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   5338:                     }
1.632     raeburn  5339:                 }
                   5340:             } else {
                   5341:                 $legacy{'login'} = 1;
1.518     albertel 5342:             }
1.632     raeburn  5343:         } else {
                   5344:             $legacy{'login'} = 1;
1.518     albertel 5345:         }
                   5346:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  5347:             if (keys(%{$domconfig{'rolecolors'}})) {
                   5348:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   5349:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   5350:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   5351:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   5352:                         }
1.518     albertel 5353:                     }
                   5354:                 }
1.632     raeburn  5355:             } else {
                   5356:                 $legacy{'rolecolors'} = 1;
1.518     albertel 5357:             }
1.632     raeburn  5358:         } else {
                   5359:             $legacy{'rolecolors'} = 1;
1.518     albertel 5360:         }
1.948     raeburn  5361:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   5362:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   5363:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   5364:             }
                   5365:         }
1.632     raeburn  5366:         if (keys(%legacy) > 0) {
                   5367:             my %legacyhash = &get_legacy_domconf($udom);
                   5368:             foreach my $item (keys(%legacyhash)) {
                   5369:                 if ($item =~ /^\Q$udom\E\.login/) {
                   5370:                     if ($legacy{'login'}) { 
                   5371:                         $designhash{$item} = $legacyhash{$item};
                   5372:                     }
                   5373:                 } else {
                   5374:                     if ($legacy{'rolecolors'}) {
                   5375:                         $designhash{$item} = $legacyhash{$item};
                   5376:                     }
1.518     albertel 5377:                 }
                   5378:             }
                   5379:         }
1.632     raeburn  5380:     } else {
                   5381:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 5382:     }
                   5383:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   5384: 				  $cachetime);
                   5385:     return %designhash;
                   5386: }
                   5387: 
1.632     raeburn  5388: sub get_legacy_domconf {
                   5389:     my ($udom) = @_;
                   5390:     my %legacyhash;
                   5391:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   5392:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   5393:     if (-e $designfile) {
1.1075.2.128  raeburn  5394:         if ( open (my $fh,'<',$designfile) ) {
1.632     raeburn  5395:             while (my $line = <$fh>) {
                   5396:                 next if ($line =~ /^\#/);
                   5397:                 chomp($line);
                   5398:                 my ($key,$val)=(split(/\=/,$line));
                   5399:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   5400:             }
                   5401:             close($fh);
                   5402:         }
                   5403:     }
1.1026    raeburn  5404:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  5405:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   5406:     }
                   5407:     return %legacyhash;
                   5408: }
                   5409: 
1.63      www      5410: =pod
                   5411: 
1.112     bowersj2 5412: =item * &domainlogo()
1.63      www      5413: 
                   5414: Inputs: $domain (usually will be undef)
                   5415: 
                   5416: Returns: A link to a domain logo, if the domain logo exists.
                   5417: If the domain logo does not exist, a description of the domain.
                   5418: 
                   5419: =cut
1.112     bowersj2 5420: 
1.63      www      5421: ###############################################
                   5422: sub domainlogo {
1.517     raeburn  5423:     my $domain = &determinedomain(shift);
1.518     albertel 5424:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  5425:     # See if there is a logo
                   5426:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  5427:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 5428:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   5429: 	    if ($imgsrc =~ m{^/res/}) {
                   5430: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   5431: 		&Apache::lonnet::repcopy($local_name);
                   5432: 	    }
                   5433: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  5434:         } 
                   5435:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 5436:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   5437:         return &Apache::lonnet::domain($domain,'description');
1.59      www      5438:     } else {
1.60      matthew  5439:         return '';
1.59      www      5440:     }
                   5441: }
1.63      www      5442: ##############################################
                   5443: 
                   5444: =pod
                   5445: 
1.112     bowersj2 5446: =item * &designparm()
1.63      www      5447: 
                   5448: Inputs: $which parameter; $domain (usually will be undef)
                   5449: 
                   5450: Returns: value of designparamter $which
                   5451: 
                   5452: =cut
1.112     bowersj2 5453: 
1.397     albertel 5454: 
1.400     albertel 5455: ##############################################
1.397     albertel 5456: sub designparm {
                   5457:     my ($which,$domain)=@_;
                   5458:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   5459:         return $env{'environment.color.'.$which};
1.96      www      5460:     }
1.63      www      5461:     $domain=&determinedomain($domain);
1.1016    raeburn  5462:     my %domdesign;
                   5463:     unless ($domain eq 'public') {
                   5464:         %domdesign = &get_domainconf($domain);
                   5465:     }
1.520     raeburn  5466:     my $output;
1.517     raeburn  5467:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   5468:         $output = $domdesign{$domain.'.'.$which};
1.63      www      5469:     } else {
1.520     raeburn  5470:         $output = $defaultdesign{$which};
                   5471:     }
                   5472:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  5473:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 5474:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   5475:             if ($output =~ m{^/res/}) {
                   5476:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   5477:                 &Apache::lonnet::repcopy($local_name);
                   5478:             }
1.520     raeburn  5479:             $output = &lonhttpdurl($output);
                   5480:         }
1.63      www      5481:     }
1.520     raeburn  5482:     return $output;
1.63      www      5483: }
1.59      www      5484: 
1.822     bisitz   5485: ##############################################
                   5486: =pod
                   5487: 
1.832     bisitz   5488: =item * &authorspace()
                   5489: 
1.1028    raeburn  5490: Inputs: $url (usually will be undef).
1.832     bisitz   5491: 
1.1075.2.40  raeburn  5492: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  5493:          directory being viewed (or for which action is being taken). 
                   5494:          If $url is provided, and begins /priv/<domain>/<uname>
                   5495:          the path will be that portion of the $context argument.
                   5496:          Otherwise the path will be for the author space of the current
                   5497:          user when the current role is author, or for that of the 
                   5498:          co-author/assistant co-author space when the current role 
                   5499:          is co-author or assistant co-author.
1.832     bisitz   5500: 
                   5501: =cut
                   5502: 
                   5503: sub authorspace {
1.1028    raeburn  5504:     my ($url) = @_;
                   5505:     if ($url ne '') {
                   5506:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   5507:            return $1;
                   5508:         }
                   5509:     }
1.832     bisitz   5510:     my $caname = '';
1.1024    www      5511:     my $cadom = '';
1.1028    raeburn  5512:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      5513:         ($cadom,$caname) =
1.832     bisitz   5514:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  5515:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   5516:         $caname = $env{'user.name'};
1.1024    www      5517:         $cadom = $env{'user.domain'};
1.832     bisitz   5518:     }
1.1028    raeburn  5519:     if (($caname ne '') && ($cadom ne '')) {
                   5520:         return "/priv/$cadom/$caname/";
                   5521:     }
                   5522:     return;
1.832     bisitz   5523: }
                   5524: 
                   5525: ##############################################
                   5526: =pod
                   5527: 
1.822     bisitz   5528: =item * &head_subbox()
                   5529: 
                   5530: Inputs: $content (contains HTML code with page functions, etc.)
                   5531: 
                   5532: Returns: HTML div with $content
                   5533:          To be included in page header
                   5534: 
                   5535: =cut
                   5536: 
                   5537: sub head_subbox {
                   5538:     my ($content)=@_;
                   5539:     my $output =
1.993     raeburn  5540:         '<div class="LC_head_subbox">'
1.822     bisitz   5541:        .$content
                   5542:        .'</div>'
                   5543: }
                   5544: 
                   5545: ##############################################
                   5546: =pod
                   5547: 
                   5548: =item * &CSTR_pageheader()
                   5549: 
1.1026    raeburn  5550: Input: (optional) filename from which breadcrumb trail is built.
                   5551:        In most cases no input as needed, as $env{'request.filename'}
                   5552:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   5553: 
                   5554: Returns: HTML div with CSTR path and recent box
1.1075.2.40  raeburn  5555:          To be included on Authoring Space pages
1.822     bisitz   5556: 
                   5557: =cut
                   5558: 
                   5559: sub CSTR_pageheader {
1.1026    raeburn  5560:     my ($trailfile) = @_;
                   5561:     if ($trailfile eq '') {
                   5562:         $trailfile = $env{'request.filename'};
                   5563:     }
                   5564: 
                   5565: # this is for resources; directories have customtitle, and crumbs
                   5566: # and select recent are created in lonpubdir.pm
                   5567: 
                   5568:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      5569:     my ($udom,$uname,$thisdisfn)=
1.1075.2.29  raeburn  5570:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  5571:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   5572:     $formaction =~ s{/+}{/}g;
1.822     bisitz   5573: 
                   5574:     my $parentpath = '';
                   5575:     my $lastitem = '';
                   5576:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   5577:         $parentpath = $1;
                   5578:         $lastitem = $2;
                   5579:     } else {
                   5580:         $lastitem = $thisdisfn;
                   5581:     }
1.921     bisitz   5582: 
                   5583:     my $output =
1.822     bisitz   5584:          '<div>'
                   5585:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40  raeburn  5586:         .'<b>'.&mt('Authoring Space:').'</b> '
1.822     bisitz   5587:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   5588:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      5589:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   5590: 
                   5591:     if ($lastitem) {
                   5592:         $output .=
                   5593:              '<span class="LC_filename">'
                   5594:             .$lastitem
                   5595:             .'</span>';
                   5596:     }
                   5597:     $output .=
                   5598:          '<br />'
1.822     bisitz   5599:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   5600:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   5601:         .'</form>'
                   5602:         .&Apache::lonmenu::constspaceform()
                   5603:         .'</div>';
1.921     bisitz   5604: 
                   5605:     return $output;
1.822     bisitz   5606: }
                   5607: 
1.60      matthew  5608: ###############################################
                   5609: ###############################################
                   5610: 
                   5611: =pod
                   5612: 
1.112     bowersj2 5613: =back
                   5614: 
1.549     albertel 5615: =head1 HTML Helpers
1.112     bowersj2 5616: 
                   5617: =over 4
                   5618: 
                   5619: =item * &bodytag()
1.60      matthew  5620: 
                   5621: Returns a uniform header for LON-CAPA web pages.
                   5622: 
                   5623: Inputs: 
                   5624: 
1.112     bowersj2 5625: =over 4
                   5626: 
                   5627: =item * $title, A title to be displayed on the page.
                   5628: 
                   5629: =item * $function, the current role (can be undef).
                   5630: 
                   5631: =item * $addentries, extra parameters for the <body> tag.
                   5632: 
                   5633: =item * $bodyonly, if defined, only return the <body> tag.
                   5634: 
                   5635: =item * $domain, if defined, force a given domain.
                   5636: 
                   5637: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5638:             text interface only)
1.60      matthew  5639: 
1.814     bisitz   5640: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5641:                      navigational links
1.317     albertel 5642: 
1.338     albertel 5643: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5644: 
1.1075.2.12  raeburn  5645: =item * $no_inline_link, if true and in remote mode, don't show the
                   5646:          'Switch To Inline Menu' link
                   5647: 
1.460     albertel 5648: =item * $args, optional argument valid values are
                   5649:             no_auto_mt_title -> prevents &mt()ing the title arg
1.1075.2.133  raeburn  5650:             use_absolute     -> for external resource or syllabus, this will
                   5651:                                 contain https://<hostname> if server uses
                   5652:                                 https (as per hosts.tab), but request is for http
                   5653:             hostname         -> hostname, from $r->hostname().
1.460     albertel 5654: 
1.1075.2.15  raeburn  5655: =item * $advtoolsref, optional argument, ref to an array containing
                   5656:             inlineremote items to be added in "Functions" menu below
                   5657:             breadcrumbs.
                   5658: 
1.112     bowersj2 5659: =back
                   5660: 
1.60      matthew  5661: Returns: A uniform header for LON-CAPA web pages.  
                   5662: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5663: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5664: other decorations will be returned.
                   5665: 
                   5666: =cut
                   5667: 
1.54      www      5668: sub bodytag {
1.831     bisitz   5669:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15  raeburn  5670:         $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339     albertel 5671: 
1.954     raeburn  5672:     my $public;
                   5673:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5674:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5675:         $public = 1;
                   5676:     }
1.460     albertel 5677:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52  raeburn  5678:     my $httphost = $args->{'use_absolute'};
1.1075.2.133  raeburn  5679:     my $hostname = $args->{'hostname'};
1.339     albertel 5680: 
1.183     matthew  5681:     $function = &get_users_function() if (!$function);
1.339     albertel 5682:     my $img =    &designparm($function.'.img',$domain);
                   5683:     my $font =   &designparm($function.'.font',$domain);
                   5684:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5685: 
1.803     bisitz   5686:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5687: 		   'bgcolor' => $pgbg,
1.339     albertel 5688: 		   'text'    => $font,
                   5689:                    'alink'   => &designparm($function.'.alink',$domain),
                   5690: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5691: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5692:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5693: 
1.63      www      5694:  # role and realm
1.1075.2.68  raeburn  5695:     my ($role,$realm) = split(m{\./},$env{'request.role'},2);
                   5696:     if ($realm) {
                   5697:         $realm = '/'.$realm;
                   5698:     }
1.1075.2.159  raeburn  5699:     if ($role eq 'ca') {
1.479     albertel 5700:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5701:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5702:     } 
1.55      www      5703: # realm
1.1075.2.158  raeburn  5704:     my ($cid,$sec);
1.258     albertel 5705:     if ($env{'request.course.id'}) {
1.1075.2.158  raeburn  5706:         $cid = $env{'request.course.id'};
                   5707:         if ($env{'request.course.sec'}) {
                   5708:             $sec = $env{'request.course.sec'};
                   5709:         }
                   5710:     } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {
                   5711:         if (&Apache::lonnet::is_course($1,$2)) {
                   5712:             $cid = $1.'_'.$2;
                   5713:             $sec = $3;
                   5714:         }
                   5715:     }
                   5716:     if ($cid) {
1.378     raeburn  5717:         if ($env{'request.role'} !~ /^cr/) {
                   5718:             $role = &Apache::lonnet::plaintext($role,&course_type());
1.1075.2.115  raeburn  5719:         } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1075.2.121  raeburn  5720:             if ($env{'request.role.desc'}) {
                   5721:                 $role = $env{'request.role.desc'};
                   5722:             } else {
                   5723:                 $role = &mt('Helpdesk[_1]','&nbsp;'.$2);
                   5724:             }
1.1075.2.115  raeburn  5725:         } else {
                   5726:             $role = (split(/\//,$role,4))[-1];
1.378     raeburn  5727:         }
1.1075.2.158  raeburn  5728:         if ($sec) {
                   5729:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$sec;
1.898     raeburn  5730:         }   
1.1075.2.158  raeburn  5731: 	$realm = $env{'course.'.$cid.'.description'};
1.378     raeburn  5732:     } else {
                   5733:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5734:     }
1.433     albertel 5735: 
1.359     albertel 5736:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5737: 
1.438     albertel 5738:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5739: 
1.101     www      5740: # construct main body tag
1.359     albertel 5741:     my $bodytag = "<body $extra_body_attr>".
1.1075.2.100  raeburn  5742: 	&Apache::lontexconvert::init_math_support();
1.252     albertel 5743: 
1.1075.2.38  raeburn  5744:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5745: 
                   5746:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5747:         return $bodytag;
1.1075.2.38  raeburn  5748:     }
1.359     albertel 5749: 
1.954     raeburn  5750:     if ($public) {
1.433     albertel 5751: 	undef($role);
                   5752:     }
1.1075.2.158  raeburn  5753: 
1.762     bisitz   5754:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5755:     #
                   5756:     # Extra info if you are the DC
                   5757:     my $dc_info = '';
1.1075.2.159  raeburn  5758:     if (($env{'user.adv'}) && ($env{'request.course.id'}) &&
1.1075.2.158  raeburn  5759:         (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
1.917     raeburn  5760:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5761:         $dc_info =~ s/\s+$//;
1.359     albertel 5762:     }
                   5763: 
1.1075.2.108  raeburn  5764:     $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.903     droeschl 5765: 
1.1075.2.13  raeburn  5766:     if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5767: 
1.1075.2.38  raeburn  5768: 
                   5769: 
1.1075.2.21  raeburn  5770:     my $funclist;
                   5771:     if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.52  raeburn  5772:         $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
1.1075.2.21  raeburn  5773:                     Apache::lonmenu::serverform();
                   5774:         my $forbodytag;
                   5775:         &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5776:                                             $forcereg,$args->{'group'},
                   5777:                                             $args->{'bread_crumbs'},
1.1075.2.133  raeburn  5778:                                             $advtoolsref,'','',\$forbodytag);
1.1075.2.21  raeburn  5779:         unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5780:             $funclist = $forbodytag;
                   5781:         }
                   5782:     } else {
1.903     droeschl 5783: 
                   5784:         #    if ($env{'request.state'} eq 'construct') {
                   5785:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5786:         #    }
                   5787: 
1.1075.2.38  raeburn  5788:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  5789:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 5790: 
1.1075.2.158  raeburn  5791:         my ($left,$right) = Apache::lonmenu::primary_menu($args->{'links_disabled'});
1.1075.2.2  raeburn  5792: 
1.916     droeschl 5793:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22  raeburn  5794:             if ($dc_info) {
1.1075.2.158  raeburn  5795:                 $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1  raeburn  5796:             }
1.1075.2.38  raeburn  5797:             $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.1075.2.22  raeburn  5798:                            <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5799:             return $bodytag;
                   5800:         }
1.894     droeschl 5801: 
1.927     raeburn  5802:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1075.2.38  raeburn  5803:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5804:         }
1.916     droeschl 5805: 
1.1075.2.38  raeburn  5806:         $bodytag .= $right;
1.852     droeschl 5807: 
1.917     raeburn  5808:         if ($dc_info) {
                   5809:             $dc_info = &dc_courseid_toggle($dc_info);
                   5810:         }
                   5811:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5812: 
1.1075.2.61  raeburn  5813:         #if directed to not display the secondary menu, don't.
                   5814:         if ($args->{'no_secondary_menu'}) {
                   5815:             return $bodytag;
                   5816:         }
1.903     droeschl 5817:         #don't show menus for public users
1.954     raeburn  5818:         if (!$public){
1.1075.2.158  raeburn  5819:             $bodytag .= Apache::lonmenu::secondary_menu($httphost,$args->{'links_disabled'});
1.903     droeschl 5820:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5821:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5822:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5823:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1075.2.133  raeburn  5824:                                 $args->{'bread_crumbs'},'','',$hostname);
1.1075.2.116  raeburn  5825:             } elsif ($forcereg) {
1.1075.2.22  raeburn  5826:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1075.2.116  raeburn  5827:                                                             $args->{'group'},
1.1075.2.133  raeburn  5828:                                                             $args->{'hide_buttons',
                   5829:                                                             $hostname});
1.1075.2.15  raeburn  5830:             } else {
1.1075.2.21  raeburn  5831:                 my $forbodytag;
                   5832:                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5833:                                                     $forcereg,$args->{'group'},
                   5834:                                                     $args->{'bread_crumbs'},
1.1075.2.133  raeburn  5835:                                                     $advtoolsref,'',$hostname,
                   5836:                                                     \$forbodytag);
1.1075.2.21  raeburn  5837:                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5838:                     $bodytag .= $forbodytag;
                   5839:                 }
1.920     raeburn  5840:             }
1.903     droeschl 5841:         }else{
                   5842:             # this is to seperate menu from content when there's no secondary
                   5843:             # menu. Especially needed for public accessible ressources.
                   5844:             $bodytag .= '<hr style="clear:both" />';
                   5845:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5846:         }
1.903     droeschl 5847: 
1.235     raeburn  5848:         return $bodytag;
1.1075.2.12  raeburn  5849:     }
                   5850: 
                   5851: #
                   5852: # Top frame rendering, Remote is up
                   5853: #
                   5854: 
                   5855:     my $imgsrc = $img;
                   5856:     if ($img =~ /^\/adm/) {
                   5857:         $imgsrc = &lonhttpdurl($img);
                   5858:     }
                   5859:     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
                   5860: 
1.1075.2.60  raeburn  5861:     my $help=($no_inline_link?''
                   5862:               :&Apache::loncommon::top_nav_help('Help'));
                   5863: 
1.1075.2.12  raeburn  5864:     # Explicit link to get inline menu
                   5865:     my $menu= ($no_inline_link?''
                   5866:                :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
                   5867: 
                   5868:     if ($dc_info) {
                   5869:         $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
                   5870:     }
                   5871: 
1.1075.2.38  raeburn  5872:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
                   5873:     unless ($public) {
                   5874:         $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
                   5875:                                 undef,'LC_menubuttons_link');
                   5876:     }
                   5877: 
1.1075.2.12  raeburn  5878:     unless ($env{'form.inhibitmenu'}) {
                   5879:         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.1075.2.38  raeburn  5880:                        <ol class="LC_primary_menu LC_floatright LC_right">
1.1075.2.60  raeburn  5881:                        <li>$help</li>
1.1075.2.12  raeburn  5882:                        <li>$menu</li>
                   5883:                        </ol><div id="LC_realm"> $realm $dc_info</div>|;
                   5884:     }
1.1075.2.13  raeburn  5885:     if ($env{'request.state'} eq 'construct') {
                   5886:         if (!$public){
                   5887:             if ($env{'request.state'} eq 'construct') {
                   5888:                 $funclist = &Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  5889:                                 &Apache::lonmenu::utilityfunctions($httphost), 'start').
1.1075.2.13  raeburn  5890:                             &Apache::lonhtmlcommon::scripttag('','end').
                   5891:                             &Apache::lonmenu::innerregister($forcereg,
                   5892:                                                             $args->{'bread_crumbs'});
                   5893:             }
                   5894:         }
                   5895:     }
1.1075.2.21  raeburn  5896:     return $bodytag."\n".$funclist;
1.182     matthew  5897: }
                   5898: 
1.917     raeburn  5899: sub dc_courseid_toggle {
                   5900:     my ($dc_info) = @_;
1.980     raeburn  5901:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5902:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5903:            &mt('(More ...)').'</a></span>'.
                   5904:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5905: }
                   5906: 
1.330     albertel 5907: sub make_attr_string {
                   5908:     my ($register,$attr_ref) = @_;
                   5909: 
                   5910:     if ($attr_ref && !ref($attr_ref)) {
                   5911: 	die("addentries Must be a hash ref ".
                   5912: 	    join(':',caller(1))." ".
                   5913: 	    join(':',caller(0))." ");
                   5914:     }
                   5915: 
                   5916:     if ($register) {
1.339     albertel 5917: 	my ($on_load,$on_unload);
                   5918: 	foreach my $key (keys(%{$attr_ref})) {
                   5919: 	    if      (lc($key) eq 'onload') {
                   5920: 		$on_load.=$attr_ref->{$key}.';';
                   5921: 		delete($attr_ref->{$key});
                   5922: 
                   5923: 	    } elsif (lc($key) eq 'onunload') {
                   5924: 		$on_unload.=$attr_ref->{$key}.';';
                   5925: 		delete($attr_ref->{$key});
                   5926: 	    }
                   5927: 	}
1.1075.2.12  raeburn  5928:         if ($env{'environment.remote'} eq 'on') {
                   5929:             $attr_ref->{'onload'}  =
                   5930:                 &Apache::lonmenu::loadevents().  $on_load;
                   5931:             $attr_ref->{'onunload'}=
                   5932:                 &Apache::lonmenu::unloadevents().$on_unload;
                   5933:         } else {  
                   5934: 	    $attr_ref->{'onload'}  = $on_load;
                   5935: 	    $attr_ref->{'onunload'}= $on_unload;
                   5936:         }
1.330     albertel 5937:     }
1.339     albertel 5938: 
1.330     albertel 5939:     my $attr_string;
1.1075.2.56  raeburn  5940:     foreach my $attr (sort(keys(%$attr_ref))) {
1.330     albertel 5941: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5942:     }
                   5943:     return $attr_string;
                   5944: }
                   5945: 
                   5946: 
1.182     matthew  5947: ###############################################
1.251     albertel 5948: ###############################################
                   5949: 
                   5950: =pod
                   5951: 
                   5952: =item * &endbodytag()
                   5953: 
                   5954: Returns a uniform footer for LON-CAPA web pages.
                   5955: 
1.635     raeburn  5956: Inputs: 1 - optional reference to an args hash
                   5957: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5958: a 'Continue' link is not displayed if the page contains an
                   5959: internal redirect in the <head></head> section,
                   5960: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5961: 
                   5962: =cut
                   5963: 
                   5964: sub endbodytag {
1.635     raeburn  5965:     my ($args) = @_;
1.1075.2.6  raeburn  5966:     my $endbodytag;
                   5967:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5968:         $endbodytag='</body>';
                   5969:     }
1.315     albertel 5970:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5971:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5972: 	    $endbodytag=
                   5973: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5974: 	        &mt('Continue').'</a>'.
                   5975: 	        $endbodytag;
                   5976:         }
1.315     albertel 5977:     }
1.251     albertel 5978:     return $endbodytag;
                   5979: }
                   5980: 
1.352     albertel 5981: =pod
                   5982: 
                   5983: =item * &standard_css()
                   5984: 
                   5985: Returns a style sheet
                   5986: 
                   5987: Inputs: (all optional)
                   5988:             domain         -> force to color decorate a page for a specific
                   5989:                                domain
                   5990:             function       -> force usage of a specific rolish color scheme
                   5991:             bgcolor        -> override the default page bgcolor
                   5992: 
                   5993: =cut
                   5994: 
1.343     albertel 5995: sub standard_css {
1.345     albertel 5996:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5997:     $function  = &get_users_function() if (!$function);
                   5998:     my $img    = &designparm($function.'.img',   $domain);
                   5999:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   6000:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 6001:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 6002: #second colour for later usage
1.345     albertel 6003:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 6004:     my $pgbg_or_bgcolor =
                   6005: 	         $bgcolor ||
1.352     albertel 6006: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 6007:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 6008:     my $alink  = &designparm($function.'.alink', $domain);
                   6009:     my $vlink  = &designparm($function.'.vlink', $domain);
                   6010:     my $link   = &designparm($function.'.link',  $domain);
                   6011: 
1.602     albertel 6012:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 6013:     my $mono                 = 'monospace';
1.850     bisitz   6014:     my $data_table_head      = $sidebg;
                   6015:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   6016:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 6017:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 6018:     my $data_table_highlight = '#FFFF00';
1.352     albertel 6019:     my $mail_new             = '#FFBB77';
                   6020:     my $mail_new_hover       = '#DD9955';
                   6021:     my $mail_read            = '#BBBB77';
                   6022:     my $mail_read_hover      = '#999944';
                   6023:     my $mail_replied         = '#AAAA88';
                   6024:     my $mail_replied_hover   = '#888855';
                   6025:     my $mail_other           = '#99BBBB';
                   6026:     my $mail_other_hover     = '#669999';
1.391     albertel 6027:     my $table_header         = '#DDDDDD';
1.489     raeburn  6028:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   6029:     my $lg_border_color      = '#C8C8C8';
1.952     onken    6030:     my $button_hover         = '#BF2317';
1.392     albertel 6031: 
1.608     albertel 6032:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   6033:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   6034:                                              : '0 3px 0 4px';
1.448     albertel 6035: 
1.523     albertel 6036: 
1.343     albertel 6037:     return <<END;
1.947     droeschl 6038: 
                   6039: /* needed for iframe to allow 100% height in FF */
                   6040: body, html { 
                   6041:     margin: 0;
                   6042:     padding: 0 0.5%;
                   6043:     height: 99%; /* to avoid scrollbars */
                   6044: }
                   6045: 
1.795     www      6046: body {
1.911     bisitz   6047:   font-family: $sans;
                   6048:   line-height:130%;
                   6049:   font-size:0.83em;
                   6050:   color:$font;
1.795     www      6051: }
                   6052: 
1.959     onken    6053: a:focus,
                   6054: a:focus img {
1.795     www      6055:   color: red;
                   6056: }
1.698     harmsja  6057: 
1.911     bisitz   6058: form, .inline {
                   6059:   display: inline;
1.795     www      6060: }
1.721     harmsja  6061: 
1.795     www      6062: .LC_right {
1.911     bisitz   6063:   text-align:right;
1.795     www      6064: }
                   6065: 
                   6066: .LC_middle {
1.911     bisitz   6067:   vertical-align:middle;
1.795     www      6068: }
1.721     harmsja  6069: 
1.1075.2.38  raeburn  6070: .LC_floatleft {
                   6071:   float: left;
                   6072: }
                   6073: 
                   6074: .LC_floatright {
                   6075:   float: right;
                   6076: }
                   6077: 
1.911     bisitz   6078: .LC_400Box {
                   6079:   width:400px;
                   6080: }
1.721     harmsja  6081: 
1.947     droeschl 6082: .LC_iframecontainer {
                   6083:     width: 98%;
                   6084:     margin: 0;
                   6085:     position: fixed;
                   6086:     top: 8.5em;
                   6087:     bottom: 0;
                   6088: }
                   6089: 
                   6090: .LC_iframecontainer iframe{
                   6091:     border: none;
                   6092:     width: 100%;
                   6093:     height: 100%;
                   6094: }
                   6095: 
1.778     bisitz   6096: .LC_filename {
                   6097:   font-family: $mono;
                   6098:   white-space:pre;
1.921     bisitz   6099:   font-size: 120%;
1.778     bisitz   6100: }
                   6101: 
                   6102: .LC_fileicon {
                   6103:   border: none;
                   6104:   height: 1.3em;
                   6105:   vertical-align: text-bottom;
                   6106:   margin-right: 0.3em;
                   6107:   text-decoration:none;
                   6108: }
                   6109: 
1.1008    www      6110: .LC_setting {
                   6111:   text-decoration:underline;
                   6112: }
                   6113: 
1.350     albertel 6114: .LC_error {
                   6115:   color: red;
                   6116: }
1.795     www      6117: 
1.1075.2.15  raeburn  6118: .LC_warning {
                   6119:   color: darkorange;
                   6120: }
                   6121: 
1.457     albertel 6122: .LC_diff_removed {
1.733     bisitz   6123:   color: red;
1.394     albertel 6124: }
1.532     albertel 6125: 
                   6126: .LC_info,
1.457     albertel 6127: .LC_success,
                   6128: .LC_diff_added {
1.350     albertel 6129:   color: green;
                   6130: }
1.795     www      6131: 
1.802     bisitz   6132: div.LC_confirm_box {
                   6133:   background-color: #FAFAFA;
                   6134:   border: 1px solid $lg_border_color;
                   6135:   margin-right: 0;
                   6136:   padding: 5px;
                   6137: }
                   6138: 
                   6139: div.LC_confirm_box .LC_error img,
                   6140: div.LC_confirm_box .LC_success img {
                   6141:   vertical-align: middle;
                   6142: }
                   6143: 
1.1075.2.108  raeburn  6144: .LC_maxwidth {
                   6145:   max-width: 100%;
                   6146:   height: auto;
                   6147: }
                   6148: 
                   6149: .LC_textsize_mobile {
                   6150:   \@media only screen and (max-device-width: 480px) {
                   6151:       -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
                   6152:   }
                   6153: }
                   6154: 
1.440     albertel 6155: .LC_icon {
1.771     droeschl 6156:   border: none;
1.790     droeschl 6157:   vertical-align: middle;
1.771     droeschl 6158: }
                   6159: 
1.543     albertel 6160: .LC_docs_spacer {
                   6161:   width: 25px;
                   6162:   height: 1px;
1.771     droeschl 6163:   border: none;
1.543     albertel 6164: }
1.346     albertel 6165: 
1.532     albertel 6166: .LC_internal_info {
1.735     bisitz   6167:   color: #999999;
1.532     albertel 6168: }
                   6169: 
1.794     www      6170: .LC_discussion {
1.1050    www      6171:   background: $data_table_dark;
1.911     bisitz   6172:   border: 1px solid black;
                   6173:   margin: 2px;
1.794     www      6174: }
                   6175: 
                   6176: .LC_disc_action_left {
1.1050    www      6177:   background: $sidebg;
1.911     bisitz   6178:   text-align: left;
1.1050    www      6179:   padding: 4px;
                   6180:   margin: 2px;
1.794     www      6181: }
                   6182: 
                   6183: .LC_disc_action_right {
1.1050    www      6184:   background: $sidebg;
1.911     bisitz   6185:   text-align: right;
1.1050    www      6186:   padding: 4px;
                   6187:   margin: 2px;
1.794     www      6188: }
                   6189: 
                   6190: .LC_disc_new_item {
1.911     bisitz   6191:   background: white;
                   6192:   border: 2px solid red;
1.1050    www      6193:   margin: 4px;
                   6194:   padding: 4px;
1.794     www      6195: }
                   6196: 
                   6197: .LC_disc_old_item {
1.911     bisitz   6198:   background: white;
1.1050    www      6199:   margin: 4px;
                   6200:   padding: 4px;
1.794     www      6201: }
                   6202: 
1.458     albertel 6203: table.LC_pastsubmission {
                   6204:   border: 1px solid black;
                   6205:   margin: 2px;
                   6206: }
                   6207: 
1.924     bisitz   6208: table#LC_menubuttons {
1.345     albertel 6209:   width: 100%;
                   6210:   background: $pgbg;
1.392     albertel 6211:   border: 2px;
1.402     albertel 6212:   border-collapse: separate;
1.803     bisitz   6213:   padding: 0;
1.345     albertel 6214: }
1.392     albertel 6215: 
1.801     tempelho 6216: table#LC_title_bar a {
                   6217:   color: $fontmenu;
                   6218: }
1.836     bisitz   6219: 
1.807     droeschl 6220: table#LC_title_bar {
1.819     tempelho 6221:   clear: both;
1.836     bisitz   6222:   display: none;
1.807     droeschl 6223: }
                   6224: 
1.795     www      6225: table#LC_title_bar,
1.933     droeschl 6226: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 6227: table#LC_title_bar.LC_with_remote {
1.359     albertel 6228:   width: 100%;
1.392     albertel 6229:   border-color: $pgbg;
                   6230:   border-style: solid;
                   6231:   border-width: $border;
1.379     albertel 6232:   background: $pgbg;
1.801     tempelho 6233:   color: $fontmenu;
1.392     albertel 6234:   border-collapse: collapse;
1.803     bisitz   6235:   padding: 0;
1.819     tempelho 6236:   margin: 0;
1.359     albertel 6237: }
1.795     www      6238: 
1.933     droeschl 6239: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 6240:     margin: 0;
                   6241:     padding: 0;
1.933     droeschl 6242:     position: relative;
                   6243:     list-style: none;
1.913     droeschl 6244: }
1.933     droeschl 6245: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 6246:     display: inline;
                   6247: }
1.933     droeschl 6248: 
                   6249: .LC_breadcrumb_tools_navigation {
1.913     droeschl 6250:     padding: 0;
1.933     droeschl 6251:     margin: 0;
                   6252:     float: left;
1.913     droeschl 6253: }
1.933     droeschl 6254: .LC_breadcrumb_tools_tools {
                   6255:     padding: 0;
                   6256:     margin: 0;
1.913     droeschl 6257:     float: right;
                   6258: }
                   6259: 
1.359     albertel 6260: table#LC_title_bar td {
                   6261:   background: $tabbg;
                   6262: }
1.795     www      6263: 
1.911     bisitz   6264: table#LC_menubuttons img {
1.803     bisitz   6265:   border: none;
1.346     albertel 6266: }
1.795     www      6267: 
1.842     droeschl 6268: .LC_breadcrumbs_component {
1.911     bisitz   6269:   float: right;
                   6270:   margin: 0 1em;
1.357     albertel 6271: }
1.842     droeschl 6272: .LC_breadcrumbs_component img {
1.911     bisitz   6273:   vertical-align: middle;
1.777     tempelho 6274: }
1.795     www      6275: 
1.1075.2.108  raeburn  6276: .LC_breadcrumbs_hoverable {
                   6277:   background: $sidebg;
                   6278: }
                   6279: 
1.383     albertel 6280: td.LC_table_cell_checkbox {
                   6281:   text-align: center;
                   6282: }
1.795     www      6283: 
                   6284: .LC_fontsize_small {
1.911     bisitz   6285:   font-size: 70%;
1.705     tempelho 6286: }
                   6287: 
1.844     bisitz   6288: #LC_breadcrumbs {
1.911     bisitz   6289:   clear:both;
                   6290:   background: $sidebg;
                   6291:   border-bottom: 1px solid $lg_border_color;
                   6292:   line-height: 2.5em;
1.933     droeschl 6293:   overflow: hidden;
1.911     bisitz   6294:   margin: 0;
                   6295:   padding: 0;
1.995     raeburn  6296:   text-align: left;
1.819     tempelho 6297: }
1.862     bisitz   6298: 
1.1075.2.16  raeburn  6299: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   6300:   clear:both;
                   6301:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 6302:   border: 1px solid $sidebg;
1.1075.2.16  raeburn  6303:   margin: 0 0 10px 0;
1.966     bisitz   6304:   padding: 3px;
1.995     raeburn  6305:   text-align: left;
1.822     bisitz   6306: }
                   6307: 
1.795     www      6308: .LC_fontsize_medium {
1.911     bisitz   6309:   font-size: 85%;
1.705     tempelho 6310: }
                   6311: 
1.795     www      6312: .LC_fontsize_large {
1.911     bisitz   6313:   font-size: 120%;
1.705     tempelho 6314: }
                   6315: 
1.346     albertel 6316: .LC_menubuttons_inline_text {
                   6317:   color: $font;
1.698     harmsja  6318:   font-size: 90%;
1.701     harmsja  6319:   padding-left:3px;
1.346     albertel 6320: }
                   6321: 
1.934     droeschl 6322: .LC_menubuttons_inline_text img{
                   6323:   vertical-align: middle;
                   6324: }
                   6325: 
1.1051    www      6326: li.LC_menubuttons_inline_text img {
1.951     onken    6327:   cursor:pointer;
1.1002    droeschl 6328:   text-decoration: none;
1.951     onken    6329: }
                   6330: 
1.526     www      6331: .LC_menubuttons_link {
                   6332:   text-decoration: none;
                   6333: }
1.795     www      6334: 
1.522     albertel 6335: .LC_menubuttons_category {
1.521     www      6336:   color: $font;
1.526     www      6337:   background: $pgbg;
1.521     www      6338:   font-size: larger;
                   6339:   font-weight: bold;
                   6340: }
                   6341: 
1.346     albertel 6342: td.LC_menubuttons_text {
1.911     bisitz   6343:   color: $font;
1.346     albertel 6344: }
1.706     harmsja  6345: 
1.346     albertel 6346: .LC_current_location {
                   6347:   background: $tabbg;
                   6348: }
1.795     www      6349: 
1.1075.2.134  raeburn  6350: td.LC_zero_height {
                   6351:   line-height: 0;
                   6352:   cellpadding: 0;
                   6353: }
                   6354: 
1.938     bisitz   6355: table.LC_data_table {
1.347     albertel 6356:   border: 1px solid #000000;
1.402     albertel 6357:   border-collapse: separate;
1.426     albertel 6358:   border-spacing: 1px;
1.610     albertel 6359:   background: $pgbg;
1.347     albertel 6360: }
1.795     www      6361: 
1.422     albertel 6362: .LC_data_table_dense {
                   6363:   font-size: small;
                   6364: }
1.795     www      6365: 
1.507     raeburn  6366: table.LC_nested_outer {
                   6367:   border: 1px solid #000000;
1.589     raeburn  6368:   border-collapse: collapse;
1.803     bisitz   6369:   border-spacing: 0;
1.507     raeburn  6370:   width: 100%;
                   6371: }
1.795     www      6372: 
1.879     raeburn  6373: table.LC_innerpickbox,
1.507     raeburn  6374: table.LC_nested {
1.803     bisitz   6375:   border: none;
1.589     raeburn  6376:   border-collapse: collapse;
1.803     bisitz   6377:   border-spacing: 0;
1.507     raeburn  6378:   width: 100%;
                   6379: }
1.795     www      6380: 
1.911     bisitz   6381: table.LC_data_table tr th,
                   6382: table.LC_calendar tr th,
1.879     raeburn  6383: table.LC_prior_tries tr th,
                   6384: table.LC_innerpickbox tr th {
1.349     albertel 6385:   font-weight: bold;
                   6386:   background-color: $data_table_head;
1.801     tempelho 6387:   color:$fontmenu;
1.701     harmsja  6388:   font-size:90%;
1.347     albertel 6389: }
1.795     www      6390: 
1.879     raeburn  6391: table.LC_innerpickbox tr th,
                   6392: table.LC_innerpickbox tr td {
                   6393:   vertical-align: top;
                   6394: }
                   6395: 
1.711     raeburn  6396: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   6397:   background-color: #CCCCCC;
1.711     raeburn  6398:   font-weight: bold;
                   6399:   text-align: left;
                   6400: }
1.795     www      6401: 
1.912     bisitz   6402: table.LC_data_table tr.LC_odd_row > td {
                   6403:   background-color: $data_table_light;
                   6404:   padding: 2px;
                   6405:   vertical-align: top;
                   6406: }
                   6407: 
1.809     bisitz   6408: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 6409:   background-color: $data_table_light;
1.912     bisitz   6410:   vertical-align: top;
                   6411: }
                   6412: 
                   6413: table.LC_data_table tr.LC_even_row > td {
                   6414:   background-color: $data_table_dark;
1.425     albertel 6415:   padding: 2px;
1.900     bisitz   6416:   vertical-align: top;
1.347     albertel 6417: }
1.795     www      6418: 
1.809     bisitz   6419: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 6420:   background-color: $data_table_dark;
1.900     bisitz   6421:   vertical-align: top;
1.347     albertel 6422: }
1.795     www      6423: 
1.425     albertel 6424: table.LC_data_table tr.LC_data_table_highlight td {
                   6425:   background-color: $data_table_darker;
                   6426: }
1.795     www      6427: 
1.639     raeburn  6428: table.LC_data_table tr td.LC_leftcol_header {
                   6429:   background-color: $data_table_head;
                   6430:   font-weight: bold;
                   6431: }
1.795     www      6432: 
1.451     albertel 6433: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  6434: table.LC_nested tr.LC_empty_row td {
1.421     albertel 6435:   font-weight: bold;
                   6436:   font-style: italic;
                   6437:   text-align: center;
                   6438:   padding: 8px;
1.347     albertel 6439: }
1.795     www      6440: 
1.1075.2.30  raeburn  6441: table.LC_data_table tr.LC_empty_row td,
                   6442: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   6443:   background-color: $sidebg;
                   6444: }
                   6445: 
                   6446: table.LC_nested tr.LC_empty_row td {
                   6447:   background-color: #FFFFFF;
                   6448: }
                   6449: 
1.890     droeschl 6450: table.LC_caption {
                   6451: }
                   6452: 
1.507     raeburn  6453: table.LC_nested tr.LC_empty_row td {
1.465     albertel 6454:   padding: 4ex
                   6455: }
1.795     www      6456: 
1.507     raeburn  6457: table.LC_nested_outer tr th {
                   6458:   font-weight: bold;
1.801     tempelho 6459:   color:$fontmenu;
1.507     raeburn  6460:   background-color: $data_table_head;
1.701     harmsja  6461:   font-size: small;
1.507     raeburn  6462:   border-bottom: 1px solid #000000;
                   6463: }
1.795     www      6464: 
1.507     raeburn  6465: table.LC_nested_outer tr td.LC_subheader {
                   6466:   background-color: $data_table_head;
                   6467:   font-weight: bold;
                   6468:   font-size: small;
                   6469:   border-bottom: 1px solid #000000;
                   6470:   text-align: right;
1.451     albertel 6471: }
1.795     www      6472: 
1.507     raeburn  6473: table.LC_nested tr.LC_info_row td {
1.735     bisitz   6474:   background-color: #CCCCCC;
1.451     albertel 6475:   font-weight: bold;
                   6476:   font-size: small;
1.507     raeburn  6477:   text-align: center;
                   6478: }
1.795     www      6479: 
1.589     raeburn  6480: table.LC_nested tr.LC_info_row td.LC_left_item,
                   6481: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  6482:   text-align: left;
1.451     albertel 6483: }
1.795     www      6484: 
1.507     raeburn  6485: table.LC_nested td {
1.735     bisitz   6486:   background-color: #FFFFFF;
1.451     albertel 6487:   font-size: small;
1.507     raeburn  6488: }
1.795     www      6489: 
1.507     raeburn  6490: table.LC_nested_outer tr th.LC_right_item,
                   6491: table.LC_nested tr.LC_info_row td.LC_right_item,
                   6492: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   6493: table.LC_nested tr td.LC_right_item {
1.451     albertel 6494:   text-align: right;
                   6495: }
                   6496: 
1.507     raeburn  6497: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   6498:   background-color: #EEEEEE;
1.451     albertel 6499: }
                   6500: 
1.473     raeburn  6501: table.LC_createuser {
                   6502: }
                   6503: 
                   6504: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  6505:   font-size: small;
1.473     raeburn  6506: }
                   6507: 
                   6508: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   6509:   background-color: #CCCCCC;
1.473     raeburn  6510:   font-weight: bold;
                   6511:   text-align: center;
                   6512: }
                   6513: 
1.349     albertel 6514: table.LC_calendar {
                   6515:   border: 1px solid #000000;
                   6516:   border-collapse: collapse;
1.917     raeburn  6517:   width: 98%;
1.349     albertel 6518: }
1.795     www      6519: 
1.349     albertel 6520: table.LC_calendar_pickdate {
                   6521:   font-size: xx-small;
                   6522: }
1.795     www      6523: 
1.349     albertel 6524: table.LC_calendar tr td {
                   6525:   border: 1px solid #000000;
                   6526:   vertical-align: top;
1.917     raeburn  6527:   width: 14%;
1.349     albertel 6528: }
1.795     www      6529: 
1.349     albertel 6530: table.LC_calendar tr td.LC_calendar_day_empty {
                   6531:   background-color: $data_table_dark;
                   6532: }
1.795     www      6533: 
1.779     bisitz   6534: table.LC_calendar tr td.LC_calendar_day_current {
                   6535:   background-color: $data_table_highlight;
1.777     tempelho 6536: }
1.795     www      6537: 
1.938     bisitz   6538: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 6539:   background-color: $mail_new;
                   6540: }
1.795     www      6541: 
1.938     bisitz   6542: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 6543:   background-color: $mail_new_hover;
                   6544: }
1.795     www      6545: 
1.938     bisitz   6546: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 6547:   background-color: $mail_read;
                   6548: }
1.795     www      6549: 
1.938     bisitz   6550: /*
                   6551: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 6552:   background-color: $mail_read_hover;
                   6553: }
1.938     bisitz   6554: */
1.795     www      6555: 
1.938     bisitz   6556: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 6557:   background-color: $mail_replied;
                   6558: }
1.795     www      6559: 
1.938     bisitz   6560: /*
                   6561: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 6562:   background-color: $mail_replied_hover;
                   6563: }
1.938     bisitz   6564: */
1.795     www      6565: 
1.938     bisitz   6566: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 6567:   background-color: $mail_other;
                   6568: }
1.795     www      6569: 
1.938     bisitz   6570: /*
                   6571: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 6572:   background-color: $mail_other_hover;
                   6573: }
1.938     bisitz   6574: */
1.494     raeburn  6575: 
1.777     tempelho 6576: table.LC_data_table tr > td.LC_browser_file,
                   6577: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   6578:   background: #AAEE77;
1.389     albertel 6579: }
1.795     www      6580: 
1.777     tempelho 6581: table.LC_data_table tr > td.LC_browser_file_locked,
                   6582: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 6583:   background: #FFAA99;
1.387     albertel 6584: }
1.795     www      6585: 
1.777     tempelho 6586: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   6587:   background: #888888;
1.779     bisitz   6588: }
1.795     www      6589: 
1.777     tempelho 6590: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   6591: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   6592:   background: #F8F866;
1.777     tempelho 6593: }
1.795     www      6594: 
1.696     bisitz   6595: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   6596:   background: #E0E8FF;
1.387     albertel 6597: }
1.696     bisitz   6598: 
1.707     bisitz   6599: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   6600:   /* background: #77FF77; */
1.707     bisitz   6601: }
1.795     www      6602: 
1.707     bisitz   6603: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   6604:   border-right: 8px solid #FFFF77;
1.707     bisitz   6605: }
1.795     www      6606: 
1.707     bisitz   6607: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   6608:   border-right: 8px solid #FFAA77;
1.707     bisitz   6609: }
1.795     www      6610: 
1.707     bisitz   6611: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   6612:   border-right: 8px solid #FF7777;
1.707     bisitz   6613: }
1.795     www      6614: 
1.707     bisitz   6615: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   6616:   border-right: 8px solid #AAFF77;
1.707     bisitz   6617: }
1.795     www      6618: 
1.707     bisitz   6619: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   6620:   border-right: 8px solid #11CC55;
1.707     bisitz   6621: }
                   6622: 
1.388     albertel 6623: span.LC_current_location {
1.701     harmsja  6624:   font-size:larger;
1.388     albertel 6625:   background: $pgbg;
                   6626: }
1.387     albertel 6627: 
1.1029    www      6628: span.LC_current_nav_location {
                   6629:   font-weight:bold;
                   6630:   background: $sidebg;
                   6631: }
                   6632: 
1.395     albertel 6633: span.LC_parm_menu_item {
                   6634:   font-size: larger;
                   6635: }
1.795     www      6636: 
1.395     albertel 6637: span.LC_parm_scope_all {
                   6638:   color: red;
                   6639: }
1.795     www      6640: 
1.395     albertel 6641: span.LC_parm_scope_folder {
                   6642:   color: green;
                   6643: }
1.795     www      6644: 
1.395     albertel 6645: span.LC_parm_scope_resource {
                   6646:   color: orange;
                   6647: }
1.795     www      6648: 
1.395     albertel 6649: span.LC_parm_part {
                   6650:   color: blue;
                   6651: }
1.795     www      6652: 
1.911     bisitz   6653: span.LC_parm_folder,
                   6654: span.LC_parm_symb {
1.395     albertel 6655:   font-size: x-small;
                   6656:   font-family: $mono;
                   6657:   color: #AAAAAA;
                   6658: }
                   6659: 
1.977     bisitz   6660: ul.LC_parm_parmlist li {
                   6661:   display: inline-block;
                   6662:   padding: 0.3em 0.8em;
                   6663:   vertical-align: top;
                   6664:   width: 150px;
                   6665:   border-top:1px solid $lg_border_color;
                   6666: }
                   6667: 
1.795     www      6668: td.LC_parm_overview_level_menu,
                   6669: td.LC_parm_overview_map_menu,
                   6670: td.LC_parm_overview_parm_selectors,
                   6671: td.LC_parm_overview_restrictions  {
1.396     albertel 6672:   border: 1px solid black;
                   6673:   border-collapse: collapse;
                   6674: }
1.795     www      6675: 
1.396     albertel 6676: table.LC_parm_overview_restrictions td {
                   6677:   border-width: 1px 4px 1px 4px;
                   6678:   border-style: solid;
                   6679:   border-color: $pgbg;
                   6680:   text-align: center;
                   6681: }
1.795     www      6682: 
1.396     albertel 6683: table.LC_parm_overview_restrictions th {
                   6684:   background: $tabbg;
                   6685:   border-width: 1px 4px 1px 4px;
                   6686:   border-style: solid;
                   6687:   border-color: $pgbg;
                   6688: }
1.795     www      6689: 
1.398     albertel 6690: table#LC_helpmenu {
1.803     bisitz   6691:   border: none;
1.398     albertel 6692:   height: 55px;
1.803     bisitz   6693:   border-spacing: 0;
1.398     albertel 6694: }
                   6695: 
                   6696: table#LC_helpmenu fieldset legend {
                   6697:   font-size: larger;
                   6698: }
1.795     www      6699: 
1.397     albertel 6700: table#LC_helpmenu_links {
                   6701:   width: 100%;
                   6702:   border: 1px solid black;
                   6703:   background: $pgbg;
1.803     bisitz   6704:   padding: 0;
1.397     albertel 6705:   border-spacing: 1px;
                   6706: }
1.795     www      6707: 
1.397     albertel 6708: table#LC_helpmenu_links tr td {
                   6709:   padding: 1px;
                   6710:   background: $tabbg;
1.399     albertel 6711:   text-align: center;
                   6712:   font-weight: bold;
1.397     albertel 6713: }
1.396     albertel 6714: 
1.795     www      6715: table#LC_helpmenu_links a:link,
                   6716: table#LC_helpmenu_links a:visited,
1.397     albertel 6717: table#LC_helpmenu_links a:active {
                   6718:   text-decoration: none;
                   6719:   color: $font;
                   6720: }
1.795     www      6721: 
1.397     albertel 6722: table#LC_helpmenu_links a:hover {
                   6723:   text-decoration: underline;
                   6724:   color: $vlink;
                   6725: }
1.396     albertel 6726: 
1.417     albertel 6727: .LC_chrt_popup_exists {
                   6728:   border: 1px solid #339933;
                   6729:   margin: -1px;
                   6730: }
1.795     www      6731: 
1.417     albertel 6732: .LC_chrt_popup_up {
                   6733:   border: 1px solid yellow;
                   6734:   margin: -1px;
                   6735: }
1.795     www      6736: 
1.417     albertel 6737: .LC_chrt_popup {
                   6738:   border: 1px solid #8888FF;
                   6739:   background: #CCCCFF;
                   6740: }
1.795     www      6741: 
1.421     albertel 6742: table.LC_pick_box {
                   6743:   border-collapse: separate;
                   6744:   background: white;
                   6745:   border: 1px solid black;
                   6746:   border-spacing: 1px;
                   6747: }
1.795     www      6748: 
1.421     albertel 6749: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6750:   background: $sidebg;
1.421     albertel 6751:   font-weight: bold;
1.900     bisitz   6752:   text-align: left;
1.740     bisitz   6753:   vertical-align: top;
1.421     albertel 6754:   width: 184px;
                   6755:   padding: 8px;
                   6756: }
1.795     www      6757: 
1.579     raeburn  6758: table.LC_pick_box td.LC_pick_box_value {
                   6759:   text-align: left;
                   6760:   padding: 8px;
                   6761: }
1.795     www      6762: 
1.579     raeburn  6763: table.LC_pick_box td.LC_pick_box_select {
                   6764:   text-align: left;
                   6765:   padding: 8px;
                   6766: }
1.795     www      6767: 
1.424     albertel 6768: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6769:   padding: 0;
1.421     albertel 6770:   height: 1px;
                   6771:   background: black;
                   6772: }
1.795     www      6773: 
1.421     albertel 6774: table.LC_pick_box td.LC_pick_box_submit {
                   6775:   text-align: right;
                   6776: }
1.795     www      6777: 
1.579     raeburn  6778: table.LC_pick_box td.LC_evenrow_value {
                   6779:   text-align: left;
                   6780:   padding: 8px;
                   6781:   background-color: $data_table_light;
                   6782: }
1.795     www      6783: 
1.579     raeburn  6784: table.LC_pick_box td.LC_oddrow_value {
                   6785:   text-align: left;
                   6786:   padding: 8px;
                   6787:   background-color: $data_table_light;
                   6788: }
1.795     www      6789: 
1.579     raeburn  6790: span.LC_helpform_receipt_cat {
                   6791:   font-weight: bold;
                   6792: }
1.795     www      6793: 
1.424     albertel 6794: table.LC_group_priv_box {
                   6795:   background: white;
                   6796:   border: 1px solid black;
                   6797:   border-spacing: 1px;
                   6798: }
1.795     www      6799: 
1.424     albertel 6800: table.LC_group_priv_box td.LC_pick_box_title {
                   6801:   background: $tabbg;
                   6802:   font-weight: bold;
                   6803:   text-align: right;
                   6804:   width: 184px;
                   6805: }
1.795     www      6806: 
1.424     albertel 6807: table.LC_group_priv_box td.LC_groups_fixed {
                   6808:   background: $data_table_light;
                   6809:   text-align: center;
                   6810: }
1.795     www      6811: 
1.424     albertel 6812: table.LC_group_priv_box td.LC_groups_optional {
                   6813:   background: $data_table_dark;
                   6814:   text-align: center;
                   6815: }
1.795     www      6816: 
1.424     albertel 6817: table.LC_group_priv_box td.LC_groups_functionality {
                   6818:   background: $data_table_darker;
                   6819:   text-align: center;
                   6820:   font-weight: bold;
                   6821: }
1.795     www      6822: 
1.424     albertel 6823: table.LC_group_priv td {
                   6824:   text-align: left;
1.803     bisitz   6825:   padding: 0;
1.424     albertel 6826: }
                   6827: 
                   6828: .LC_navbuttons {
                   6829:   margin: 2ex 0ex 2ex 0ex;
                   6830: }
1.795     www      6831: 
1.423     albertel 6832: .LC_topic_bar {
                   6833:   font-weight: bold;
                   6834:   background: $tabbg;
1.918     wenzelju 6835:   margin: 1em 0em 1em 2em;
1.805     bisitz   6836:   padding: 3px;
1.918     wenzelju 6837:   font-size: 1.2em;
1.423     albertel 6838: }
1.795     www      6839: 
1.423     albertel 6840: .LC_topic_bar span {
1.918     wenzelju 6841:   left: 0.5em;
                   6842:   position: absolute;
1.423     albertel 6843:   vertical-align: middle;
1.918     wenzelju 6844:   font-size: 1.2em;
1.423     albertel 6845: }
1.795     www      6846: 
1.423     albertel 6847: table.LC_course_group_status {
                   6848:   margin: 20px;
                   6849: }
1.795     www      6850: 
1.423     albertel 6851: table.LC_status_selector td {
                   6852:   vertical-align: top;
                   6853:   text-align: center;
1.424     albertel 6854:   padding: 4px;
                   6855: }
1.795     www      6856: 
1.599     albertel 6857: div.LC_feedback_link {
1.616     albertel 6858:   clear: both;
1.829     kalberla 6859:   background: $sidebg;
1.779     bisitz   6860:   width: 100%;
1.829     kalberla 6861:   padding-bottom: 10px;
                   6862:   border: 1px $tabbg solid;
1.833     kalberla 6863:   height: 22px;
                   6864:   line-height: 22px;
                   6865:   padding-top: 5px;
                   6866: }
                   6867: 
                   6868: div.LC_feedback_link img {
                   6869:   height: 22px;
1.867     kalberla 6870:   vertical-align:middle;
1.829     kalberla 6871: }
                   6872: 
1.911     bisitz   6873: div.LC_feedback_link a {
1.829     kalberla 6874:   text-decoration: none;
1.489     raeburn  6875: }
1.795     www      6876: 
1.867     kalberla 6877: div.LC_comblock {
1.911     bisitz   6878:   display:inline;
1.867     kalberla 6879:   color:$font;
                   6880:   font-size:90%;
                   6881: }
                   6882: 
                   6883: div.LC_feedback_link div.LC_comblock {
                   6884:   padding-left:5px;
                   6885: }
                   6886: 
                   6887: div.LC_feedback_link div.LC_comblock a {
                   6888:   color:$font;
                   6889: }
                   6890: 
1.489     raeburn  6891: span.LC_feedback_link {
1.858     bisitz   6892:   /* background: $feedback_link_bg; */
1.599     albertel 6893:   font-size: larger;
                   6894: }
1.795     www      6895: 
1.599     albertel 6896: span.LC_message_link {
1.858     bisitz   6897:   /* background: $feedback_link_bg; */
1.599     albertel 6898:   font-size: larger;
                   6899:   position: absolute;
                   6900:   right: 1em;
1.489     raeburn  6901: }
1.421     albertel 6902: 
1.515     albertel 6903: table.LC_prior_tries {
1.524     albertel 6904:   border: 1px solid #000000;
                   6905:   border-collapse: separate;
                   6906:   border-spacing: 1px;
1.515     albertel 6907: }
1.523     albertel 6908: 
1.515     albertel 6909: table.LC_prior_tries td {
1.524     albertel 6910:   padding: 2px;
1.515     albertel 6911: }
1.523     albertel 6912: 
                   6913: .LC_answer_correct {
1.795     www      6914:   background: lightgreen;
                   6915:   color: darkgreen;
                   6916:   padding: 6px;
1.523     albertel 6917: }
1.795     www      6918: 
1.523     albertel 6919: .LC_answer_charged_try {
1.797     www      6920:   background: #FFAAAA;
1.795     www      6921:   color: darkred;
                   6922:   padding: 6px;
1.523     albertel 6923: }
1.795     www      6924: 
1.779     bisitz   6925: .LC_answer_not_charged_try,
1.523     albertel 6926: .LC_answer_no_grade,
                   6927: .LC_answer_late {
1.795     www      6928:   background: lightyellow;
1.523     albertel 6929:   color: black;
1.795     www      6930:   padding: 6px;
1.523     albertel 6931: }
1.795     www      6932: 
1.523     albertel 6933: .LC_answer_previous {
1.795     www      6934:   background: lightblue;
                   6935:   color: darkblue;
                   6936:   padding: 6px;
1.523     albertel 6937: }
1.795     www      6938: 
1.779     bisitz   6939: .LC_answer_no_message {
1.777     tempelho 6940:   background: #FFFFFF;
                   6941:   color: black;
1.795     www      6942:   padding: 6px;
1.779     bisitz   6943: }
1.795     www      6944: 
1.1075.2.140  raeburn  6945: .LC_answer_unknown,
                   6946: .LC_answer_warning {
1.779     bisitz   6947:   background: orange;
                   6948:   color: black;
1.795     www      6949:   padding: 6px;
1.777     tempelho 6950: }
1.795     www      6951: 
1.529     albertel 6952: span.LC_prior_numerical,
                   6953: span.LC_prior_string,
                   6954: span.LC_prior_custom,
                   6955: span.LC_prior_reaction,
                   6956: span.LC_prior_math {
1.925     bisitz   6957:   font-family: $mono;
1.523     albertel 6958:   white-space: pre;
                   6959: }
                   6960: 
1.525     albertel 6961: span.LC_prior_string {
1.925     bisitz   6962:   font-family: $mono;
1.525     albertel 6963:   white-space: pre;
                   6964: }
                   6965: 
1.523     albertel 6966: table.LC_prior_option {
                   6967:   width: 100%;
                   6968:   border-collapse: collapse;
                   6969: }
1.795     www      6970: 
1.911     bisitz   6971: table.LC_prior_rank,
1.795     www      6972: table.LC_prior_match {
1.528     albertel 6973:   border-collapse: collapse;
                   6974: }
1.795     www      6975: 
1.528     albertel 6976: table.LC_prior_option tr td,
                   6977: table.LC_prior_rank tr td,
                   6978: table.LC_prior_match tr td {
1.524     albertel 6979:   border: 1px solid #000000;
1.515     albertel 6980: }
                   6981: 
1.855     bisitz   6982: .LC_nobreak {
1.544     albertel 6983:   white-space: nowrap;
1.519     raeburn  6984: }
                   6985: 
1.576     raeburn  6986: span.LC_cusr_emph {
                   6987:   font-style: italic;
                   6988: }
                   6989: 
1.633     raeburn  6990: span.LC_cusr_subheading {
                   6991:   font-weight: normal;
                   6992:   font-size: 85%;
                   6993: }
                   6994: 
1.861     bisitz   6995: div.LC_docs_entry_move {
1.859     bisitz   6996:   border: 1px solid #BBBBBB;
1.545     albertel 6997:   background: #DDDDDD;
1.861     bisitz   6998:   width: 22px;
1.859     bisitz   6999:   padding: 1px;
                   7000:   margin: 0;
1.545     albertel 7001: }
                   7002: 
1.861     bisitz   7003: table.LC_data_table tr > td.LC_docs_entry_commands,
                   7004: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 7005:   font-size: x-small;
                   7006: }
1.795     www      7007: 
1.861     bisitz   7008: .LC_docs_entry_parameter {
                   7009:   white-space: nowrap;
                   7010: }
                   7011: 
1.544     albertel 7012: .LC_docs_copy {
1.545     albertel 7013:   color: #000099;
1.544     albertel 7014: }
1.795     www      7015: 
1.544     albertel 7016: .LC_docs_cut {
1.545     albertel 7017:   color: #550044;
1.544     albertel 7018: }
1.795     www      7019: 
1.544     albertel 7020: .LC_docs_rename {
1.545     albertel 7021:   color: #009900;
1.544     albertel 7022: }
1.795     www      7023: 
1.544     albertel 7024: .LC_docs_remove {
1.545     albertel 7025:   color: #990000;
                   7026: }
                   7027: 
1.1075.2.134  raeburn  7028: .LC_domprefs_email,
1.547     albertel 7029: .LC_docs_reinit_warn,
                   7030: .LC_docs_ext_edit {
                   7031:   font-size: x-small;
                   7032: }
                   7033: 
1.545     albertel 7034: table.LC_docs_adddocs td,
                   7035: table.LC_docs_adddocs th {
                   7036:   border: 1px solid #BBBBBB;
                   7037:   padding: 4px;
                   7038:   background: #DDDDDD;
1.543     albertel 7039: }
                   7040: 
1.584     albertel 7041: table.LC_sty_begin {
                   7042:   background: #BBFFBB;
                   7043: }
1.795     www      7044: 
1.584     albertel 7045: table.LC_sty_end {
                   7046:   background: #FFBBBB;
                   7047: }
                   7048: 
1.589     raeburn  7049: table.LC_double_column {
1.803     bisitz   7050:   border-width: 0;
1.589     raeburn  7051:   border-collapse: collapse;
                   7052:   width: 100%;
                   7053:   padding: 2px;
                   7054: }
                   7055: 
                   7056: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  7057:   top: 2px;
1.589     raeburn  7058:   left: 2px;
                   7059:   width: 47%;
                   7060:   vertical-align: top;
                   7061: }
                   7062: 
                   7063: table.LC_double_column tr td.LC_right_col {
                   7064:   top: 2px;
1.779     bisitz   7065:   right: 2px;
1.589     raeburn  7066:   width: 47%;
                   7067:   vertical-align: top;
                   7068: }
                   7069: 
1.591     raeburn  7070: div.LC_left_float {
                   7071:   float: left;
                   7072:   padding-right: 5%;
1.597     albertel 7073:   padding-bottom: 4px;
1.591     raeburn  7074: }
                   7075: 
                   7076: div.LC_clear_float_header {
1.597     albertel 7077:   padding-bottom: 2px;
1.591     raeburn  7078: }
                   7079: 
                   7080: div.LC_clear_float_footer {
1.597     albertel 7081:   padding-top: 10px;
1.591     raeburn  7082:   clear: both;
                   7083: }
                   7084: 
1.597     albertel 7085: div.LC_grade_show_user {
1.941     bisitz   7086: /*  border-left: 5px solid $sidebg; */
                   7087:   border-top: 5px solid #000000;
                   7088:   margin: 50px 0 0 0;
1.936     bisitz   7089:   padding: 15px 0 5px 10px;
1.597     albertel 7090: }
1.795     www      7091: 
1.936     bisitz   7092: div.LC_grade_show_user_odd_row {
1.941     bisitz   7093: /*  border-left: 5px solid #000000; */
                   7094: }
                   7095: 
                   7096: div.LC_grade_show_user div.LC_Box {
                   7097:   margin-right: 50px;
1.597     albertel 7098: }
                   7099: 
                   7100: div.LC_grade_submissions,
                   7101: div.LC_grade_message_center,
1.936     bisitz   7102: div.LC_grade_info_links {
1.597     albertel 7103:   margin: 5px;
                   7104:   width: 99%;
                   7105:   background: #FFFFFF;
                   7106: }
1.795     www      7107: 
1.597     albertel 7108: div.LC_grade_submissions_header,
1.936     bisitz   7109: div.LC_grade_message_center_header {
1.705     tempelho 7110:   font-weight: bold;
                   7111:   font-size: large;
1.597     albertel 7112: }
1.795     www      7113: 
1.597     albertel 7114: div.LC_grade_submissions_body,
1.936     bisitz   7115: div.LC_grade_message_center_body {
1.597     albertel 7116:   border: 1px solid black;
                   7117:   width: 99%;
                   7118:   background: #FFFFFF;
                   7119: }
1.795     www      7120: 
1.613     albertel 7121: table.LC_scantron_action {
                   7122:   width: 100%;
                   7123: }
1.795     www      7124: 
1.613     albertel 7125: table.LC_scantron_action tr th {
1.698     harmsja  7126:   font-weight:bold;
                   7127:   font-style:normal;
1.613     albertel 7128: }
1.795     www      7129: 
1.779     bisitz   7130: .LC_edit_problem_header,
1.614     albertel 7131: div.LC_edit_problem_footer {
1.705     tempelho 7132:   font-weight: normal;
                   7133:   font-size:  medium;
1.602     albertel 7134:   margin: 2px;
1.1060    bisitz   7135:   background-color: $sidebg;
1.600     albertel 7136: }
1.795     www      7137: 
1.600     albertel 7138: div.LC_edit_problem_header,
1.602     albertel 7139: div.LC_edit_problem_header div,
1.614     albertel 7140: div.LC_edit_problem_footer,
                   7141: div.LC_edit_problem_footer div,
1.602     albertel 7142: div.LC_edit_problem_editxml_header,
                   7143: div.LC_edit_problem_editxml_header div {
1.1075.2.112  raeburn  7144:   z-index: 100;
1.600     albertel 7145: }
1.795     www      7146: 
1.600     albertel 7147: div.LC_edit_problem_header_title {
1.705     tempelho 7148:   font-weight: bold;
                   7149:   font-size: larger;
1.602     albertel 7150:   background: $tabbg;
                   7151:   padding: 3px;
1.1060    bisitz   7152:   margin: 0 0 5px 0;
1.602     albertel 7153: }
1.795     www      7154: 
1.602     albertel 7155: table.LC_edit_problem_header_title {
                   7156:   width: 100%;
1.600     albertel 7157:   background: $tabbg;
1.602     albertel 7158: }
                   7159: 
1.1075.2.112  raeburn  7160: div.LC_edit_actionbar {
                   7161:     background-color: $sidebg;
                   7162:     margin: 0;
                   7163:     padding: 0;
                   7164:     line-height: 200%;
1.602     albertel 7165: }
1.795     www      7166: 
1.1075.2.112  raeburn  7167: div.LC_edit_actionbar div{
                   7168:     padding: 0;
                   7169:     margin: 0;
                   7170:     display: inline-block;
1.600     albertel 7171: }
1.795     www      7172: 
1.1075.2.34  raeburn  7173: .LC_edit_opt {
                   7174:   padding-left: 1em;
                   7175:   white-space: nowrap;
                   7176: }
                   7177: 
1.1075.2.57  raeburn  7178: .LC_edit_problem_latexhelper{
                   7179:     text-align: right;
                   7180: }
                   7181: 
                   7182: #LC_edit_problem_colorful div{
                   7183:     margin-left: 40px;
                   7184: }
                   7185: 
1.1075.2.112  raeburn  7186: #LC_edit_problem_codemirror div{
                   7187:     margin-left: 0px;
                   7188: }
                   7189: 
1.911     bisitz   7190: img.stift {
1.803     bisitz   7191:   border-width: 0;
                   7192:   vertical-align: middle;
1.677     riegler  7193: }
1.680     riegler  7194: 
1.923     bisitz   7195: table td.LC_mainmenu_col_fieldset {
1.680     riegler  7196:   vertical-align: top;
1.777     tempelho 7197: }
1.795     www      7198: 
1.716     raeburn  7199: div.LC_createcourse {
1.911     bisitz   7200:   margin: 10px 10px 10px 10px;
1.716     raeburn  7201: }
                   7202: 
1.917     raeburn  7203: .LC_dccid {
1.1075.2.38  raeburn  7204:   float: right;
1.917     raeburn  7205:   margin: 0.2em 0 0 0;
                   7206:   padding: 0;
                   7207:   font-size: 90%;
                   7208:   display:none;
                   7209: }
                   7210: 
1.897     wenzelju 7211: ol.LC_primary_menu a:hover,
1.721     harmsja  7212: ol#LC_MenuBreadcrumbs a:hover,
                   7213: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 7214: ul#LC_secondary_menu a:hover,
1.721     harmsja  7215: .LC_FormSectionClearButton input:hover
1.795     www      7216: ul.LC_TabContent   li:hover a {
1.952     onken    7217:   color:$button_hover;
1.911     bisitz   7218:   text-decoration:none;
1.693     droeschl 7219: }
                   7220: 
1.779     bisitz   7221: h1 {
1.911     bisitz   7222:   padding: 0;
                   7223:   line-height:130%;
1.693     droeschl 7224: }
1.698     harmsja  7225: 
1.911     bisitz   7226: h2,
                   7227: h3,
                   7228: h4,
                   7229: h5,
                   7230: h6 {
                   7231:   margin: 5px 0 5px 0;
                   7232:   padding: 0;
                   7233:   line-height:130%;
1.693     droeschl 7234: }
1.795     www      7235: 
                   7236: .LC_hcell {
1.911     bisitz   7237:   padding:3px 15px 3px 15px;
                   7238:   margin: 0;
                   7239:   background-color:$tabbg;
                   7240:   color:$fontmenu;
                   7241:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 7242: }
1.795     www      7243: 
1.840     bisitz   7244: .LC_Box > .LC_hcell {
1.911     bisitz   7245:   margin: 0 -10px 10px -10px;
1.835     bisitz   7246: }
                   7247: 
1.721     harmsja  7248: .LC_noBorder {
1.911     bisitz   7249:   border: 0;
1.698     harmsja  7250: }
1.693     droeschl 7251: 
1.721     harmsja  7252: .LC_FormSectionClearButton input {
1.911     bisitz   7253:   background-color:transparent;
                   7254:   border: none;
                   7255:   cursor:pointer;
                   7256:   text-decoration:underline;
1.693     droeschl 7257: }
1.763     bisitz   7258: 
                   7259: .LC_help_open_topic {
1.911     bisitz   7260:   color: #FFFFFF;
                   7261:   background-color: #EEEEFF;
                   7262:   margin: 1px;
                   7263:   padding: 4px;
                   7264:   border: 1px solid #000033;
                   7265:   white-space: nowrap;
                   7266:   /* vertical-align: middle; */
1.759     neumanie 7267: }
1.693     droeschl 7268: 
1.911     bisitz   7269: dl,
                   7270: ul,
                   7271: div,
                   7272: fieldset {
                   7273:   margin: 10px 10px 10px 0;
                   7274:   /* overflow: hidden; */
1.693     droeschl 7275: }
1.795     www      7276: 
1.1075.2.90  raeburn  7277: article.geogebraweb div {
                   7278:     margin: 0;
                   7279: }
                   7280: 
1.838     bisitz   7281: fieldset > legend {
1.911     bisitz   7282:   font-weight: bold;
                   7283:   padding: 0 5px 0 5px;
1.838     bisitz   7284: }
                   7285: 
1.813     bisitz   7286: #LC_nav_bar {
1.911     bisitz   7287:   float: left;
1.995     raeburn  7288:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   7289:   margin: 0 0 2px 0;
1.807     droeschl 7290: }
                   7291: 
1.916     droeschl 7292: #LC_realm {
                   7293:   margin: 0.2em 0 0 0;
                   7294:   padding: 0;
                   7295:   font-weight: bold;
                   7296:   text-align: center;
1.995     raeburn  7297:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 7298: }
                   7299: 
1.911     bisitz   7300: #LC_nav_bar em {
                   7301:   font-weight: bold;
                   7302:   font-style: normal;
1.807     droeschl 7303: }
                   7304: 
1.897     wenzelju 7305: ol.LC_primary_menu {
1.934     droeschl 7306:   margin: 0;
1.1075.2.2  raeburn  7307:   padding: 0;
1.807     droeschl 7308: }
                   7309: 
1.852     droeschl 7310: ol#LC_PathBreadcrumbs {
1.911     bisitz   7311:   margin: 0;
1.693     droeschl 7312: }
                   7313: 
1.897     wenzelju 7314: ol.LC_primary_menu li {
1.1075.2.2  raeburn  7315:   color: RGB(80, 80, 80);
                   7316:   vertical-align: middle;
                   7317:   text-align: left;
                   7318:   list-style: none;
1.1075.2.112  raeburn  7319:   position: relative;
1.1075.2.2  raeburn  7320:   float: left;
1.1075.2.112  raeburn  7321:   z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
                   7322:   line-height: 1.5em;
1.1075.2.2  raeburn  7323: }
                   7324: 
1.1075.2.113  raeburn  7325: ol.LC_primary_menu li a, 
1.1075.2.112  raeburn  7326: ol.LC_primary_menu li p {
1.1075.2.2  raeburn  7327:   display: block;
                   7328:   margin: 0;
                   7329:   padding: 0 5px 0 10px;
                   7330:   text-decoration: none;
                   7331: }
                   7332: 
1.1075.2.112  raeburn  7333: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
                   7334:   display: inline-block;
                   7335:   width: 95%;
                   7336:   text-align: left;
                   7337: }
                   7338: 
                   7339: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
                   7340:   display: inline-block;
                   7341:   width: 5%;
                   7342:   float: right;
                   7343:   text-align: right;
                   7344:   font-size: 70%;
                   7345: }
                   7346: 
                   7347: ol.LC_primary_menu ul {
1.1075.2.2  raeburn  7348:   display: none;
1.1075.2.112  raeburn  7349:   width: 15em;
1.1075.2.2  raeburn  7350:   background-color: $data_table_light;
1.1075.2.112  raeburn  7351:   position: absolute;
                   7352:   top: 100%;
                   7353: }
                   7354: 
                   7355: ol.LC_primary_menu ul ul {
                   7356:   left: 100%;
                   7357:   top: 0;
1.1075.2.2  raeburn  7358: }
                   7359: 
1.1075.2.112  raeburn  7360: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1075.2.2  raeburn  7361:   display: block;
                   7362:   position: absolute;
                   7363:   margin: 0;
                   7364:   padding: 0;
1.1075.2.5  raeburn  7365:   z-index: 2;
1.1075.2.2  raeburn  7366: }
                   7367: 
                   7368: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1075.2.112  raeburn  7369: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1075.2.2  raeburn  7370:   font-size: 90%;
1.911     bisitz   7371:   vertical-align: top;
1.1075.2.2  raeburn  7372:   float: none;
1.1075.2.5  raeburn  7373:   border-left: 1px solid black;
                   7374:   border-right: 1px solid black;
1.1075.2.112  raeburn  7375: /* A dark bottom border to visualize different menu options;
                   7376: overwritten in the create_submenu routine for the last border-bottom of the menu */
                   7377:   border-bottom: 1px solid $data_table_dark;
1.1075.2.2  raeburn  7378: }
                   7379: 
1.1075.2.112  raeburn  7380: ol.LC_primary_menu li li p:hover {
                   7381:   color:$button_hover;
                   7382:   text-decoration:none;
                   7383:   background-color:$data_table_dark;
1.1075.2.2  raeburn  7384: }
                   7385: 
                   7386: ol.LC_primary_menu li li a:hover {
                   7387:    color:$button_hover;
                   7388:    background-color:$data_table_dark;
1.693     droeschl 7389: }
                   7390: 
1.1075.2.112  raeburn  7391: /* Font-size equal to the size of the predecessors*/
                   7392: ol.LC_primary_menu li:hover li li {
                   7393:   font-size: 100%;
                   7394: }
                   7395: 
1.897     wenzelju 7396: ol.LC_primary_menu li img {
1.911     bisitz   7397:   vertical-align: bottom;
1.934     droeschl 7398:   height: 1.1em;
1.1075.2.3  raeburn  7399:   margin: 0.2em 0 0 0;
1.693     droeschl 7400: }
                   7401: 
1.897     wenzelju 7402: ol.LC_primary_menu a {
1.911     bisitz   7403:   color: RGB(80, 80, 80);
                   7404:   text-decoration: none;
1.693     droeschl 7405: }
1.795     www      7406: 
1.949     droeschl 7407: ol.LC_primary_menu a.LC_new_message {
                   7408:   font-weight:bold;
                   7409:   color: darkred;
                   7410: }
                   7411: 
1.975     raeburn  7412: ol.LC_docs_parameters {
                   7413:   margin-left: 0;
                   7414:   padding: 0;
                   7415:   list-style: none;
                   7416: }
                   7417: 
                   7418: ol.LC_docs_parameters li {
                   7419:   margin: 0;
                   7420:   padding-right: 20px;
                   7421:   display: inline;
                   7422: }
                   7423: 
1.976     raeburn  7424: ol.LC_docs_parameters li:before {
                   7425:   content: "\\002022 \\0020";
                   7426: }
                   7427: 
                   7428: li.LC_docs_parameters_title {
                   7429:   font-weight: bold;
                   7430: }
                   7431: 
                   7432: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   7433:   content: "";
                   7434: }
                   7435: 
1.897     wenzelju 7436: ul#LC_secondary_menu {
1.1075.2.23  raeburn  7437:   clear: right;
1.911     bisitz   7438:   color: $fontmenu;
                   7439:   background: $tabbg;
                   7440:   list-style: none;
                   7441:   padding: 0;
                   7442:   margin: 0;
                   7443:   width: 100%;
1.995     raeburn  7444:   text-align: left;
1.1075.2.4  raeburn  7445:   float: left;
1.808     droeschl 7446: }
                   7447: 
1.897     wenzelju 7448: ul#LC_secondary_menu li {
1.911     bisitz   7449:   font-weight: bold;
                   7450:   line-height: 1.8em;
                   7451:   border-right: 1px solid black;
1.1075.2.4  raeburn  7452:   float: left;
                   7453: }
                   7454: 
                   7455: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   7456:   background-color: $data_table_light;
                   7457: }
                   7458: 
                   7459: ul#LC_secondary_menu li a {
                   7460:   padding: 0 0.8em;
                   7461: }
                   7462: 
                   7463: ul#LC_secondary_menu li ul {
                   7464:   display: none;
                   7465: }
                   7466: 
                   7467: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   7468:   display: block;
                   7469:   position: absolute;
                   7470:   margin: 0;
                   7471:   padding: 0;
                   7472:   list-style:none;
                   7473:   float: none;
                   7474:   background-color: $data_table_light;
1.1075.2.5  raeburn  7475:   z-index: 2;
1.1075.2.10  raeburn  7476:   margin-left: -1px;
1.1075.2.4  raeburn  7477: }
                   7478: 
                   7479: ul#LC_secondary_menu li ul li {
                   7480:   font-size: 90%;
                   7481:   vertical-align: top;
                   7482:   border-left: 1px solid black;
                   7483:   border-right: 1px solid black;
1.1075.2.33  raeburn  7484:   background-color: $data_table_light;
1.1075.2.4  raeburn  7485:   list-style:none;
                   7486:   float: none;
                   7487: }
                   7488: 
                   7489: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   7490:   background-color: $data_table_dark;
1.807     droeschl 7491: }
                   7492: 
1.847     tempelho 7493: ul.LC_TabContent {
1.911     bisitz   7494:   display:block;
                   7495:   background: $sidebg;
                   7496:   border-bottom: solid 1px $lg_border_color;
                   7497:   list-style:none;
1.1020    raeburn  7498:   margin: -1px -10px 0 -10px;
1.911     bisitz   7499:   padding: 0;
1.693     droeschl 7500: }
                   7501: 
1.795     www      7502: ul.LC_TabContent li,
                   7503: ul.LC_TabContentBigger li {
1.911     bisitz   7504:   float:left;
1.741     harmsja  7505: }
1.795     www      7506: 
1.897     wenzelju 7507: ul#LC_secondary_menu li a {
1.911     bisitz   7508:   color: $fontmenu;
                   7509:   text-decoration: none;
1.693     droeschl 7510: }
1.795     www      7511: 
1.721     harmsja  7512: ul.LC_TabContent {
1.952     onken    7513:   min-height:20px;
1.721     harmsja  7514: }
1.795     www      7515: 
                   7516: ul.LC_TabContent li {
1.911     bisitz   7517:   vertical-align:middle;
1.959     onken    7518:   padding: 0 16px 0 10px;
1.911     bisitz   7519:   background-color:$tabbg;
                   7520:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  7521:   border-left: solid 1px $font;
1.721     harmsja  7522: }
1.795     www      7523: 
1.847     tempelho 7524: ul.LC_TabContent .right {
1.911     bisitz   7525:   float:right;
1.847     tempelho 7526: }
                   7527: 
1.911     bisitz   7528: ul.LC_TabContent li a,
                   7529: ul.LC_TabContent li {
                   7530:   color:rgb(47,47,47);
                   7531:   text-decoration:none;
                   7532:   font-size:95%;
                   7533:   font-weight:bold;
1.952     onken    7534:   min-height:20px;
                   7535: }
                   7536: 
1.959     onken    7537: ul.LC_TabContent li a:hover,
                   7538: ul.LC_TabContent li a:focus {
1.952     onken    7539:   color: $button_hover;
1.959     onken    7540:   background:none;
                   7541:   outline:none;
1.952     onken    7542: }
                   7543: 
                   7544: ul.LC_TabContent li:hover {
                   7545:   color: $button_hover;
                   7546:   cursor:pointer;
1.721     harmsja  7547: }
1.795     www      7548: 
1.911     bisitz   7549: ul.LC_TabContent li.active {
1.952     onken    7550:   color: $font;
1.911     bisitz   7551:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    7552:   border-bottom:solid 1px #FFFFFF;
                   7553:   cursor: default;
1.744     ehlerst  7554: }
1.795     www      7555: 
1.959     onken    7556: ul.LC_TabContent li.active a {
                   7557:   color:$font;
                   7558:   background:#FFFFFF;
                   7559:   outline: none;
                   7560: }
1.1047    raeburn  7561: 
                   7562: ul.LC_TabContent li.goback {
                   7563:   float: left;
                   7564:   border-left: none;
                   7565: }
                   7566: 
1.870     tempelho 7567: #maincoursedoc {
1.911     bisitz   7568:   clear:both;
1.870     tempelho 7569: }
                   7570: 
                   7571: ul.LC_TabContentBigger {
1.911     bisitz   7572:   display:block;
                   7573:   list-style:none;
                   7574:   padding: 0;
1.870     tempelho 7575: }
                   7576: 
1.795     www      7577: ul.LC_TabContentBigger li {
1.911     bisitz   7578:   vertical-align:bottom;
                   7579:   height: 30px;
                   7580:   font-size:110%;
                   7581:   font-weight:bold;
                   7582:   color: #737373;
1.841     tempelho 7583: }
                   7584: 
1.957     onken    7585: ul.LC_TabContentBigger li.active {
                   7586:   position: relative;
                   7587:   top: 1px;
                   7588: }
                   7589: 
1.870     tempelho 7590: ul.LC_TabContentBigger li a {
1.911     bisitz   7591:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   7592:   height: 30px;
                   7593:   line-height: 30px;
                   7594:   text-align: center;
                   7595:   display: block;
                   7596:   text-decoration: none;
1.958     onken    7597:   outline: none;  
1.741     harmsja  7598: }
1.795     www      7599: 
1.870     tempelho 7600: ul.LC_TabContentBigger li.active a {
1.911     bisitz   7601:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   7602:   color:$font;
1.744     ehlerst  7603: }
1.795     www      7604: 
1.870     tempelho 7605: ul.LC_TabContentBigger li b {
1.911     bisitz   7606:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   7607:   display: block;
                   7608:   float: left;
                   7609:   padding: 0 30px;
1.957     onken    7610:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 7611: }
                   7612: 
1.956     onken    7613: ul.LC_TabContentBigger li:hover b {
                   7614:   color:$button_hover;
                   7615: }
                   7616: 
1.870     tempelho 7617: ul.LC_TabContentBigger li.active b {
1.911     bisitz   7618:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   7619:   color:$font;
1.957     onken    7620:   border: 0;
1.741     harmsja  7621: }
1.693     droeschl 7622: 
1.870     tempelho 7623: 
1.862     bisitz   7624: ul.LC_CourseBreadcrumbs {
                   7625:   background: $sidebg;
1.1020    raeburn  7626:   height: 2em;
1.862     bisitz   7627:   padding-left: 10px;
1.1020    raeburn  7628:   margin: 0;
1.862     bisitz   7629:   list-style-position: inside;
                   7630: }
                   7631: 
1.911     bisitz   7632: ol#LC_MenuBreadcrumbs,
1.862     bisitz   7633: ol#LC_PathBreadcrumbs {
1.911     bisitz   7634:   padding-left: 10px;
                   7635:   margin: 0;
1.933     droeschl 7636:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 7637: }
                   7638: 
1.911     bisitz   7639: ol#LC_MenuBreadcrumbs li,
                   7640: ol#LC_PathBreadcrumbs li,
1.862     bisitz   7641: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   7642:   display: inline;
1.933     droeschl 7643:   white-space: normal;  
1.693     droeschl 7644: }
                   7645: 
1.823     bisitz   7646: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   7647: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   7648:   text-decoration: none;
                   7649:   font-size:90%;
1.693     droeschl 7650: }
1.795     www      7651: 
1.969     droeschl 7652: ol#LC_MenuBreadcrumbs h1 {
                   7653:   display: inline;
                   7654:   font-size: 90%;
                   7655:   line-height: 2.5em;
                   7656:   margin: 0;
                   7657:   padding: 0;
                   7658: }
                   7659: 
1.795     www      7660: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   7661:   text-decoration:none;
                   7662:   font-size:100%;
                   7663:   font-weight:bold;
1.693     droeschl 7664: }
1.795     www      7665: 
1.840     bisitz   7666: .LC_Box {
1.911     bisitz   7667:   border: solid 1px $lg_border_color;
                   7668:   padding: 0 10px 10px 10px;
1.746     neumanie 7669: }
1.795     www      7670: 
1.1020    raeburn  7671: .LC_DocsBox {
                   7672:   border: solid 1px $lg_border_color;
                   7673:   padding: 0 0 10px 10px;
                   7674: }
                   7675: 
1.795     www      7676: .LC_AboutMe_Image {
1.911     bisitz   7677:   float:left;
                   7678:   margin-right:10px;
1.747     neumanie 7679: }
1.795     www      7680: 
                   7681: .LC_Clear_AboutMe_Image {
1.911     bisitz   7682:   clear:left;
1.747     neumanie 7683: }
1.795     www      7684: 
1.721     harmsja  7685: dl.LC_ListStyleClean dt {
1.911     bisitz   7686:   padding-right: 5px;
                   7687:   display: table-header-group;
1.693     droeschl 7688: }
                   7689: 
1.721     harmsja  7690: dl.LC_ListStyleClean dd {
1.911     bisitz   7691:   display: table-row;
1.693     droeschl 7692: }
                   7693: 
1.721     harmsja  7694: .LC_ListStyleClean,
                   7695: .LC_ListStyleSimple,
                   7696: .LC_ListStyleNormal,
1.795     www      7697: .LC_ListStyleSpecial {
1.911     bisitz   7698:   /* display:block; */
                   7699:   list-style-position: inside;
                   7700:   list-style-type: none;
                   7701:   overflow: hidden;
                   7702:   padding: 0;
1.693     droeschl 7703: }
                   7704: 
1.721     harmsja  7705: .LC_ListStyleSimple li,
                   7706: .LC_ListStyleSimple dd,
                   7707: .LC_ListStyleNormal li,
                   7708: .LC_ListStyleNormal dd,
                   7709: .LC_ListStyleSpecial li,
1.795     www      7710: .LC_ListStyleSpecial dd {
1.911     bisitz   7711:   margin: 0;
                   7712:   padding: 5px 5px 5px 10px;
                   7713:   clear: both;
1.693     droeschl 7714: }
                   7715: 
1.721     harmsja  7716: .LC_ListStyleClean li,
                   7717: .LC_ListStyleClean dd {
1.911     bisitz   7718:   padding-top: 0;
                   7719:   padding-bottom: 0;
1.693     droeschl 7720: }
                   7721: 
1.721     harmsja  7722: .LC_ListStyleSimple dd,
1.795     www      7723: .LC_ListStyleSimple li {
1.911     bisitz   7724:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 7725: }
                   7726: 
1.721     harmsja  7727: .LC_ListStyleSpecial li,
                   7728: .LC_ListStyleSpecial dd {
1.911     bisitz   7729:   list-style-type: none;
                   7730:   background-color: RGB(220, 220, 220);
                   7731:   margin-bottom: 4px;
1.693     droeschl 7732: }
                   7733: 
1.721     harmsja  7734: table.LC_SimpleTable {
1.911     bisitz   7735:   margin:5px;
                   7736:   border:solid 1px $lg_border_color;
1.795     www      7737: }
1.693     droeschl 7738: 
1.721     harmsja  7739: table.LC_SimpleTable tr {
1.911     bisitz   7740:   padding: 0;
                   7741:   border:solid 1px $lg_border_color;
1.693     droeschl 7742: }
1.795     www      7743: 
                   7744: table.LC_SimpleTable thead {
1.911     bisitz   7745:   background:rgb(220,220,220);
1.693     droeschl 7746: }
                   7747: 
1.721     harmsja  7748: div.LC_columnSection {
1.911     bisitz   7749:   display: block;
                   7750:   clear: both;
                   7751:   overflow: hidden;
                   7752:   margin: 0;
1.693     droeschl 7753: }
                   7754: 
1.721     harmsja  7755: div.LC_columnSection>* {
1.911     bisitz   7756:   float: left;
                   7757:   margin: 10px 20px 10px 0;
                   7758:   overflow:hidden;
1.693     droeschl 7759: }
1.721     harmsja  7760: 
1.795     www      7761: table em {
1.911     bisitz   7762:   font-weight: bold;
                   7763:   font-style: normal;
1.748     schulted 7764: }
1.795     www      7765: 
1.779     bisitz   7766: table.LC_tableBrowseRes,
1.795     www      7767: table.LC_tableOfContent {
1.911     bisitz   7768:   border:none;
                   7769:   border-spacing: 1px;
                   7770:   padding: 3px;
                   7771:   background-color: #FFFFFF;
                   7772:   font-size: 90%;
1.753     droeschl 7773: }
1.789     droeschl 7774: 
1.911     bisitz   7775: table.LC_tableOfContent {
                   7776:   border-collapse: collapse;
1.789     droeschl 7777: }
                   7778: 
1.771     droeschl 7779: table.LC_tableBrowseRes a,
1.768     schulted 7780: table.LC_tableOfContent a {
1.911     bisitz   7781:   background-color: transparent;
                   7782:   text-decoration: none;
1.753     droeschl 7783: }
                   7784: 
1.795     www      7785: table.LC_tableOfContent img {
1.911     bisitz   7786:   border: none;
                   7787:   height: 1.3em;
                   7788:   vertical-align: text-bottom;
                   7789:   margin-right: 0.3em;
1.753     droeschl 7790: }
1.757     schulted 7791: 
1.795     www      7792: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7793:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7794: }
                   7795: 
1.795     www      7796: a#LC_content_toolbar_everything {
1.911     bisitz   7797:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7798: }
                   7799: 
1.795     www      7800: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7801:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7802: }
                   7803: 
1.795     www      7804: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7805:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7806: }
                   7807: 
1.795     www      7808: a#LC_content_toolbar_changefolder {
1.911     bisitz   7809:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7810: }
                   7811: 
1.795     www      7812: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7813:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7814: }
                   7815: 
1.1043    raeburn  7816: a#LC_content_toolbar_edittoplevel {
                   7817:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7818: }
                   7819: 
1.795     www      7820: ul#LC_toolbar li a:hover {
1.911     bisitz   7821:   background-position: bottom center;
1.757     schulted 7822: }
                   7823: 
1.795     www      7824: ul#LC_toolbar {
1.911     bisitz   7825:   padding: 0;
                   7826:   margin: 2px;
                   7827:   list-style:none;
                   7828:   position:relative;
                   7829:   background-color:white;
1.1075.2.9  raeburn  7830:   overflow: auto;
1.757     schulted 7831: }
                   7832: 
1.795     www      7833: ul#LC_toolbar li {
1.911     bisitz   7834:   border:1px solid white;
                   7835:   padding: 0;
                   7836:   margin: 0;
                   7837:   float: left;
                   7838:   display:inline;
                   7839:   vertical-align:middle;
1.1075.2.9  raeburn  7840:   white-space: nowrap;
1.911     bisitz   7841: }
1.757     schulted 7842: 
1.783     amueller 7843: 
1.795     www      7844: a.LC_toolbarItem {
1.911     bisitz   7845:   display:block;
                   7846:   padding: 0;
                   7847:   margin: 0;
                   7848:   height: 32px;
                   7849:   width: 32px;
                   7850:   color:white;
                   7851:   border: none;
                   7852:   background-repeat:no-repeat;
                   7853:   background-color:transparent;
1.757     schulted 7854: }
                   7855: 
1.915     droeschl 7856: ul.LC_funclist {
                   7857:     margin: 0;
                   7858:     padding: 0.5em 1em 0.5em 0;
                   7859: }
                   7860: 
1.933     droeschl 7861: ul.LC_funclist > li:first-child {
                   7862:     font-weight:bold; 
                   7863:     margin-left:0.8em;
                   7864: }
                   7865: 
1.915     droeschl 7866: ul.LC_funclist + ul.LC_funclist {
                   7867:     /* 
                   7868:        left border as a seperator if we have more than
                   7869:        one list 
                   7870:     */
                   7871:     border-left: 1px solid $sidebg;
                   7872:     /* 
                   7873:        this hides the left border behind the border of the 
                   7874:        outer box if element is wrapped to the next 'line' 
                   7875:     */
                   7876:     margin-left: -1px;
                   7877: }
                   7878: 
1.843     bisitz   7879: ul.LC_funclist li {
1.915     droeschl 7880:   display: inline;
1.782     bisitz   7881:   white-space: nowrap;
1.915     droeschl 7882:   margin: 0 0 0 25px;
                   7883:   line-height: 150%;
1.782     bisitz   7884: }
                   7885: 
1.974     wenzelju 7886: .LC_hidden {
                   7887:   display: none;
                   7888: }
                   7889: 
1.1030    www      7890: .LCmodal-overlay {
                   7891: 		position:fixed;
                   7892: 		top:0;
                   7893: 		right:0;
                   7894: 		bottom:0;
                   7895: 		left:0;
                   7896: 		height:100%;
                   7897: 		width:100%;
                   7898: 		margin:0;
                   7899: 		padding:0;
                   7900: 		background:#999;
                   7901: 		opacity:.75;
                   7902: 		filter: alpha(opacity=75);
                   7903: 		-moz-opacity: 0.75;
                   7904: 		z-index:101;
                   7905: }
                   7906: 
                   7907: * html .LCmodal-overlay {   
                   7908: 		position: absolute;
                   7909: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7910: }
                   7911: 
                   7912: .LCmodal-window {
                   7913: 		position:fixed;
                   7914: 		top:50%;
                   7915: 		left:50%;
                   7916: 		margin:0;
                   7917: 		padding:0;
                   7918: 		z-index:102;
                   7919: 	}
                   7920: 
                   7921: * html .LCmodal-window {
                   7922: 		position:absolute;
                   7923: }
                   7924: 
                   7925: .LCclose-window {
                   7926: 		position:absolute;
                   7927: 		width:32px;
                   7928: 		height:32px;
                   7929: 		right:8px;
                   7930: 		top:8px;
                   7931: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7932: 		text-indent:-99999px;
                   7933: 		overflow:hidden;
                   7934: 		cursor:pointer;
                   7935: }
                   7936: 
1.1075.2.158  raeburn  7937: .LCisDisabled {
                   7938:   cursor: not-allowed;
                   7939:   opacity: 0.5;
                   7940: }
                   7941: 
                   7942: a[aria-disabled="true"] {
                   7943:   color: currentColor;
                   7944:   display: inline-block;  /* For IE11/ MS Edge bug */
                   7945:   pointer-events: none;
                   7946:   text-decoration: none;
                   7947: }
                   7948: 
1.1075.2.141  raeburn  7949: pre.LC_wordwrap {
                   7950:   white-space: pre-wrap;
                   7951:   white-space: -moz-pre-wrap;
                   7952:   white-space: -pre-wrap;
                   7953:   white-space: -o-pre-wrap;
                   7954:   word-wrap: break-word;
                   7955: }
                   7956: 
1.1075.2.17  raeburn  7957: /*
                   7958:   styles used by TTH when "Default set of options to pass to tth/m
                   7959:   when converting TeX" in course settings has been set
                   7960: 
                   7961:   option passed: -t
                   7962: 
                   7963: */
                   7964: 
                   7965: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7966: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7967: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7968: td div.norm {line-height:normal;}
                   7969: 
                   7970: /*
                   7971:   option passed -y3
                   7972: */
                   7973: 
                   7974: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7975: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7976: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7977: 
1.1075.2.121  raeburn  7978: #LC_minitab_header {
                   7979:   float:left;
                   7980:   width:100%;
                   7981:   background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
                   7982:   font-size:93%;
                   7983:   line-height:normal;
                   7984:   margin: 0.5em 0 0.5em 0;
                   7985: }
                   7986: #LC_minitab_header ul {
                   7987:   margin:0;
                   7988:   padding:10px 10px 0;
                   7989:   list-style:none;
                   7990: }
                   7991: #LC_minitab_header li {
                   7992:   float:left;
                   7993:   background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
                   7994:   margin:0;
                   7995:   padding:0 0 0 9px;
                   7996: }
                   7997: #LC_minitab_header a {
                   7998:   display:block;
                   7999:   background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
                   8000:   padding:5px 15px 4px 6px;
                   8001: }
                   8002: #LC_minitab_header #LC_current_minitab {
                   8003:   background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
                   8004: }
                   8005: #LC_minitab_header #LC_current_minitab a {
                   8006:   background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
                   8007:   padding-bottom:5px;
                   8008: }
                   8009: 
                   8010: 
1.343     albertel 8011: END
                   8012: }
                   8013: 
1.306     albertel 8014: =pod
                   8015: 
                   8016: =item * &headtag()
                   8017: 
                   8018: Returns a uniform footer for LON-CAPA web pages.
                   8019: 
1.307     albertel 8020: Inputs: $title - optional title for the head
                   8021:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 8022:         $args - optional arguments
1.319     albertel 8023:             force_register - if is true call registerurl so the remote is 
                   8024:                              informed
1.415     albertel 8025:             redirect       -> array ref of
                   8026:                                    1- seconds before redirect occurs
                   8027:                                    2- url to redirect to
                   8028:                                    3- whether the side effect should occur
1.315     albertel 8029:                            (side effect of setting 
                   8030:                                $env{'internal.head.redirect'} to the url 
                   8031:                                redirected too)
1.352     albertel 8032:             domain         -> force to color decorate a page for a specific
                   8033:                                domain
                   8034:             function       -> force usage of a specific rolish color scheme
                   8035:             bgcolor        -> override the default page bgcolor
1.460     albertel 8036:             no_auto_mt_title
                   8037:                            -> prevent &mt()ing the title arg
1.464     albertel 8038: 
1.306     albertel 8039: =cut
                   8040: 
                   8041: sub headtag {
1.313     albertel 8042:     my ($title,$head_extra,$args) = @_;
1.306     albertel 8043:     
1.363     albertel 8044:     my $function = $args->{'function'} || &get_users_function();
                   8045:     my $domain   = $args->{'domain'}   || &determinedomain();
                   8046:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1075.2.52  raeburn  8047:     my $httphost = $args->{'use_absolute'};
1.418     albertel 8048:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 8049: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 8050: 		   #time(),
1.418     albertel 8051: 		   $env{'environment.color.timestamp'},
1.363     albertel 8052: 		   $function,$domain,$bgcolor);
                   8053: 
1.369     www      8054:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 8055: 
1.308     albertel 8056:     my $result =
                   8057: 	'<head>'.
1.1075.2.56  raeburn  8058: 	&font_settings($args);
1.319     albertel 8059: 
1.1075.2.72  raeburn  8060:     my $inhibitprint;
                   8061:     if ($args->{'print_suppress'}) {
                   8062:         $inhibitprint = &print_suppression();
                   8063:     }
1.1064    raeburn  8064: 
1.461     albertel 8065:     if (!$args->{'frameset'}) {
                   8066: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   8067:     }
1.1075.2.12  raeburn  8068:     if ($args->{'force_register'}) {
                   8069:         $result .= &Apache::lonmenu::registerurl(1);
1.319     albertel 8070:     }
1.436     albertel 8071:     if (!$args->{'no_nav_bar'} 
                   8072: 	&& !$args->{'only_body'}
                   8073: 	&& !$args->{'frameset'}) {
1.1075.2.52  raeburn  8074: 	$result .= &help_menu_js($httphost);
1.1032    www      8075:         $result.=&modal_window();
1.1038    www      8076:         $result.=&togglebox_script();
1.1034    www      8077:         $result.=&wishlist_window();
1.1041    www      8078:         $result.=&LCprogressbarUpdate_script();
1.1034    www      8079:     } else {
                   8080:         if ($args->{'add_modal'}) {
                   8081:            $result.=&modal_window();
                   8082:         }
                   8083:         if ($args->{'add_wishlist'}) {
                   8084:            $result.=&wishlist_window();
                   8085:         }
1.1038    www      8086:         if ($args->{'add_togglebox'}) {
                   8087:            $result.=&togglebox_script();
                   8088:         }
1.1041    www      8089:         if ($args->{'add_progressbar'}) {
                   8090:            $result.=&LCprogressbarUpdate_script();
                   8091:         }
1.436     albertel 8092:     }
1.314     albertel 8093:     if (ref($args->{'redirect'})) {
1.414     albertel 8094: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 8095: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 8096: 	if (!$inhibit_continue) {
                   8097: 	    $env{'internal.head.redirect'} = $url;
                   8098: 	}
1.313     albertel 8099: 	$result.=<<ADDMETA
                   8100: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 8101: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 8102: ADDMETA
1.1075.2.89  raeburn  8103:     } else {
                   8104:         unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
                   8105:             my $requrl = $env{'request.uri'};
                   8106:             if ($requrl eq '') {
                   8107:                 $requrl = $ENV{'REQUEST_URI'};
                   8108:                 $requrl =~ s/\?.+$//;
                   8109:             }
                   8110:             unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
                   8111:                     (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
                   8112:                      ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
                   8113:                 my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                   8114:                 unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                   8115:                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
1.1075.2.145  raeburn  8116:                     my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
1.1075.2.151  raeburn  8117:                     my ($offload,$offloadoth);
1.1075.2.89  raeburn  8118:                     if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                   8119:                         if ($domdefs{'offloadnow'}{$lonhost}) {
1.1075.2.145  raeburn  8120:                             $offload = 1;
1.1075.2.151  raeburn  8121:                             if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
                   8122:                                 (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
                   8123:                                 unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
                   8124:                                     $offloadoth = 1;
                   8125:                                     $dom_in_use = $env{'user.domain'};
                   8126:                                 }
                   8127:                             }
1.1075.2.145  raeburn  8128:                         }
                   8129:                     }
                   8130:                     unless ($offload) {
                   8131:                         if (ref($domdefs{'offloadoth'}) eq 'HASH') {
                   8132:                             if ($domdefs{'offloadoth'}{$lonhost}) {
                   8133:                                 if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
                   8134:                                     (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
                   8135:                                     unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
                   8136:                                         $offload = 1;
1.1075.2.151  raeburn  8137:                                         $offloadoth = 1;
1.1075.2.145  raeburn  8138:                                         $dom_in_use = $env{'user.domain'};
                   8139:                                     }
1.1075.2.89  raeburn  8140:                                 }
1.1075.2.145  raeburn  8141:                             }
                   8142:                         }
                   8143:                     }
                   8144:                     if ($offload) {
1.1075.2.158  raeburn  8145:                         my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
1.1075.2.151  raeburn  8146:                         if (($newserver eq '') && ($offloadoth)) {
                   8147:                             my @domains = &Apache::lonnet::current_machine_domains();
                   8148:                             if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) { 
                   8149:                                 ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
                   8150:                             }
                   8151:                         }
1.1075.2.145  raeburn  8152:                         if (($newserver) && ($newserver ne $lonhost)) {
                   8153:                             my $numsec = 5;
                   8154:                             my $timeout = $numsec * 1000;
                   8155:                             my ($newurl,$locknum,%locks,$msg);
                   8156:                             if ($env{'request.role.adv'}) {
                   8157:                                 ($locknum,%locks) = &Apache::lonnet::get_locks();
                   8158:                             }
                   8159:                             my $disable_submit = 0;
                   8160:                             if ($requrl =~ /$LONCAPA::assess_re/) {
                   8161:                                 $disable_submit = 1;
                   8162:                             }
                   8163:                             if ($locknum) {
                   8164:                                 my @lockinfo = sort(values(%locks));
1.1075.2.153  raeburn  8165:                                 $msg = &mt('Once the following tasks are complete:')." \n".
1.1075.2.145  raeburn  8166:                                        join(", ",sort(values(%locks)))."\n";
                   8167:                                 if (&show_course()) {
                   8168:                                     $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
1.1075.2.89  raeburn  8169:                                 } else {
1.1075.2.145  raeburn  8170:                                     $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
                   8171:                                 }
                   8172:                             } else {
                   8173:                                 if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                   8174:                                     $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
                   8175:                                 }
                   8176:                                 $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                   8177:                                 $newurl = '/adm/switchserver?otherserver='.$newserver;
                   8178:                                 if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
                   8179:                                     $newurl .= '&role='.$env{'request.role'};
                   8180:                                 }
                   8181:                                 if ($env{'request.symb'}) {
                   8182:                                     my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
                   8183:                                     if ($shownsymb =~ m{^/enc/}) {
                   8184:                                         my $reqdmajor = 2;
                   8185:                                         my $reqdminor = 11;
                   8186:                                         my $reqdsubminor = 3;
                   8187:                                         my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
                   8188:                                         my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
                   8189:                                         my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
                   8190:                                         if (($major eq '' && $minor eq '') ||
                   8191:                                             (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
                   8192:                                             (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
                   8193:                                              ($reqdsubminor > $subminor))))) {
                   8194:                                             undef($shownsymb);
                   8195:                                         }
1.1075.2.89  raeburn  8196:                                     }
1.1075.2.145  raeburn  8197:                                     if ($shownsymb) {
                   8198:                                         &js_escape(\$shownsymb);
                   8199:                                         $newurl .= '&symb='.$shownsymb;
1.1075.2.89  raeburn  8200:                                     }
1.1075.2.145  raeburn  8201:                                 } else {
                   8202:                                     my $shownurl = &Apache::lonenc::check_encrypt($requrl);
                   8203:                                     &js_escape(\$shownurl);
                   8204:                                     $newurl .= '&origurl='.$shownurl;
1.1075.2.89  raeburn  8205:                                 }
1.1075.2.145  raeburn  8206:                             }
                   8207:                             &js_escape(\$msg);
                   8208:                             $result.=<<OFFLOAD
1.1075.2.89  raeburn  8209: <meta http-equiv="pragma" content="no-cache" />
                   8210: <script type="text/javascript">
1.1075.2.92  raeburn  8211: // <![CDATA[
1.1075.2.89  raeburn  8212: function LC_Offload_Now() {
                   8213:     var dest = "$newurl";
                   8214:     if (dest != '') {
                   8215:         window.location.href="$newurl";
                   8216:     }
                   8217: }
1.1075.2.92  raeburn  8218: \$(document).ready(function () {
                   8219:     window.alert('$msg');
                   8220:     if ($disable_submit) {
1.1075.2.89  raeburn  8221:         \$(".LC_hwk_submit").prop("disabled", true);
                   8222:         \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1075.2.92  raeburn  8223:     }
                   8224:     setTimeout('LC_Offload_Now()', $timeout);
                   8225: });
                   8226: // ]]>
1.1075.2.89  raeburn  8227: </script>
                   8228: OFFLOAD
                   8229:                         }
                   8230:                     }
                   8231:                 }
                   8232:             }
                   8233:         }
1.313     albertel 8234:     }
1.306     albertel 8235:     if (!defined($title)) {
                   8236: 	$title = 'The LearningOnline Network with CAPA';
                   8237:     }
1.460     albertel 8238:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   8239:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.1075.2.61  raeburn  8240: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'"';
                   8241:     if (!$args->{'frameset'}) {
                   8242:         $result .= ' /';
                   8243:     }
                   8244:     $result .= '>'
1.1064    raeburn  8245:         .$inhibitprint
1.414     albertel 8246: 	.$head_extra;
1.1075.2.108  raeburn  8247:     my $clientmobile;
                   8248:     if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   8249:         (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
                   8250:     } else {
                   8251:         $clientmobile = $env{'browser.mobile'};
                   8252:     }
                   8253:     if ($clientmobile) {
1.1075.2.42  raeburn  8254:         $result .= '
                   8255: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   8256: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   8257:     }
1.1075.2.126  raeburn  8258:     $result .= '<meta name="google" content="notranslate" />'."\n";
1.962     droeschl 8259:     return $result.'</head>';
1.306     albertel 8260: }
                   8261: 
                   8262: =pod
                   8263: 
1.340     albertel 8264: =item * &font_settings()
                   8265: 
                   8266: Returns neccessary <meta> to set the proper encoding
                   8267: 
1.1075.2.56  raeburn  8268: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340     albertel 8269: 
                   8270: =cut
                   8271: 
                   8272: sub font_settings {
1.1075.2.56  raeburn  8273:     my ($args) = @_;
1.340     albertel 8274:     my $headerstring='';
1.1075.2.56  raeburn  8275:     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
                   8276:         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340     albertel 8277: 	$headerstring.=
1.1075.2.61  raeburn  8278: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
                   8279:         if (!$args->{'frameset'}) {
                   8280:             $headerstring.= ' /';
                   8281:         }
                   8282:         $headerstring .= '>'."\n";
1.340     albertel 8283:     }
                   8284:     return $headerstring;
                   8285: }
                   8286: 
1.341     albertel 8287: =pod
                   8288: 
1.1064    raeburn  8289: =item * &print_suppression()
                   8290: 
                   8291: In course context returns css which causes the body to be blank when media="print",
                   8292: if printout generation is unavailable for the current resource.
                   8293: 
                   8294: This could be because:
                   8295: 
                   8296: (a) printstartdate is in the future
                   8297: 
                   8298: (b) printenddate is in the past
                   8299: 
                   8300: (c) there is an active exam block with "printout"
                   8301: functionality blocked
                   8302: 
                   8303: Users with pav, pfo or evb privileges are exempt.
                   8304: 
                   8305: Inputs: none
                   8306: 
                   8307: =cut
                   8308: 
                   8309: 
                   8310: sub print_suppression {
                   8311:     my $noprint;
                   8312:     if ($env{'request.course.id'}) {
                   8313:         my $scope = $env{'request.course.id'};
                   8314:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   8315:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   8316:             return;
                   8317:         }
                   8318:         if ($env{'request.course.sec'} ne '') {
                   8319:             $scope .= "/$env{'request.course.sec'}";
                   8320:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   8321:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  8322:                 return;
1.1064    raeburn  8323:             }
                   8324:         }
                   8325:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   8326:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.158  raeburn  8327:         my $clientip = &Apache::lonnet::get_requestor_ip();
                   8328:         my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
1.1064    raeburn  8329:         if ($blocked) {
                   8330:             my $checkrole = "cm./$cdom/$cnum";
                   8331:             if ($env{'request.course.sec'} ne '') {
                   8332:                 $checkrole .= "/$env{'request.course.sec'}";
                   8333:             }
                   8334:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   8335:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   8336:                 $noprint = 1;
                   8337:             }
                   8338:         }
                   8339:         unless ($noprint) {
                   8340:             my $symb = &Apache::lonnet::symbread();
                   8341:             if ($symb ne '') {
                   8342:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   8343:                 if (ref($navmap)) {
                   8344:                     my $res = $navmap->getBySymb($symb);
                   8345:                     if (ref($res)) {
                   8346:                         if (!$res->resprintable()) {
                   8347:                             $noprint = 1;
                   8348:                         }
                   8349:                     }
                   8350:                 }
                   8351:             }
                   8352:         }
                   8353:         if ($noprint) {
                   8354:             return <<"ENDSTYLE";
                   8355: <style type="text/css" media="print">
                   8356:     body { display:none }
                   8357: </style>
                   8358: ENDSTYLE
                   8359:         }
                   8360:     }
                   8361:     return;
                   8362: }
                   8363: 
                   8364: =pod
                   8365: 
1.341     albertel 8366: =item * &xml_begin()
                   8367: 
                   8368: Returns the needed doctype and <html>
                   8369: 
                   8370: Inputs: none
                   8371: 
                   8372: =cut
                   8373: 
                   8374: sub xml_begin {
1.1075.2.61  raeburn  8375:     my ($is_frameset) = @_;
1.341     albertel 8376:     my $output='';
                   8377: 
                   8378:     if ($env{'browser.mathml'}) {
                   8379: 	$output='<?xml version="1.0"?>'
                   8380:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   8381: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   8382:             
                   8383: #	    .'<!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">] >'
                   8384: 	    .'<!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">'
                   8385:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   8386: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
1.1075.2.61  raeburn  8387:     } elsif ($is_frameset) {
                   8388:         $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   8389:                 '<html>'."\n";
1.341     albertel 8390:     } else {
1.1075.2.61  raeburn  8391: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
                   8392:                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341     albertel 8393:     }
                   8394:     return $output;
                   8395: }
1.340     albertel 8396: 
                   8397: =pod
                   8398: 
1.306     albertel 8399: =item * &start_page()
                   8400: 
                   8401: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   8402: 
1.648     raeburn  8403: Inputs:
                   8404: 
                   8405: =over 4
                   8406: 
                   8407: $title - optional title for the page
                   8408: 
                   8409: $head_extra - optional extra HTML to incude inside the <head>
                   8410: 
                   8411: $args - additional optional args supported are:
                   8412: 
                   8413: =over 8
                   8414: 
                   8415:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 8416:                                     arg on
1.814     bisitz   8417:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  8418:              add_entries    -> additional attributes to add to the  <body>
                   8419:              domain         -> force to color decorate a page for a 
1.317     albertel 8420:                                     specific domain
1.648     raeburn  8421:              function       -> force usage of a specific rolish color
1.317     albertel 8422:                                     scheme
1.648     raeburn  8423:              redirect       -> see &headtag()
                   8424:              bgcolor        -> override the default page bg color
                   8425:              js_ready       -> return a string ready for being used in 
1.317     albertel 8426:                                     a javascript writeln
1.648     raeburn  8427:              html_encode    -> return a string ready for being used in 
1.320     albertel 8428:                                     a html attribute
1.648     raeburn  8429:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 8430:                                     $forcereg arg
1.648     raeburn  8431:              frameset       -> if true will start with a <frameset>
1.330     albertel 8432:                                     rather than <body>
1.648     raeburn  8433:              skip_phases    -> hash ref of 
1.338     albertel 8434:                                     head -> skip the <html><head> generation
                   8435:                                     body -> skip all <body> generation
1.1075.2.12  raeburn  8436:              no_inline_link -> if true and in remote mode, don't show the
                   8437:                                     'Switch To Inline Menu' link
1.648     raeburn  8438:              no_auto_mt_title -> prevent &mt()ing the title arg
1.867     kalberla 8439:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  8440:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1075.2.123  raeburn  8441:              bread_crumbs_nomenu -> if true will pass false as the value of $menulink
                   8442:                                     to lonhtmlcommon::breadcrumbs
1.1075.2.15  raeburn  8443:              group          -> includes the current group, if page is for a
                   8444:                                specific group
1.1075.2.133  raeburn  8445:              use_absolute   -> for request for external resource or syllabus, this
                   8446:                                will contain https://<hostname> if server uses
                   8447:                                https (as per hosts.tab), but request is for http
                   8448:              hostname       -> hostname, originally from $r->hostname(), (optional).
1.1075.2.158  raeburn  8449:              links_disabled -> Links in primary and secondary menus are disabled
                   8450:                                (Can enable them once page has loaded - see lonroles.pm
                   8451:                                for an example).
1.361     albertel 8452: 
1.648     raeburn  8453: =back
1.460     albertel 8454: 
1.648     raeburn  8455: =back
1.562     albertel 8456: 
1.306     albertel 8457: =cut
                   8458: 
                   8459: sub start_page {
1.309     albertel 8460:     my ($title,$head_extra,$args) = @_;
1.318     albertel 8461:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 8462: 
1.315     albertel 8463:     $env{'internal.start_page'}++;
1.1075.2.15  raeburn  8464:     my ($result,@advtools);
1.964     droeschl 8465: 
1.338     albertel 8466:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62  raeburn  8467:         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338     albertel 8468:     }
                   8469:     
                   8470:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   8471: 	if ($args->{'frameset'}) {
                   8472: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   8473: 						$args->{'add_entries'});
                   8474: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   8475:         } else {
                   8476:             $result .=
                   8477:                 &bodytag($title, 
                   8478:                          $args->{'function'},       $args->{'add_entries'},
                   8479:                          $args->{'only_body'},      $args->{'domain'},
                   8480:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12  raeburn  8481:                          $args->{'bgcolor'},        $args->{'no_inline_link'},
1.1075.2.15  raeburn  8482:                          $args,                     \@advtools);
1.831     bisitz   8483:         }
1.330     albertel 8484:     }
1.338     albertel 8485: 
1.315     albertel 8486:     if ($args->{'js_ready'}) {
1.713     kaisler  8487: 		$result = &js_ready($result);
1.315     albertel 8488:     }
1.320     albertel 8489:     if ($args->{'html_encode'}) {
1.713     kaisler  8490: 		$result = &html_encode($result);
                   8491:     }
                   8492: 
1.813     bisitz   8493:     # Preparation for new and consistent functionlist at top of screen
                   8494:     # if ($args->{'functionlist'}) {
                   8495:     #            $result .= &build_functionlist();
                   8496:     #}
                   8497: 
1.964     droeschl 8498:     # Don't add anything more if only_body wanted or in const space
                   8499:     return $result if    $args->{'only_body'} 
                   8500:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   8501: 
                   8502:     #Breadcrumbs
1.758     kaisler  8503:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   8504: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   8505: 		#if any br links exists, add them to the breadcrumbs
                   8506: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   8507: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   8508: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   8509: 			}
                   8510: 		}
1.1075.2.19  raeburn  8511:                 # if @advtools array contains items add then to the breadcrumbs
                   8512:                 if (@advtools > 0) {
                   8513:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   8514:                 }
1.1075.2.123  raeburn  8515:                 my $menulink;
                   8516:                 # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
                   8517:                 if (exists($args->{'bread_crumbs_nomenu'})) {
                   8518:                     $menulink = 0;
                   8519:                 } else {
                   8520:                     undef($menulink);
                   8521:                 }
1.758     kaisler  8522: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   8523: 		if(exists($args->{'bread_crumbs_component'})){
1.1075.2.123  raeburn  8524: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
1.758     kaisler  8525: 		}else{
1.1075.2.123  raeburn  8526: 			$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
1.758     kaisler  8527: 		}
1.1075.2.24  raeburn  8528:     } elsif (($env{'environment.remote'} eq 'on') &&
                   8529:              ($env{'form.inhibitmenu'} ne 'yes') &&
                   8530:              ($env{'request.noversionuri'} =~ m{^/res/}) &&
                   8531:              ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21  raeburn  8532:         $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320     albertel 8533:     }
1.315     albertel 8534:     return $result;
1.306     albertel 8535: }
                   8536: 
                   8537: sub end_page {
1.315     albertel 8538:     my ($args) = @_;
                   8539:     $env{'internal.end_page'}++;
1.330     albertel 8540:     my $result;
1.335     albertel 8541:     if ($args->{'discussion'}) {
                   8542: 	my ($target,$parser);
                   8543: 	if (ref($args->{'discussion'})) {
                   8544: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   8545: 				$args->{'discussion'}{'parser'});
                   8546: 	}
                   8547: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   8548:     }
1.330     albertel 8549:     if ($args->{'frameset'}) {
                   8550: 	$result .= '</frameset>';
                   8551:     } else {
1.635     raeburn  8552: 	$result .= &endbodytag($args);
1.330     albertel 8553:     }
1.1075.2.6  raeburn  8554:     unless ($args->{'notbody'}) {
                   8555:         $result .= "\n</html>";
                   8556:     }
1.330     albertel 8557: 
1.315     albertel 8558:     if ($args->{'js_ready'}) {
1.317     albertel 8559: 	$result = &js_ready($result);
1.315     albertel 8560:     }
1.335     albertel 8561: 
1.320     albertel 8562:     if ($args->{'html_encode'}) {
                   8563: 	$result = &html_encode($result);
                   8564:     }
1.335     albertel 8565: 
1.315     albertel 8566:     return $result;
                   8567: }
                   8568: 
1.1034    www      8569: sub wishlist_window {
                   8570:     return(<<'ENDWISHLIST');
1.1046    raeburn  8571: <script type="text/javascript">
1.1034    www      8572: // <![CDATA[
                   8573: // <!-- BEGIN LON-CAPA Internal
                   8574: function set_wishlistlink(title, path) {
                   8575:     if (!title) {
                   8576:         title = document.title;
                   8577:         title = title.replace(/^LON-CAPA /,'');
                   8578:     }
1.1075.2.65  raeburn  8579:     title = encodeURIComponent(title);
1.1075.2.83  raeburn  8580:     title = title.replace("'","\\\'");
1.1034    www      8581:     if (!path) {
                   8582:         path = location.pathname;
                   8583:     }
1.1075.2.65  raeburn  8584:     path = encodeURIComponent(path);
1.1075.2.83  raeburn  8585:     path = path.replace("'","\\\'");
1.1034    www      8586:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   8587:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   8588: }
                   8589: // END LON-CAPA Internal -->
                   8590: // ]]>
                   8591: </script>
                   8592: ENDWISHLIST
                   8593: }
                   8594: 
1.1030    www      8595: sub modal_window {
                   8596:     return(<<'ENDMODAL');
1.1046    raeburn  8597: <script type="text/javascript">
1.1030    www      8598: // <![CDATA[
                   8599: // <!-- BEGIN LON-CAPA Internal
                   8600: var modalWindow = {
                   8601: 	parent:"body",
                   8602: 	windowId:null,
                   8603: 	content:null,
                   8604: 	width:null,
                   8605: 	height:null,
                   8606: 	close:function()
                   8607: 	{
                   8608: 	        $(".LCmodal-window").remove();
                   8609: 	        $(".LCmodal-overlay").remove();
                   8610: 	},
                   8611: 	open:function()
                   8612: 	{
                   8613: 		var modal = "";
                   8614: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   8615: 		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;\">";
                   8616: 		modal += this.content;
                   8617: 		modal += "</div>";	
                   8618: 
                   8619: 		$(this.parent).append(modal);
                   8620: 
                   8621: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   8622: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   8623: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   8624: 	}
                   8625: };
1.1075.2.42  raeburn  8626: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      8627: 	{
1.1075.2.119  raeburn  8628:                 source = source.replace(/'/g,"&#39;");
1.1030    www      8629: 		modalWindow.windowId = "myModal";
                   8630: 		modalWindow.width = width;
                   8631: 		modalWindow.height = height;
1.1075.2.80  raeburn  8632: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030    www      8633: 		modalWindow.open();
1.1075.2.87  raeburn  8634: 	};
1.1030    www      8635: // END LON-CAPA Internal -->
                   8636: // ]]>
                   8637: </script>
                   8638: ENDMODAL
                   8639: }
                   8640: 
                   8641: sub modal_link {
1.1075.2.42  raeburn  8642:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      8643:     unless ($width) { $width=480; }
                   8644:     unless ($height) { $height=400; }
1.1031    www      8645:     unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42  raeburn  8646:     unless ($transparency) { $transparency='true'; }
                   8647: 
1.1074    raeburn  8648:     my $target_attr;
                   8649:     if (defined($target)) {
                   8650:         $target_attr = 'target="'.$target.'"';
                   8651:     }
                   8652:     return <<"ENDLINK";
1.1075.2.143  raeburn  8653: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
1.1074    raeburn  8654: ENDLINK
1.1030    www      8655: }
                   8656: 
1.1032    www      8657: sub modal_adhoc_script {
1.1075.2.155  raeburn  8658:     my ($funcname,$width,$height,$content,$possmathjax)=@_;
                   8659:     my $mathjax;
                   8660:     if ($possmathjax) {
                   8661:         $mathjax = <<'ENDJAX';
                   8662:                if (typeof MathJax == 'object') {
                   8663:                    MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
                   8664:                }
                   8665: ENDJAX
                   8666:     }
1.1032    www      8667:     return (<<ENDADHOC);
1.1046    raeburn  8668: <script type="text/javascript">
1.1032    www      8669: // <![CDATA[
                   8670:         var $funcname = function()
                   8671:         {
                   8672:                 modalWindow.windowId = "myModal";
                   8673:                 modalWindow.width = $width;
                   8674:                 modalWindow.height = $height;
                   8675:                 modalWindow.content = '$content';
                   8676:                 modalWindow.open();
1.1075.2.155  raeburn  8677:                 $mathjax
1.1032    www      8678:         };  
                   8679: // ]]>
                   8680: </script>
                   8681: ENDADHOC
                   8682: }
                   8683: 
1.1041    www      8684: sub modal_adhoc_inner {
1.1075.2.155  raeburn  8685:     my ($funcname,$width,$height,$content,$possmathjax)=@_;
1.1041    www      8686:     my $innerwidth=$width-20;
                   8687:     $content=&js_ready(
1.1042    www      8688:                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42  raeburn  8689:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   8690:                  $content.
1.1041    www      8691:                  &end_scrollbox().
1.1075.2.42  raeburn  8692:                  &end_page()
1.1041    www      8693:              );
1.1075.2.155  raeburn  8694:     return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);
1.1041    www      8695: }
                   8696: 
                   8697: sub modal_adhoc_window {
1.1075.2.155  raeburn  8698:     my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;
                   8699:     return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).
1.1041    www      8700:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   8701: }
                   8702: 
                   8703: sub modal_adhoc_launch {
                   8704:     my ($funcname,$width,$height,$content)=@_;
                   8705:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   8706: <script type="text/javascript">
                   8707: // <![CDATA[
                   8708: $funcname();
                   8709: // ]]>
                   8710: </script>
                   8711: ENDLAUNCH
                   8712: }
                   8713: 
                   8714: sub modal_adhoc_close {
                   8715:     return (<<ENDCLOSE);
                   8716: <script type="text/javascript">
                   8717: // <![CDATA[
                   8718: modalWindow.close();
                   8719: // ]]>
                   8720: </script>
                   8721: ENDCLOSE
                   8722: }
                   8723: 
1.1038    www      8724: sub togglebox_script {
                   8725:    return(<<ENDTOGGLE);
                   8726: <script type="text/javascript"> 
                   8727: // <![CDATA[
                   8728: function LCtoggleDisplay(id,hidetext,showtext) {
                   8729:    link = document.getElementById(id + "link").childNodes[0];
                   8730:    with (document.getElementById(id).style) {
                   8731:       if (display == "none" ) {
                   8732:           display = "inline";
                   8733:           link.nodeValue = hidetext;
                   8734:         } else {
                   8735:           display = "none";
                   8736:           link.nodeValue = showtext;
                   8737:        }
                   8738:    }
                   8739: }
                   8740: // ]]>
                   8741: </script>
                   8742: ENDTOGGLE
                   8743: }
                   8744: 
1.1039    www      8745: sub start_togglebox {
                   8746:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   8747:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   8748:     unless ($showtext) { $showtext=&mt('show'); }
                   8749:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   8750:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   8751:     return &start_data_table().
                   8752:            &start_data_table_header_row().
                   8753:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   8754:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   8755:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   8756:            &end_data_table_header_row().
                   8757:            '<tr id="'.$id.'" style="display:none""><td>';
                   8758: }
                   8759: 
                   8760: sub end_togglebox {
                   8761:     return '</td></tr>'.&end_data_table();
                   8762: }
                   8763: 
1.1041    www      8764: sub LCprogressbar_script {
1.1075.2.130  raeburn  8765:    my ($id,$number_to_do)=@_;
                   8766:    if ($number_to_do) {
                   8767:        return(<<ENDPROGRESS);
1.1041    www      8768: <script type="text/javascript">
                   8769: // <![CDATA[
1.1045    www      8770: \$('#progressbar$id').progressbar({
1.1041    www      8771:   value: 0,
                   8772:   change: function(event, ui) {
                   8773:     var newVal = \$(this).progressbar('option', 'value');
                   8774:     \$('.pblabel', this).text(LCprogressTxt);
                   8775:   }
                   8776: });
                   8777: // ]]>
                   8778: </script>
                   8779: ENDPROGRESS
1.1075.2.130  raeburn  8780:    } else {
                   8781:        return(<<ENDPROGRESS);
                   8782: <script type="text/javascript">
                   8783: // <![CDATA[
                   8784: \$('#progressbar$id').progressbar({
                   8785:   value: false,
                   8786:   create: function(event, ui) {
                   8787:     \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
                   8788:     \$('.ui-progressbar-overlay', this).css({'margin':'0'});
                   8789:   }
                   8790: });
                   8791: // ]]>
                   8792: </script>
                   8793: ENDPROGRESS
                   8794:    }
1.1041    www      8795: }
                   8796: 
                   8797: sub LCprogressbarUpdate_script {
                   8798:    return(<<ENDPROGRESSUPDATE);
                   8799: <style type="text/css">
                   8800: .ui-progressbar { position:relative; }
1.1075.2.130  raeburn  8801: .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      8802: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   8803: </style>
                   8804: <script type="text/javascript">
                   8805: // <![CDATA[
1.1045    www      8806: var LCprogressTxt='---';
                   8807: 
1.1075.2.130  raeburn  8808: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041    www      8809:    LCprogressTxt=progresstext;
1.1075.2.130  raeburn  8810:    if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
                   8811:        \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
                   8812:    } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
                   8813:        \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
                   8814:    } else {
                   8815:        \$('#progressbar'+id).progressbar('value',percent);
                   8816:    }
1.1041    www      8817: }
                   8818: // ]]>
                   8819: </script>
                   8820: ENDPROGRESSUPDATE
                   8821: }
                   8822: 
1.1042    www      8823: my $LClastpercent;
1.1045    www      8824: my $LCidcnt;
                   8825: my $LCcurrentid;
1.1042    www      8826: 
1.1041    www      8827: sub LCprogressbar {
1.1075.2.130  raeburn  8828:     my ($r,$number_to_do,$preamble)=@_;
1.1042    www      8829:     $LClastpercent=0;
1.1045    www      8830:     $LCidcnt++;
                   8831:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1075.2.130  raeburn  8832:     my ($starting,$content);
                   8833:     if ($number_to_do) {
                   8834:         $starting=&mt('Starting');
                   8835:         $content=(<<ENDPROGBAR);
                   8836: $preamble
1.1045    www      8837:   <div id="progressbar$LCcurrentid">
1.1041    www      8838:     <span class="pblabel">$starting</span>
                   8839:   </div>
                   8840: ENDPROGBAR
1.1075.2.130  raeburn  8841:     } else {
                   8842:         $starting=&mt('Loading...');
                   8843:         $LClastpercent='false';
                   8844:         $content=(<<ENDPROGBAR);
                   8845: $preamble
                   8846:   <div id="progressbar$LCcurrentid">
                   8847:       <div class="progress-label">$starting</div>
                   8848:   </div>
                   8849: ENDPROGBAR
                   8850:     }
                   8851:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041    www      8852: }
                   8853: 
                   8854: sub LCprogressbarUpdate {
1.1075.2.130  raeburn  8855:     my ($r,$val,$text,$number_to_do)=@_;
                   8856:     if ($number_to_do) {
                   8857:         unless ($val) { 
                   8858:             if ($LClastpercent) {
                   8859:                 $val=$LClastpercent;
                   8860:             } else {
                   8861:                 $val=0;
                   8862:             }
                   8863:         }
                   8864:         if ($val<0) { $val=0; }
                   8865:         if ($val>100) { $val=0; }
                   8866:         $LClastpercent=$val;
                   8867:         unless ($text) { $text=$val.'%'; }
                   8868:     } else {
                   8869:         $val = 'false';
1.1042    www      8870:     }
1.1041    www      8871:     $text=&js_ready($text);
1.1044    www      8872:     &r_print($r,<<ENDUPDATE);
1.1041    www      8873: <script type="text/javascript">
                   8874: // <![CDATA[
1.1075.2.130  raeburn  8875: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041    www      8876: // ]]>
                   8877: </script>
                   8878: ENDUPDATE
1.1035    www      8879: }
                   8880: 
1.1042    www      8881: sub LCprogressbarClose {
                   8882:     my ($r)=@_;
                   8883:     $LClastpercent=0;
1.1044    www      8884:     &r_print($r,<<ENDCLOSE);
1.1042    www      8885: <script type="text/javascript">
                   8886: // <![CDATA[
1.1045    www      8887: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      8888: // ]]>
                   8889: </script>
                   8890: ENDCLOSE
1.1044    www      8891: }
                   8892: 
                   8893: sub r_print {
                   8894:     my ($r,$to_print)=@_;
                   8895:     if ($r) {
                   8896:       $r->print($to_print);
                   8897:       $r->rflush();
                   8898:     } else {
                   8899:       print($to_print);
                   8900:     }
1.1042    www      8901: }
                   8902: 
1.320     albertel 8903: sub html_encode {
                   8904:     my ($result) = @_;
                   8905: 
1.322     albertel 8906:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 8907:     
                   8908:     return $result;
                   8909: }
1.1044    www      8910: 
1.317     albertel 8911: sub js_ready {
                   8912:     my ($result) = @_;
                   8913: 
1.323     albertel 8914:     $result =~ s/[\n\r]/ /xmsg;
                   8915:     $result =~ s/\\/\\\\/xmsg;
                   8916:     $result =~ s/'/\\'/xmsg;
1.372     albertel 8917:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 8918:     
                   8919:     return $result;
                   8920: }
                   8921: 
1.315     albertel 8922: sub validate_page {
                   8923:     if (  exists($env{'internal.start_page'})
1.316     albertel 8924: 	  &&     $env{'internal.start_page'} > 1) {
                   8925: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 8926: 				 $env{'internal.start_page'}.' '.
1.316     albertel 8927: 				 $ENV{'request.filename'});
1.315     albertel 8928:     }
                   8929:     if (  exists($env{'internal.end_page'})
1.316     albertel 8930: 	  &&     $env{'internal.end_page'} > 1) {
                   8931: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 8932: 				 $env{'internal.end_page'}.' '.
1.316     albertel 8933: 				 $env{'request.filename'});
1.315     albertel 8934:     }
                   8935:     if (     exists($env{'internal.start_page'})
                   8936: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 8937: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   8938: 				 $env{'request.filename'});
1.315     albertel 8939:     }
                   8940:     if (   ! exists($env{'internal.start_page'})
                   8941: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 8942: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   8943: 				 $env{'request.filename'});
1.315     albertel 8944:     }
1.306     albertel 8945: }
1.315     albertel 8946: 
1.996     www      8947: 
                   8948: sub start_scrollbox {
1.1075.2.56  raeburn  8949:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  8950:     unless ($outerwidth) { $outerwidth='520px'; }
                   8951:     unless ($width) { $width='500px'; }
                   8952:     unless ($height) { $height='200px'; }
1.1075    raeburn  8953:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  8954:     if ($id ne '') {
1.1075.2.42  raeburn  8955:         $table_id = ' id="table_'.$id.'"';
                   8956:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  8957:     }
1.1075    raeburn  8958:     if ($bgcolor ne '') {
                   8959:         $tdcol = "background-color: $bgcolor;";
                   8960:     }
1.1075.2.42  raeburn  8961:     my $nicescroll_js;
                   8962:     if ($env{'browser.mobile'}) {
                   8963:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   8964:     }
1.1075    raeburn  8965:     return <<"END";
1.1075.2.42  raeburn  8966: $nicescroll_js
                   8967: 
                   8968: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56  raeburn  8969: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075    raeburn  8970: END
1.996     www      8971: }
                   8972: 
                   8973: sub end_scrollbox {
1.1036    www      8974:     return '</div></td></tr></table>';
1.996     www      8975: }
                   8976: 
1.1075.2.42  raeburn  8977: sub nicescroll_javascript {
                   8978:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   8979:     my %options;
                   8980:     if (ref($cursor) eq 'HASH') {
                   8981:         %options = %{$cursor};
                   8982:     }
                   8983:     unless ($options{'railalign'} =~ /^left|right$/) {
                   8984:         $options{'railalign'} = 'left';
                   8985:     }
                   8986:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8987:         my $function  = &get_users_function();
                   8988:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
                   8989:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8990:             $options{'cursorcolor'} = '#00F';
                   8991:         }
                   8992:     }
                   8993:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   8994:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
                   8995:             $options{'cursoropacity'}='1.0';
                   8996:         }
                   8997:     } else {
                   8998:         $options{'cursoropacity'}='1.0';
                   8999:     }
                   9000:     if ($options{'cursorfixedheight'} eq 'none') {
                   9001:         delete($options{'cursorfixedheight'});
                   9002:     } else {
                   9003:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   9004:     }
                   9005:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   9006:         delete($options{'railoffset'});
                   9007:     }
                   9008:     my @niceoptions;
                   9009:     while (my($key,$value) = each(%options)) {
                   9010:         if ($value =~ /^\{.+\}$/) {
                   9011:             push(@niceoptions,$key.':'.$value);
                   9012:         } else {
                   9013:             push(@niceoptions,$key.':"'.$value.'"');
                   9014:         }
                   9015:     }
                   9016:     my $nicescroll_js = '
                   9017: $(document).ready(
                   9018:       function() {
                   9019:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   9020:       }
                   9021: );
                   9022: ';
                   9023:     if ($framecheck) {
                   9024:         $nicescroll_js .= '
                   9025: function expand_div(caller) {
                   9026:     if (top === self) {
                   9027:         document.getElementById("'.$id.'").style.width = "auto";
                   9028:         document.getElementById("'.$id.'").style.height = "auto";
                   9029:     } else {
                   9030:         try {
                   9031:             if (parent.frames) {
                   9032:                 if (parent.frames.length > 1) {
                   9033:                     var framesrc = parent.frames[1].location.href;
                   9034:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   9035:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   9036:                         document.getElementById("'.$id.'").style.width = "auto";
                   9037:                         document.getElementById("'.$id.'").style.height = "auto";
                   9038:                     }
                   9039:                 }
                   9040:             }
                   9041:         } catch (e) {
                   9042:             return;
                   9043:         }
                   9044:     }
                   9045:     return;
                   9046: }
                   9047: ';
                   9048:     }
                   9049:     if ($needjsready) {
                   9050:         $nicescroll_js = '
                   9051: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   9052:     } else {
                   9053:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   9054:     }
                   9055:     return $nicescroll_js;
                   9056: }
                   9057: 
1.318     albertel 9058: sub simple_error_page {
1.1075.2.49  raeburn  9059:     my ($r,$title,$msg,$args) = @_;
                   9060:     if (ref($args) eq 'HASH') {
                   9061:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
                   9062:     } else {
                   9063:         $msg = &mt($msg);
                   9064:     }
                   9065: 
1.318     albertel 9066:     my $page =
                   9067: 	&Apache::loncommon::start_page($title).
1.1075.2.49  raeburn  9068: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 9069: 	&Apache::loncommon::end_page();
                   9070:     if (ref($r)) {
                   9071: 	$r->print($page);
1.327     albertel 9072: 	return;
1.318     albertel 9073:     }
                   9074:     return $page;
                   9075: }
1.347     albertel 9076: 
                   9077: {
1.610     albertel 9078:     my @row_count;
1.961     onken    9079: 
                   9080:     sub start_data_table_count {
                   9081:         unshift(@row_count, 0);
                   9082:         return;
                   9083:     }
                   9084: 
                   9085:     sub end_data_table_count {
                   9086:         shift(@row_count);
                   9087:         return;
                   9088:     }
                   9089: 
1.347     albertel 9090:     sub start_data_table {
1.1018    raeburn  9091: 	my ($add_class,$id) = @_;
1.422     albertel 9092: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  9093:         my $table_id;
                   9094:         if (defined($id)) {
                   9095:             $table_id = ' id="'.$id.'"';
                   9096:         }
1.961     onken    9097: 	&start_data_table_count();
1.1018    raeburn  9098: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 9099:     }
                   9100: 
                   9101:     sub end_data_table {
1.961     onken    9102: 	&end_data_table_count();
1.389     albertel 9103: 	return '</table>'."\n";;
1.347     albertel 9104:     }
                   9105: 
                   9106:     sub start_data_table_row {
1.974     wenzelju 9107: 	my ($add_class, $id) = @_;
1.610     albertel 9108: 	$row_count[0]++;
                   9109: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   9110: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 9111:         $id = (' id="'.$id.'"') unless ($id eq '');
                   9112:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 9113:     }
1.471     banghart 9114:     
                   9115:     sub continue_data_table_row {
1.974     wenzelju 9116: 	my ($add_class, $id) = @_;
1.610     albertel 9117: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 9118: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   9119:         $id = (' id="'.$id.'"') unless ($id eq '');
                   9120:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 9121:     }
1.347     albertel 9122: 
                   9123:     sub end_data_table_row {
1.389     albertel 9124: 	return '</tr>'."\n";;
1.347     albertel 9125:     }
1.367     www      9126: 
1.421     albertel 9127:     sub start_data_table_empty_row {
1.707     bisitz   9128: #	$row_count[0]++;
1.421     albertel 9129: 	return  '<tr class="LC_empty_row" >'."\n";;
                   9130:     }
                   9131: 
                   9132:     sub end_data_table_empty_row {
                   9133: 	return '</tr>'."\n";;
                   9134:     }
                   9135: 
1.367     www      9136:     sub start_data_table_header_row {
1.389     albertel 9137: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      9138:     }
                   9139: 
                   9140:     sub end_data_table_header_row {
1.389     albertel 9141: 	return '</tr>'."\n";;
1.367     www      9142:     }
1.890     droeschl 9143: 
                   9144:     sub data_table_caption {
                   9145:         my $caption = shift;
                   9146:         return "<caption class=\"LC_caption\">$caption</caption>";
                   9147:     }
1.347     albertel 9148: }
                   9149: 
1.548     albertel 9150: =pod
                   9151: 
                   9152: =item * &inhibit_menu_check($arg)
                   9153: 
                   9154: Checks for a inhibitmenu state and generates output to preserve it
                   9155: 
                   9156: Inputs:         $arg - can be any of
                   9157:                      - undef - in which case the return value is a string 
                   9158:                                to add  into arguments list of a uri
                   9159:                      - 'input' - in which case the return value is a HTML
                   9160:                                  <form> <input> field of type hidden to
                   9161:                                  preserve the value
                   9162:                      - a url - in which case the return value is the url with
                   9163:                                the neccesary cgi args added to preserve the
                   9164:                                inhibitmenu state
                   9165:                      - a ref to a url - no return value, but the string is
                   9166:                                         updated to include the neccessary cgi
                   9167:                                         args to preserve the inhibitmenu state
                   9168: 
                   9169: =cut
                   9170: 
                   9171: sub inhibit_menu_check {
                   9172:     my ($arg) = @_;
                   9173:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   9174:     if ($arg eq 'input') {
                   9175: 	if ($env{'form.inhibitmenu'}) {
                   9176: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   9177: 	} else {
                   9178: 	    return
                   9179: 	}
                   9180:     }
                   9181:     if ($env{'form.inhibitmenu'}) {
                   9182: 	if (ref($arg)) {
                   9183: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   9184: 	} elsif ($arg eq '') {
                   9185: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   9186: 	} else {
                   9187: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   9188: 	}
                   9189:     }
                   9190:     if (!ref($arg)) {
                   9191: 	return $arg;
                   9192:     }
                   9193: }
                   9194: 
1.251     albertel 9195: ###############################################
1.182     matthew  9196: 
                   9197: =pod
                   9198: 
1.549     albertel 9199: =back
                   9200: 
                   9201: =head1 User Information Routines
                   9202: 
                   9203: =over 4
                   9204: 
1.405     albertel 9205: =item * &get_users_function()
1.182     matthew  9206: 
                   9207: Used by &bodytag to determine the current users primary role.
                   9208: Returns either 'student','coordinator','admin', or 'author'.
                   9209: 
                   9210: =cut
                   9211: 
                   9212: ###############################################
                   9213: sub get_users_function {
1.815     tempelho 9214:     my $function = 'norole';
1.818     tempelho 9215:     if ($env{'request.role'}=~/^(st)/) {
                   9216:         $function='student';
                   9217:     }
1.907     raeburn  9218:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  9219:         $function='coordinator';
                   9220:     }
1.258     albertel 9221:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  9222:         $function='admin';
                   9223:     }
1.826     bisitz   9224:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  9225:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  9226:         $function='author';
                   9227:     }
                   9228:     return $function;
1.54      www      9229: }
1.99      www      9230: 
                   9231: ###############################################
                   9232: 
1.233     raeburn  9233: =pod
                   9234: 
1.821     raeburn  9235: =item * &show_course()
                   9236: 
                   9237: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   9238: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   9239: 
                   9240: Inputs:
                   9241: None
                   9242: 
                   9243: Outputs:
                   9244: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   9245: 
                   9246: =cut
                   9247: 
                   9248: ###############################################
                   9249: sub show_course {
                   9250:     my $course = !$env{'user.adv'};
                   9251:     if (!$env{'user.adv'}) {
                   9252:         foreach my $env (keys(%env)) {
                   9253:             next if ($env !~ m/^user\.priv\./);
                   9254:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   9255:                 $course = 0;
                   9256:                 last;
                   9257:             }
                   9258:         }
                   9259:     }
                   9260:     return $course;
                   9261: }
                   9262: 
                   9263: ###############################################
                   9264: 
                   9265: =pod
                   9266: 
1.542     raeburn  9267: =item * &check_user_status()
1.274     raeburn  9268: 
                   9269: Determines current status of supplied role for a
                   9270: specific user. Roles can be active, previous or future.
                   9271: 
                   9272: Inputs: 
                   9273: user's domain, user's username, course's domain,
1.375     raeburn  9274: course's number, optional section ID.
1.274     raeburn  9275: 
                   9276: Outputs:
                   9277: role status: active, previous or future. 
                   9278: 
                   9279: =cut
                   9280: 
                   9281: sub check_user_status {
1.412     raeburn  9282:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  9283:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1075.2.85  raeburn  9284:     my @uroles = keys(%userinfo);
1.274     raeburn  9285:     my $srchstr;
                   9286:     my $active_chk = 'none';
1.412     raeburn  9287:     my $now = time;
1.274     raeburn  9288:     if (@uroles > 0) {
1.908     raeburn  9289:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  9290:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   9291:         } else {
1.412     raeburn  9292:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   9293:         }
                   9294:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  9295:             my $role_end = 0;
                   9296:             my $role_start = 0;
                   9297:             $active_chk = 'active';
1.412     raeburn  9298:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   9299:                 $role_end = $1;
                   9300:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   9301:                     $role_start = $1;
1.274     raeburn  9302:                 }
                   9303:             }
                   9304:             if ($role_start > 0) {
1.412     raeburn  9305:                 if ($now < $role_start) {
1.274     raeburn  9306:                     $active_chk = 'future';
                   9307:                 }
                   9308:             }
                   9309:             if ($role_end > 0) {
1.412     raeburn  9310:                 if ($now > $role_end) {
1.274     raeburn  9311:                     $active_chk = 'previous';
                   9312:                 }
                   9313:             }
                   9314:         }
                   9315:     }
                   9316:     return $active_chk;
                   9317: }
                   9318: 
                   9319: ###############################################
                   9320: 
                   9321: =pod
                   9322: 
1.405     albertel 9323: =item * &get_sections()
1.233     raeburn  9324: 
                   9325: Determines all the sections for a course including
                   9326: sections with students and sections containing other roles.
1.419     raeburn  9327: Incoming parameters: 
                   9328: 
                   9329: 1. domain
                   9330: 2. course number 
                   9331: 3. reference to array containing roles for which sections should 
                   9332: be gathered (optional).
                   9333: 4. reference to array containing status types for which sections 
                   9334: should be gathered (optional).
                   9335: 
                   9336: If the third argument is undefined, sections are gathered for any role. 
                   9337: If the fourth argument is undefined, sections are gathered for any status.
                   9338: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  9339:  
1.374     raeburn  9340: Returns section hash (keys are section IDs, values are
                   9341: number of users in each section), subject to the
1.419     raeburn  9342: optional roles filter, optional status filter 
1.233     raeburn  9343: 
                   9344: =cut
                   9345: 
                   9346: ###############################################
                   9347: sub get_sections {
1.419     raeburn  9348:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 9349:     if (!defined($cdom) || !defined($cnum)) {
                   9350:         my $cid =  $env{'request.course.id'};
                   9351: 
                   9352: 	return if (!defined($cid));
                   9353: 
                   9354:         $cdom = $env{'course.'.$cid.'.domain'};
                   9355:         $cnum = $env{'course.'.$cid.'.num'};
                   9356:     }
                   9357: 
                   9358:     my %sectioncount;
1.419     raeburn  9359:     my $now = time;
1.240     albertel 9360: 
1.1075.2.33  raeburn  9361:     my $check_students = 1;
                   9362:     my $only_students = 0;
                   9363:     if (ref($possible_roles) eq 'ARRAY') {
                   9364:         if (grep(/^st$/,@{$possible_roles})) {
                   9365:             if (@{$possible_roles} == 1) {
                   9366:                 $only_students = 1;
                   9367:             }
                   9368:         } else {
                   9369:             $check_students = 0;
                   9370:         }
                   9371:     }
                   9372: 
                   9373:     if ($check_students) {
1.276     albertel 9374: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 9375: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   9376: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  9377:         my $start_index = &Apache::loncoursedata::CL_START();
                   9378:         my $end_index = &Apache::loncoursedata::CL_END();
                   9379:         my $status;
1.366     albertel 9380: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  9381: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   9382: 				                     $data->[$status_index],
                   9383:                                                      $data->[$start_index],
                   9384:                                                      $data->[$end_index]);
                   9385:             if ($stu_status eq 'Active') {
                   9386:                 $status = 'active';
                   9387:             } elsif ($end < $now) {
                   9388:                 $status = 'previous';
                   9389:             } elsif ($start > $now) {
                   9390:                 $status = 'future';
                   9391:             } 
                   9392: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   9393:                 if ((!defined($possible_status)) || (($status ne '') && 
                   9394:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   9395: 		    $sectioncount{$section}++;
                   9396:                 }
1.240     albertel 9397: 	    }
                   9398: 	}
                   9399:     }
1.1075.2.33  raeburn  9400:     if ($only_students) {
                   9401:         return %sectioncount;
                   9402:     }
1.240     albertel 9403:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9404:     foreach my $user (sort(keys(%courseroles))) {
                   9405: 	if ($user !~ /^(\w{2})/) { next; }
                   9406: 	my ($role) = ($user =~ /^(\w{2})/);
                   9407: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  9408: 	my ($section,$status);
1.240     albertel 9409: 	if ($role eq 'cr' &&
                   9410: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   9411: 	    $section=$1;
                   9412: 	}
                   9413: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   9414: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  9415:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   9416:         if ($end == -1 && $start == -1) {
                   9417:             next; #deleted role
                   9418:         }
                   9419:         if (!defined($possible_status)) { 
                   9420:             $sectioncount{$section}++;
                   9421:         } else {
                   9422:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   9423:                 $status = 'active';
                   9424:             } elsif ($end < $now) {
                   9425:                 $status = 'future';
                   9426:             } elsif ($start > $now) {
                   9427:                 $status = 'previous';
                   9428:             }
                   9429:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   9430:                 $sectioncount{$section}++;
                   9431:             }
                   9432:         }
1.233     raeburn  9433:     }
1.366     albertel 9434:     return %sectioncount;
1.233     raeburn  9435: }
                   9436: 
1.274     raeburn  9437: ###############################################
1.294     raeburn  9438: 
                   9439: =pod
1.405     albertel 9440: 
                   9441: =item * &get_course_users()
                   9442: 
1.275     raeburn  9443: Retrieves usernames:domains for users in the specified course
                   9444: with specific role(s), and access status. 
                   9445: 
                   9446: Incoming parameters:
1.277     albertel 9447: 1. course domain
                   9448: 2. course number
                   9449: 3. access status: users must have - either active, 
1.275     raeburn  9450: previous, future, or all.
1.277     albertel 9451: 4. reference to array of permissible roles
1.288     raeburn  9452: 5. reference to array of section restrictions (optional)
                   9453: 6. reference to results object (hash of hashes).
                   9454: 7. reference to optional userdata hash
1.609     raeburn  9455: 8. reference to optional statushash
1.630     raeburn  9456: 9. flag if privileged users (except those set to unhide in
                   9457:    course settings) should be excluded    
1.609     raeburn  9458: Keys of top level results hash are roles.
1.275     raeburn  9459: Keys of inner hashes are username:domain, with 
                   9460: values set to access type.
1.288     raeburn  9461: Optional userdata hash returns an array with arguments in the 
                   9462: same order as loncoursedata::get_classlist() for student data.
                   9463: 
1.609     raeburn  9464: Optional statushash returns
                   9465: 
1.288     raeburn  9466: Entries for end, start, section and status are blank because
                   9467: of the possibility of multiple values for non-student roles.
                   9468: 
1.275     raeburn  9469: =cut
1.405     albertel 9470: 
1.275     raeburn  9471: ###############################################
1.405     albertel 9472: 
1.275     raeburn  9473: sub get_course_users {
1.630     raeburn  9474:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  9475:     my %idx = ();
1.419     raeburn  9476:     my %seclists;
1.288     raeburn  9477: 
                   9478:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   9479:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   9480:     $idx{end} = &Apache::loncoursedata::CL_END();
                   9481:     $idx{start} = &Apache::loncoursedata::CL_START();
                   9482:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   9483:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   9484:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   9485:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   9486: 
1.290     albertel 9487:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 9488:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  9489:         my $now = time;
1.277     albertel 9490:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  9491:             my $match = 0;
1.412     raeburn  9492:             my $secmatch = 0;
1.419     raeburn  9493:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  9494:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  9495:             if ($section eq '') {
                   9496:                 $section = 'none';
                   9497:             }
1.291     albertel 9498:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 9499:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  9500:                     $secmatch = 1;
                   9501:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 9502:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  9503:                         $secmatch = 1;
                   9504:                     }
                   9505:                 } else {  
1.419     raeburn  9506: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  9507: 		        $secmatch = 1;
                   9508:                     }
1.290     albertel 9509: 		}
1.412     raeburn  9510:                 if (!$secmatch) {
                   9511:                     next;
                   9512:                 }
1.419     raeburn  9513:             }
1.275     raeburn  9514:             if (defined($$types{'active'})) {
1.288     raeburn  9515:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  9516:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  9517:                     $match = 1;
1.275     raeburn  9518:                 }
                   9519:             }
                   9520:             if (defined($$types{'previous'})) {
1.609     raeburn  9521:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  9522:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  9523:                     $match = 1;
1.275     raeburn  9524:                 }
                   9525:             }
                   9526:             if (defined($$types{'future'})) {
1.609     raeburn  9527:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  9528:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  9529:                     $match = 1;
1.275     raeburn  9530:                 }
                   9531:             }
1.609     raeburn  9532:             if ($match) {
                   9533:                 push(@{$seclists{$student}},$section);
                   9534:                 if (ref($userdata) eq 'HASH') {
                   9535:                     $$userdata{$student} = $$classlist{$student};
                   9536:                 }
                   9537:                 if (ref($statushash) eq 'HASH') {
                   9538:                     $statushash->{$student}{'st'}{$section} = $status;
                   9539:                 }
1.288     raeburn  9540:             }
1.275     raeburn  9541:         }
                   9542:     }
1.412     raeburn  9543:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  9544:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9545:         my $now = time;
1.609     raeburn  9546:         my %displaystatus = ( previous => 'Expired',
                   9547:                               active   => 'Active',
                   9548:                               future   => 'Future',
                   9549:                             );
1.1075.2.36  raeburn  9550:         my (%nothide,@possdoms);
1.630     raeburn  9551:         if ($hidepriv) {
                   9552:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   9553:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   9554:                 if ($user !~ /:/) {
                   9555:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   9556:                 } else {
                   9557:                     $nothide{$user} = 1;
                   9558:                 }
                   9559:             }
1.1075.2.36  raeburn  9560:             my @possdoms = ($cdom);
                   9561:             if ($coursehash{'checkforpriv'}) {
                   9562:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   9563:             }
1.630     raeburn  9564:         }
1.439     raeburn  9565:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  9566:             my $match = 0;
1.412     raeburn  9567:             my $secmatch = 0;
1.439     raeburn  9568:             my $status;
1.412     raeburn  9569:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  9570:             $user =~ s/:$//;
1.439     raeburn  9571:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   9572:             if ($end == -1 || $start == -1) {
                   9573:                 next;
                   9574:             }
                   9575:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   9576:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  9577:                 my ($uname,$udom) = split(/:/,$user);
                   9578:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 9579:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  9580:                         $secmatch = 1;
                   9581:                     } elsif ($usec eq '') {
1.420     albertel 9582:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  9583:                             $secmatch = 1;
                   9584:                         }
                   9585:                     } else {
                   9586:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   9587:                             $secmatch = 1;
                   9588:                         }
                   9589:                     }
                   9590:                     if (!$secmatch) {
                   9591:                         next;
                   9592:                     }
1.288     raeburn  9593:                 }
1.419     raeburn  9594:                 if ($usec eq '') {
                   9595:                     $usec = 'none';
                   9596:                 }
1.275     raeburn  9597:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  9598:                     if ($hidepriv) {
1.1075.2.36  raeburn  9599:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  9600:                             (!$nothide{$uname.':'.$udom})) {
                   9601:                             next;
                   9602:                         }
                   9603:                     }
1.503     raeburn  9604:                     if ($end > 0 && $end < $now) {
1.439     raeburn  9605:                         $status = 'previous';
                   9606:                     } elsif ($start > $now) {
                   9607:                         $status = 'future';
                   9608:                     } else {
                   9609:                         $status = 'active';
                   9610:                     }
1.277     albertel 9611:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  9612:                         if ($status eq $type) {
1.420     albertel 9613:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  9614:                                 push(@{$$users{$role}{$user}},$type);
                   9615:                             }
1.288     raeburn  9616:                             $match = 1;
                   9617:                         }
                   9618:                     }
1.419     raeburn  9619:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   9620:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   9621: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   9622:                         }
1.420     albertel 9623:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  9624:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   9625:                         }
1.609     raeburn  9626:                         if (ref($statushash) eq 'HASH') {
                   9627:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   9628:                         }
1.275     raeburn  9629:                     }
                   9630:                 }
                   9631:             }
                   9632:         }
1.290     albertel 9633:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  9634:             if ((defined($cdom)) && (defined($cnum))) {
                   9635:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   9636:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   9637:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  9638:                     next if ($owner eq '');
                   9639:                     my ($ownername,$ownerdom);
                   9640:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   9641:                         $ownername = $1;
                   9642:                         $ownerdom = $2;
                   9643:                     } else {
                   9644:                         $ownername = $owner;
                   9645:                         $ownerdom = $cdom;
                   9646:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  9647:                     }
                   9648:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 9649:                     if (defined($userdata) && 
1.609     raeburn  9650: 			!exists($$userdata{$owner})) {
                   9651: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   9652:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   9653:                             push(@{$seclists{$owner}},'none');
                   9654:                         }
                   9655:                         if (ref($statushash) eq 'HASH') {
                   9656:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  9657:                         }
1.290     albertel 9658: 		    }
1.279     raeburn  9659:                 }
                   9660:             }
                   9661:         }
1.419     raeburn  9662:         foreach my $user (keys(%seclists)) {
                   9663:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   9664:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   9665:         }
1.275     raeburn  9666:     }
                   9667:     return;
                   9668: }
                   9669: 
1.288     raeburn  9670: sub get_user_info {
                   9671:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 9672:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   9673: 	&plainname($uname,$udom,'lastname');
1.291     albertel 9674:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  9675:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  9676:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   9677:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  9678:     return;
                   9679: }
1.275     raeburn  9680: 
1.472     raeburn  9681: ###############################################
                   9682: 
                   9683: =pod
                   9684: 
                   9685: =item * &get_user_quota()
                   9686: 
1.1075.2.41  raeburn  9687: Retrieves quota assigned for storage of user files.
                   9688: Default is to report quota for portfolio files.
1.472     raeburn  9689: 
                   9690: Incoming parameters:
                   9691: 1. user's username
                   9692: 2. user's domain
1.1075.2.41  raeburn  9693: 3. quota name - portfolio, author, or course
                   9694:    (if no quota name provided, defaults to portfolio).
1.1075.2.59  raeburn  9695: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42  raeburn  9696:    course
1.472     raeburn  9697: 
                   9698: Returns:
1.1075.2.58  raeburn  9699: 1. Disk quota (in MB) assigned to student.
1.536     raeburn  9700: 2. (Optional) Type of setting: custom or default
                   9701:    (individually assigned or default for user's 
                   9702:    institutional status).
                   9703: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   9704:    or student - types as defined in localenroll::inst_usertypes 
                   9705:    for user's domain, which determines default quota for user.
                   9706: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  9707: 
                   9708: If a value has been stored in the user's environment, 
1.536     raeburn  9709: it will return that, otherwise it returns the maximal default
1.1075.2.41  raeburn  9710: defined for the user's institutional status(es) in the domain.
1.472     raeburn  9711: 
                   9712: =cut
                   9713: 
                   9714: ###############################################
                   9715: 
                   9716: 
                   9717: sub get_user_quota {
1.1075.2.42  raeburn  9718:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  9719:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  9720:     if (!defined($udom)) {
                   9721:         $udom = $env{'user.domain'};
                   9722:     }
                   9723:     if (!defined($uname)) {
                   9724:         $uname = $env{'user.name'};
                   9725:     }
                   9726:     if (($udom eq '' || $uname eq '') ||
                   9727:         ($udom eq 'public') && ($uname eq 'public')) {
                   9728:         $quota = 0;
1.536     raeburn  9729:         $quotatype = 'default';
                   9730:         $defquota = 0; 
1.472     raeburn  9731:     } else {
1.536     raeburn  9732:         my $inststatus;
1.1075.2.41  raeburn  9733:         if ($quotaname eq 'course') {
                   9734:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   9735:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   9736:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   9737:             } else {
                   9738:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   9739:                 $quota = $cenv{'internal.uploadquota'};
                   9740:             }
1.536     raeburn  9741:         } else {
1.1075.2.41  raeburn  9742:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   9743:                 if ($quotaname eq 'author') {
                   9744:                     $quota = $env{'environment.authorquota'};
                   9745:                 } else {
                   9746:                     $quota = $env{'environment.portfolioquota'};
                   9747:                 }
                   9748:                 $inststatus = $env{'environment.inststatus'};
                   9749:             } else {
                   9750:                 my %userenv = 
                   9751:                     &Apache::lonnet::get('environment',['portfolioquota',
                   9752:                                          'authorquota','inststatus'],$udom,$uname);
                   9753:                 my ($tmp) = keys(%userenv);
                   9754:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   9755:                     if ($quotaname eq 'author') {
                   9756:                         $quota = $userenv{'authorquota'};
                   9757:                     } else {
                   9758:                         $quota = $userenv{'portfolioquota'};
                   9759:                     }
                   9760:                     $inststatus = $userenv{'inststatus'};
                   9761:                 } else {
                   9762:                     undef(%userenv);
                   9763:                 }
                   9764:             }
                   9765:         }
                   9766:         if ($quota eq '' || wantarray) {
                   9767:             if ($quotaname eq 'course') {
                   9768:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59  raeburn  9769:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
                   9770:                     ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42  raeburn  9771:                     $defquota = $domdefs{$crstype.'quota'};
                   9772:                 }
                   9773:                 if ($defquota eq '') {
                   9774:                     $defquota = 500;
                   9775:                 }
1.1075.2.41  raeburn  9776:             } else {
                   9777:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   9778:             }
                   9779:             if ($quota eq '') {
                   9780:                 $quota = $defquota;
                   9781:                 $quotatype = 'default';
                   9782:             } else {
                   9783:                 $quotatype = 'custom';
                   9784:             }
1.472     raeburn  9785:         }
                   9786:     }
1.536     raeburn  9787:     if (wantarray) {
                   9788:         return ($quota,$quotatype,$settingstatus,$defquota);
                   9789:     } else {
                   9790:         return $quota;
                   9791:     }
1.472     raeburn  9792: }
                   9793: 
                   9794: ###############################################
                   9795: 
                   9796: =pod
                   9797: 
                   9798: =item * &default_quota()
                   9799: 
1.536     raeburn  9800: Retrieves default quota assigned for storage of user portfolio files,
                   9801: given an (optional) user's institutional status.
1.472     raeburn  9802: 
                   9803: Incoming parameters:
1.1075.2.42  raeburn  9804: 
1.472     raeburn  9805: 1. domain
1.536     raeburn  9806: 2. (Optional) institutional status(es).  This is a : separated list of 
                   9807:    status types (e.g., faculty, staff, student etc.)
                   9808:    which apply to the user for whom the default is being retrieved.
                   9809:    If the institutional status string in undefined, the domain
1.1075.2.41  raeburn  9810:    default quota will be returned.
                   9811: 3.  quota name - portfolio, author, or course
                   9812:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  9813: 
                   9814: Returns:
1.1075.2.42  raeburn  9815: 
1.1075.2.58  raeburn  9816: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536     raeburn  9817: 2. (Optional) institutional type which determined the value of the
                   9818:    default quota.
1.472     raeburn  9819: 
                   9820: If a value has been stored in the domain's configuration db,
                   9821: it will return that, otherwise it returns 20 (for backwards 
                   9822: compatibility with domains which have not set up a configuration
1.1075.2.58  raeburn  9823: db file; the original statically defined portfolio quota was 20 MB). 
1.472     raeburn  9824: 
1.536     raeburn  9825: If the user's status includes multiple types (e.g., staff and student),
                   9826: the largest default quota which applies to the user determines the
                   9827: default quota returned.
                   9828: 
1.472     raeburn  9829: =cut
                   9830: 
                   9831: ###############################################
                   9832: 
                   9833: 
                   9834: sub default_quota {
1.1075.2.41  raeburn  9835:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  9836:     my ($defquota,$settingstatus);
                   9837:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  9838:                                             ['quotas'],$udom);
1.1075.2.41  raeburn  9839:     my $key = 'defaultquota';
                   9840:     if ($quotaname eq 'author') {
                   9841:         $key = 'authorquota';
                   9842:     }
1.622     raeburn  9843:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  9844:         if ($inststatus ne '') {
1.765     raeburn  9845:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  9846:             foreach my $item (@statuses) {
1.1075.2.41  raeburn  9847:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   9848:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  9849:                         if ($defquota eq '') {
1.1075.2.41  raeburn  9850:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  9851:                             $settingstatus = $item;
1.1075.2.41  raeburn  9852:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   9853:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  9854:                             $settingstatus = $item;
                   9855:                         }
                   9856:                     }
1.1075.2.41  raeburn  9857:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  9858:                     if ($quotahash{'quotas'}{$item} ne '') {
                   9859:                         if ($defquota eq '') {
                   9860:                             $defquota = $quotahash{'quotas'}{$item};
                   9861:                             $settingstatus = $item;
                   9862:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   9863:                             $defquota = $quotahash{'quotas'}{$item};
                   9864:                             $settingstatus = $item;
                   9865:                         }
1.536     raeburn  9866:                     }
                   9867:                 }
                   9868:             }
                   9869:         }
                   9870:         if ($defquota eq '') {
1.1075.2.41  raeburn  9871:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   9872:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   9873:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  9874:                 $defquota = $quotahash{'quotas'}{'default'};
                   9875:             }
1.536     raeburn  9876:             $settingstatus = 'default';
1.1075.2.42  raeburn  9877:             if ($defquota eq '') {
                   9878:                 if ($quotaname eq 'author') {
                   9879:                     $defquota = 500;
                   9880:                 }
                   9881:             }
1.536     raeburn  9882:         }
                   9883:     } else {
                   9884:         $settingstatus = 'default';
1.1075.2.41  raeburn  9885:         if ($quotaname eq 'author') {
                   9886:             $defquota = 500;
                   9887:         } else {
                   9888:             $defquota = 20;
                   9889:         }
1.536     raeburn  9890:     }
                   9891:     if (wantarray) {
                   9892:         return ($defquota,$settingstatus);
1.472     raeburn  9893:     } else {
1.536     raeburn  9894:         return $defquota;
1.472     raeburn  9895:     }
                   9896: }
                   9897: 
1.1075.2.41  raeburn  9898: ###############################################
                   9899: 
                   9900: =pod
                   9901: 
1.1075.2.42  raeburn  9902: =item * &excess_filesize_warning()
1.1075.2.41  raeburn  9903: 
                   9904: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42  raeburn  9905: of existing file within authoring space will cause quota for the authoring
                   9906: space to be exceeded.
                   9907: 
                   9908: Same, if upload of a file directly to a course/community via Course Editor
                   9909: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41  raeburn  9910: 
1.1075.2.61  raeburn  9911: Inputs: 7 
1.1075.2.42  raeburn  9912: 1. username or coursenum
1.1075.2.41  raeburn  9913: 2. domain
1.1075.2.42  raeburn  9914: 3. context ('author' or 'course')
1.1075.2.41  raeburn  9915: 4. filename of file for which action is being requested
                   9916: 5. filesize (kB) of file
                   9917: 6. action being taken: copy or upload.
1.1075.2.59  raeburn  9918: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41  raeburn  9919: 
                   9920: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
                   9921:          otherwise return null.
                   9922: 
1.1075.2.42  raeburn  9923: =back
                   9924: 
1.1075.2.41  raeburn  9925: =cut
                   9926: 
1.1075.2.42  raeburn  9927: sub excess_filesize_warning {
1.1075.2.59  raeburn  9928:     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42  raeburn  9929:     my $current_disk_usage = 0;
1.1075.2.59  raeburn  9930:     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42  raeburn  9931:     if ($context eq 'author') {
                   9932:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   9933:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   9934:     } else {
                   9935:         foreach my $subdir ('docs','supplemental') {
                   9936:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   9937:         }
                   9938:     }
1.1075.2.41  raeburn  9939:     $disk_quota = int($disk_quota * 1000);
                   9940:     if (($current_disk_usage + $filesize) > $disk_quota) {
1.1075.2.69  raeburn  9941:         return '<p class="LC_warning">'.
1.1075.2.41  raeburn  9942:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1075.2.69  raeburn  9943:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                   9944:                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1075.2.41  raeburn  9945:                             $disk_quota,$current_disk_usage).
                   9946:                '</p>';
                   9947:     }
                   9948:     return;
                   9949: }
                   9950: 
                   9951: ###############################################
                   9952: 
                   9953: 
1.384     raeburn  9954: sub get_secgrprole_info {
                   9955:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   9956:     my %sections_count = &get_sections($cdom,$cnum);
                   9957:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   9958:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   9959:     my @groups = sort(keys(%curr_groups));
                   9960:     my $allroles = [];
                   9961:     my $rolehash;
                   9962:     my $accesshash = {
                   9963:                      active => 'Currently has access',
                   9964:                      future => 'Will have future access',
                   9965:                      previous => 'Previously had access',
                   9966:                   };
                   9967:     if ($needroles) {
                   9968:         $rolehash = {'all' => 'all'};
1.385     albertel 9969:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9970: 	if (&Apache::lonnet::error(%user_roles)) {
                   9971: 	    undef(%user_roles);
                   9972: 	}
                   9973:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  9974:             my ($role)=split(/\:/,$item,2);
                   9975:             if ($role eq 'cr') { next; }
                   9976:             if ($role =~ /^cr/) {
                   9977:                 $$rolehash{$role} = (split('/',$role))[3];
                   9978:             } else {
                   9979:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   9980:             }
                   9981:         }
                   9982:         foreach my $key (sort(keys(%{$rolehash}))) {
                   9983:             push(@{$allroles},$key);
                   9984:         }
                   9985:         push (@{$allroles},'st');
                   9986:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   9987:     }
                   9988:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   9989: }
                   9990: 
1.555     raeburn  9991: sub user_picker {
1.1075.2.127  raeburn  9992:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555     raeburn  9993:     my $currdom = $dom;
1.1075.2.114  raeburn  9994:     my @alldoms = &Apache::lonnet::all_domains();
                   9995:     if (@alldoms == 1) {
                   9996:         my %domsrch = &Apache::lonnet::get_dom('configuration',
                   9997:                                                ['directorysrch'],$alldoms[0]);
                   9998:         my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
                   9999:         my $showdom = $domdesc;
                   10000:         if ($showdom eq '') {
                   10001:             $showdom = $dom;
                   10002:         }
                   10003:         if (ref($domsrch{'directorysrch'}) eq 'HASH') {
                   10004:             if ((!$domsrch{'directorysrch'}{'available'}) &&
                   10005:                 ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
                   10006:                 return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
                   10007:             }
                   10008:         }
                   10009:     }
1.555     raeburn  10010:     my %curr_selected = (
                   10011:                         srchin => 'dom',
1.580     raeburn  10012:                         srchby => 'lastname',
1.555     raeburn  10013:                       );
                   10014:     my $srchterm;
1.625     raeburn  10015:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  10016:         if ($srch->{'srchby'} ne '') {
                   10017:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   10018:         }
                   10019:         if ($srch->{'srchin'} ne '') {
                   10020:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   10021:         }
                   10022:         if ($srch->{'srchtype'} ne '') {
                   10023:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   10024:         }
                   10025:         if ($srch->{'srchdomain'} ne '') {
                   10026:             $currdom = $srch->{'srchdomain'};
                   10027:         }
                   10028:         $srchterm = $srch->{'srchterm'};
                   10029:     }
1.1075.2.98  raeburn  10030:     my %html_lt=&Apache::lonlocal::texthash(
1.573     raeburn  10031:                     'usr'       => 'Search criteria',
1.563     raeburn  10032:                     'doma'      => 'Domain/institution to search',
1.558     albertel 10033:                     'uname'     => 'username',
                   10034:                     'lastname'  => 'last name',
1.555     raeburn  10035:                     'lastfirst' => 'last name, first name',
1.558     albertel 10036:                     'crs'       => 'in this course',
1.576     raeburn  10037:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 10038:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  10039:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 10040:                     'exact'     => 'is',
                   10041:                     'contains'  => 'contains',
1.569     raeburn  10042:                     'begins'    => 'begins with',
1.1075.2.98  raeburn  10043:                                        );
                   10044:     my %js_lt=&Apache::lonlocal::texthash(
1.571     raeburn  10045:                     'youm'      => "You must include some text to search for.",
                   10046:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   10047:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   10048:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   10049:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   10050:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   10051:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   10052:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  10053:                                        );
1.1075.2.98  raeburn  10054:     &html_escape(\%html_lt);
                   10055:     &js_escape(\%js_lt);
1.1075.2.115  raeburn  10056:     my $domform;
1.1075.2.126  raeburn  10057:     my $allow_blank = 1;
1.1075.2.115  raeburn  10058:     if ($fixeddom) {
1.1075.2.126  raeburn  10059:         $allow_blank = 0;
                   10060:         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1075.2.115  raeburn  10061:     } else {
1.1075.2.126  raeburn  10062:         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1);
1.1075.2.115  raeburn  10063:     }
1.563     raeburn  10064:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  10065: 
                   10066:     my @srchins = ('crs','dom','alc','instd');
                   10067: 
                   10068:     foreach my $option (@srchins) {
                   10069:         # FIXME 'alc' option unavailable until 
                   10070:         #       loncreateuser::print_user_query_page()
                   10071:         #       has been completed.
                   10072:         next if ($option eq 'alc');
1.880     raeburn  10073:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  10074:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.1075.2.127  raeburn  10075:         next if (($option eq 'instd') && ($noinstd));
1.563     raeburn  10076:         if ($curr_selected{'srchin'} eq $option) {
                   10077:             $srchinsel .= ' 
1.1075.2.98  raeburn  10078:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563     raeburn  10079:         } else {
                   10080:             $srchinsel .= '
1.1075.2.98  raeburn  10081:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563     raeburn  10082:         }
1.555     raeburn  10083:     }
1.563     raeburn  10084:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  10085: 
                   10086:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  10087:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  10088:         if ($curr_selected{'srchby'} eq $option) {
                   10089:             $srchbysel .= '
1.1075.2.98  raeburn  10090:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  10091:         } else {
                   10092:             $srchbysel .= '
1.1075.2.98  raeburn  10093:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  10094:          }
                   10095:     }
                   10096:     $srchbysel .= "\n  </select>\n";
                   10097: 
                   10098:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  10099:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  10100:         if ($curr_selected{'srchtype'} eq $option) {
                   10101:             $srchtypesel .= '
1.1075.2.98  raeburn  10102:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  10103:         } else {
                   10104:             $srchtypesel .= '
1.1075.2.98  raeburn  10105:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  10106:         }
                   10107:     }
                   10108:     $srchtypesel .= "\n  </select>\n";
                   10109: 
1.558     albertel 10110:     my ($newuserscript,$new_user_create);
1.994     raeburn  10111:     my $context_dom = $env{'request.role.domain'};
                   10112:     if ($context eq 'requestcrs') {
                   10113:         if ($env{'form.coursedom'} ne '') { 
                   10114:             $context_dom = $env{'form.coursedom'};
                   10115:         }
                   10116:     }
1.556     raeburn  10117:     if ($forcenewuser) {
1.576     raeburn  10118:         if (ref($srch) eq 'HASH') {
1.994     raeburn  10119:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  10120:                 if ($cancreate) {
                   10121:                     $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>';
                   10122:                 } else {
1.799     bisitz   10123:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  10124:                     my %usertypetext = (
                   10125:                         official   => 'institutional',
                   10126:                         unofficial => 'non-institutional',
                   10127:                     );
1.799     bisitz   10128:                     $new_user_create = '<p class="LC_warning">'
                   10129:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   10130:                                       .' '
                   10131:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   10132:                                           ,'<a href="'.$helplink.'">','</a>')
                   10133:                                       .'</p><br />';
1.627     raeburn  10134:                 }
1.576     raeburn  10135:             }
                   10136:         }
                   10137: 
1.556     raeburn  10138:         $newuserscript = <<"ENDSCRIPT";
                   10139: 
1.570     raeburn  10140: function setSearch(createnew,callingForm) {
1.556     raeburn  10141:     if (createnew == 1) {
1.570     raeburn  10142:         for (var i=0; i<callingForm.srchby.length; i++) {
                   10143:             if (callingForm.srchby.options[i].value == 'uname') {
                   10144:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  10145:             }
                   10146:         }
1.570     raeburn  10147:         for (var i=0; i<callingForm.srchin.length; i++) {
                   10148:             if ( callingForm.srchin.options[i].value == 'dom') {
                   10149: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  10150:             }
                   10151:         }
1.570     raeburn  10152:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   10153:             if (callingForm.srchtype.options[i].value == 'exact') {
                   10154:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  10155:             }
                   10156:         }
1.570     raeburn  10157:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  10158:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  10159:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  10160:             }
                   10161:         }
                   10162:     }
                   10163: }
                   10164: ENDSCRIPT
1.558     albertel 10165: 
1.556     raeburn  10166:     }
                   10167: 
1.555     raeburn  10168:     my $output = <<"END_BLOCK";
1.556     raeburn  10169: <script type="text/javascript">
1.824     bisitz   10170: // <![CDATA[
1.570     raeburn  10171: function validateEntry(callingForm) {
1.558     albertel 10172: 
1.556     raeburn  10173:     var checkok = 1;
1.558     albertel 10174:     var srchin;
1.570     raeburn  10175:     for (var i=0; i<callingForm.srchin.length; i++) {
                   10176: 	if ( callingForm.srchin[i].checked ) {
                   10177: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 10178: 	}
                   10179:     }
                   10180: 
1.570     raeburn  10181:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   10182:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   10183:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   10184:     var srchterm =  callingForm.srchterm.value;
                   10185:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  10186:     var msg = "";
                   10187: 
                   10188:     if (srchterm == "") {
                   10189:         checkok = 0;
1.1075.2.98  raeburn  10190:         msg += "$js_lt{'youm'}\\n";
1.556     raeburn  10191:     }
                   10192: 
1.569     raeburn  10193:     if (srchtype== 'begins') {
                   10194:         if (srchterm.length < 2) {
                   10195:             checkok = 0;
1.1075.2.98  raeburn  10196:             msg += "$js_lt{'thte'}\\n";
1.569     raeburn  10197:         }
                   10198:     }
                   10199: 
1.556     raeburn  10200:     if (srchtype== 'contains') {
                   10201:         if (srchterm.length < 3) {
                   10202:             checkok = 0;
1.1075.2.98  raeburn  10203:             msg += "$js_lt{'thet'}\\n";
1.556     raeburn  10204:         }
                   10205:     }
                   10206:     if (srchin == 'instd') {
                   10207:         if (srchdomain == '') {
                   10208:             checkok = 0;
1.1075.2.98  raeburn  10209:             msg += "$js_lt{'yomc'}\\n";
1.556     raeburn  10210:         }
                   10211:     }
                   10212:     if (srchin == 'dom') {
                   10213:         if (srchdomain == '') {
                   10214:             checkok = 0;
1.1075.2.98  raeburn  10215:             msg += "$js_lt{'ymcd'}\\n";
1.556     raeburn  10216:         }
                   10217:     }
                   10218:     if (srchby == 'lastfirst') {
                   10219:         if (srchterm.indexOf(",") == -1) {
                   10220:             checkok = 0;
1.1075.2.98  raeburn  10221:             msg += "$js_lt{'whus'}\\n";
1.556     raeburn  10222:         }
                   10223:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   10224:             checkok = 0;
1.1075.2.98  raeburn  10225:             msg += "$js_lt{'whse'}\\n";
1.556     raeburn  10226:         }
                   10227:     }
                   10228:     if (checkok == 0) {
1.1075.2.98  raeburn  10229:         alert("$js_lt{'thfo'}\\n"+msg);
1.556     raeburn  10230:         return;
                   10231:     }
                   10232:     if (checkok == 1) {
1.570     raeburn  10233:         callingForm.submit();
1.556     raeburn  10234:     }
                   10235: }
                   10236: 
                   10237: $newuserscript
                   10238: 
1.824     bisitz   10239: // ]]>
1.556     raeburn  10240: </script>
1.558     albertel 10241: 
                   10242: $new_user_create
                   10243: 
1.555     raeburn  10244: END_BLOCK
1.558     albertel 10245: 
1.876     raeburn  10246:     $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1075.2.98  raeburn  10247:                &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876     raeburn  10248:                $domform.
                   10249:                &Apache::lonhtmlcommon::row_closure().
1.1075.2.98  raeburn  10250:                &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876     raeburn  10251:                $srchbysel.
                   10252:                $srchtypesel. 
                   10253:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   10254:                $srchinsel.
                   10255:                &Apache::lonhtmlcommon::row_closure(1). 
                   10256:                &Apache::lonhtmlcommon::end_pick_box().
                   10257:                '<br />';
1.1075.2.114  raeburn  10258:     return ($output,1);
1.555     raeburn  10259: }
                   10260: 
1.612     raeburn  10261: sub user_rule_check {
1.615     raeburn  10262:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1075.2.99  raeburn  10263:     my ($response,%inst_response);
1.612     raeburn  10264:     if (ref($usershash) eq 'HASH') {
1.1075.2.99  raeburn  10265:         if (keys(%{$usershash}) > 1) {
                   10266:             my (%by_username,%by_id,%userdoms);
                   10267:             my $checkid;
1.612     raeburn  10268:             if (ref($checks) eq 'HASH') {
1.1075.2.99  raeburn  10269:                 if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
                   10270:                     $checkid = 1;
                   10271:                 }
                   10272:             }
                   10273:             foreach my $user (keys(%{$usershash})) {
                   10274:                 my ($uname,$udom) = split(/:/,$user);
                   10275:                 if ($checkid) {
                   10276:                     if (ref($usershash->{$user}) eq 'HASH') {
                   10277:                         if ($usershash->{$user}->{'id'} ne '') {
                   10278:                             $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
                   10279:                             $userdoms{$udom} = 1;
                   10280:                             if (ref($inst_results) eq 'HASH') {
                   10281:                                 $inst_results->{$uname.':'.$udom} = {};
                   10282:                             }
                   10283:                         }
                   10284:                     }
                   10285:                 } else {
                   10286:                     $by_username{$udom}{$uname} = 1;
                   10287:                     $userdoms{$udom} = 1;
                   10288:                     if (ref($inst_results) eq 'HASH') {
                   10289:                         $inst_results->{$uname.':'.$udom} = {};
                   10290:                     }
                   10291:                 }
                   10292:             }
                   10293:             foreach my $udom (keys(%userdoms)) {
                   10294:                 if (!$got_rules->{$udom}) {
                   10295:                     my %domconfig = &Apache::lonnet::get_dom('configuration',
                   10296:                                                              ['usercreation'],$udom);
                   10297:                     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   10298:                         foreach my $item ('username','id') {
                   10299:                             if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   10300:                                 $$curr_rules{$udom}{$item} =
                   10301:                                     $domconfig{'usercreation'}{$item.'_rule'};
                   10302:                             }
                   10303:                         }
                   10304:                     }
                   10305:                     $got_rules->{$udom} = 1;
                   10306:                 }
                   10307:             }
                   10308:             if ($checkid) {
                   10309:                 foreach my $udom (keys(%by_id)) {
                   10310:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
                   10311:                     if ($outcome eq 'ok') {
                   10312:                         foreach my $id (keys(%{$by_id{$udom}})) {
                   10313:                             my $uname = $by_id{$udom}{$id};
                   10314:                             $inst_response{$uname.':'.$udom} = $outcome;
                   10315:                         }
                   10316:                         if (ref($results) eq 'HASH') {
                   10317:                             foreach my $uname (keys(%{$results})) {
                   10318:                                 if (exists($inst_response{$uname.':'.$udom})) {
                   10319:                                     $inst_response{$uname.':'.$udom} = $outcome;
                   10320:                                     $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   10321:                                 }
                   10322:                             }
                   10323:                         }
                   10324:                     }
1.612     raeburn  10325:                 }
1.615     raeburn  10326:             } else {
1.1075.2.99  raeburn  10327:                 foreach my $udom (keys(%by_username)) {
                   10328:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
                   10329:                     if ($outcome eq 'ok') {
                   10330:                         foreach my $uname (keys(%{$by_username{$udom}})) {
                   10331:                             $inst_response{$uname.':'.$udom} = $outcome;
                   10332:                         }
                   10333:                         if (ref($results) eq 'HASH') {
                   10334:                             foreach my $uname (keys(%{$results})) {
                   10335:                                 $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   10336:                             }
                   10337:                         }
                   10338:                     }
                   10339:                 }
1.612     raeburn  10340:             }
1.1075.2.99  raeburn  10341:         } elsif (keys(%{$usershash}) == 1) {
                   10342:             my $user = (keys(%{$usershash}))[0];
                   10343:             my ($uname,$udom) = split(/:/,$user);
                   10344:             if (($udom ne '') && ($uname ne '')) {
                   10345:                 if (ref($usershash->{$user}) eq 'HASH') {
                   10346:                     if (ref($checks) eq 'HASH') {
                   10347:                         if (defined($checks->{'username'})) {
                   10348:                             ($inst_response{$user},%{$inst_results->{$user}}) =
                   10349:                                 &Apache::lonnet::get_instuser($udom,$uname);
                   10350:                         } elsif (defined($checks->{'id'})) {
                   10351:                             if ($usershash->{$user}->{'id'} ne '') {
                   10352:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   10353:                                     &Apache::lonnet::get_instuser($udom,undef,
                   10354:                                                                   $usershash->{$user}->{'id'});
                   10355:                             } else {
                   10356:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   10357:                                     &Apache::lonnet::get_instuser($udom,$uname);
                   10358:                             }
                   10359:                         }
                   10360:                     } else {
                   10361:                        ($inst_response{$user},%{$inst_results->{$user}}) =
                   10362:                             &Apache::lonnet::get_instuser($udom,$uname);
                   10363:                        return;
                   10364:                     }
                   10365:                     if (!$got_rules->{$udom}) {
                   10366:                         my %domconfig = &Apache::lonnet::get_dom('configuration',
                   10367:                                                                  ['usercreation'],$udom);
                   10368:                         if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   10369:                             foreach my $item ('username','id') {
                   10370:                                 if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   10371:                                    $$curr_rules{$udom}{$item} =
                   10372:                                        $domconfig{'usercreation'}{$item.'_rule'};
                   10373:                                 }
                   10374:                             }
1.585     raeburn  10375:                         }
1.1075.2.99  raeburn  10376:                         $got_rules->{$udom} = 1;
1.585     raeburn  10377:                     }
                   10378:                 }
1.1075.2.99  raeburn  10379:             } else {
                   10380:                 return;
                   10381:             }
                   10382:         } else {
                   10383:             return;
                   10384:         }
                   10385:         foreach my $user (keys(%{$usershash})) {
                   10386:             my ($uname,$udom) = split(/:/,$user);
                   10387:             next if (($udom eq '') || ($uname eq ''));
                   10388:             my $id;
                   10389:             if (ref($inst_results) eq 'HASH') {
                   10390:                 if (ref($inst_results->{$user}) eq 'HASH') {
                   10391:                     $id = $inst_results->{$user}->{'id'};
                   10392:                 }
                   10393:             }
                   10394:             if ($id eq '') {
                   10395:                 if (ref($usershash->{$user})) {
                   10396:                     $id = $usershash->{$user}->{'id'};
                   10397:                 }
1.585     raeburn  10398:             }
1.612     raeburn  10399:             foreach my $item (keys(%{$checks})) {
                   10400:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   10401:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   10402:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1075.2.99  raeburn  10403:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
                   10404:                                                                              $$curr_rules{$udom}{$item});
1.612     raeburn  10405:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   10406:                                 if ($rule_check{$rule}) {
                   10407:                                     $$rulematch{$user}{$item} = $rule;
1.1075.2.99  raeburn  10408:                                     if ($inst_response{$user} eq 'ok') {
1.615     raeburn  10409:                                         if (ref($inst_results) eq 'HASH') {
                   10410:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   10411:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   10412:                                                     $$alerts{$item}{$udom}{$uname} = 1;
1.1075.2.99  raeburn  10413:                                                 } elsif ($item eq 'id') {
                   10414:                                                     if ($inst_results->{$user}->{'id'} eq '') {
                   10415:                                                         $$alerts{$item}{$udom}{$uname} = 1;
                   10416:                                                     }
1.615     raeburn  10417:                                                 }
1.612     raeburn  10418:                                             }
                   10419:                                         }
1.615     raeburn  10420:                                     }
                   10421:                                     last;
1.585     raeburn  10422:                                 }
                   10423:                             }
                   10424:                         }
                   10425:                     }
                   10426:                 }
                   10427:             }
                   10428:         }
                   10429:     }
1.612     raeburn  10430:     return;
                   10431: }
                   10432: 
                   10433: sub user_rule_formats {
                   10434:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   10435:     my %text = ( 
                   10436:                  'username' => 'Usernames',
                   10437:                  'id'       => 'IDs',
                   10438:                );
                   10439:     my $output;
                   10440:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   10441:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   10442:         if (@{$ruleorder} > 0) {
1.1075.2.20  raeburn  10443:             $output = '<br />'.
                   10444:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   10445:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   10446:                       ' <ul>';
1.612     raeburn  10447:             foreach my $rule (@{$ruleorder}) {
                   10448:                 if (ref($curr_rules) eq 'ARRAY') {
                   10449:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   10450:                         if (ref($rules->{$rule}) eq 'HASH') {
                   10451:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   10452:                                         $rules->{$rule}{'desc'}.'</li>';
                   10453:                         }
                   10454:                     }
                   10455:                 }
                   10456:             }
                   10457:             $output .= '</ul>';
                   10458:         }
                   10459:     }
                   10460:     return $output;
                   10461: }
                   10462: 
                   10463: sub instrule_disallow_msg {
1.615     raeburn  10464:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  10465:     my $response;
                   10466:     my %text = (
                   10467:                   item   => 'username',
                   10468:                   items  => 'usernames',
                   10469:                   match  => 'matches',
                   10470:                   do     => 'does',
                   10471:                   action => 'a username',
                   10472:                   one    => 'one',
                   10473:                );
                   10474:     if ($count > 1) {
                   10475:         $text{'item'} = 'usernames';
                   10476:         $text{'match'} ='match';
                   10477:         $text{'do'} = 'do';
                   10478:         $text{'action'} = 'usernames',
                   10479:         $text{'one'} = 'ones';
                   10480:     }
                   10481:     if ($checkitem eq 'id') {
                   10482:         $text{'items'} = 'IDs';
                   10483:         $text{'item'} = 'ID';
                   10484:         $text{'action'} = 'an ID';
1.615     raeburn  10485:         if ($count > 1) {
                   10486:             $text{'item'} = 'IDs';
                   10487:             $text{'action'} = 'IDs';
                   10488:         }
1.612     raeburn  10489:     }
1.674     bisitz   10490:     $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  10491:     if ($mode eq 'upload') {
                   10492:         if ($checkitem eq 'username') {
                   10493:             $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'}.");
                   10494:         } elsif ($checkitem eq 'id') {
1.674     bisitz   10495:             $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  10496:         }
1.669     raeburn  10497:     } elsif ($mode eq 'selfcreate') {
                   10498:         if ($checkitem eq 'id') {
                   10499:             $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.");
                   10500:         }
1.615     raeburn  10501:     } else {
                   10502:         if ($checkitem eq 'username') {
                   10503:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   10504:         } elsif ($checkitem eq 'id') {
                   10505:             $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.");
                   10506:         }
1.612     raeburn  10507:     }
                   10508:     return $response;
1.585     raeburn  10509: }
                   10510: 
1.624     raeburn  10511: sub personal_data_fieldtitles {
                   10512:     my %fieldtitles = &Apache::lonlocal::texthash (
                   10513:                         id => 'Student/Employee ID',
                   10514:                         permanentemail => 'E-mail address',
                   10515:                         lastname => 'Last Name',
                   10516:                         firstname => 'First Name',
                   10517:                         middlename => 'Middle Name',
                   10518:                         generation => 'Generation',
                   10519:                         gen => 'Generation',
1.765     raeburn  10520:                         inststatus => 'Affiliation',
1.624     raeburn  10521:                    );
                   10522:     return %fieldtitles;
                   10523: }
                   10524: 
1.642     raeburn  10525: sub sorted_inst_types {
                   10526:     my ($dom) = @_;
1.1075.2.70  raeburn  10527:     my ($usertypes,$order);
                   10528:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   10529:     if (ref($domdefaults{'inststatus'}) eq 'HASH') {
                   10530:         $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
                   10531:         $order = $domdefaults{'inststatus'}{'inststatusorder'};
                   10532:     } else {
                   10533:         ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   10534:     }
1.642     raeburn  10535:     my $othertitle = &mt('All users');
                   10536:     if ($env{'request.course.id'}) {
1.668     raeburn  10537:         $othertitle  = &mt('Any users');
1.642     raeburn  10538:     }
                   10539:     my @types;
                   10540:     if (ref($order) eq 'ARRAY') {
                   10541:         @types = @{$order};
                   10542:     }
                   10543:     if (@types == 0) {
                   10544:         if (ref($usertypes) eq 'HASH') {
                   10545:             @types = sort(keys(%{$usertypes}));
                   10546:         }
                   10547:     }
                   10548:     if (keys(%{$usertypes}) > 0) {
                   10549:         $othertitle = &mt('Other users');
                   10550:     }
                   10551:     return ($othertitle,$usertypes,\@types);
                   10552: }
                   10553: 
1.645     raeburn  10554: sub get_institutional_codes {
1.1075.2.157  raeburn  10555:     my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_;
1.645     raeburn  10556: # Get complete list of course sections to update
                   10557:     my @currsections = ();
                   10558:     my @currxlists = ();
1.1075.2.157  raeburn  10559:     my (%unclutteredsec,%unclutteredlcsec);
1.645     raeburn  10560:     my $coursecode = $$settings{'internal.coursecode'};
1.1075.2.157  raeburn  10561:     my $crskey = $crs.':'.$coursecode;
                   10562:     @{$unclutteredsec{$crskey}} = ();
                   10563:     @{$unclutteredlcsec{$crskey}} = ();
1.645     raeburn  10564: 
                   10565:     if ($$settings{'internal.sectionnums'} ne '') {
                   10566:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   10567:     }
                   10568: 
                   10569:     if ($$settings{'internal.crosslistings'} ne '') {
                   10570:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   10571:     }
                   10572: 
                   10573:     if (@currxlists > 0) {
1.1075.2.157  raeburn  10574:         foreach my $xl (@currxlists) {
                   10575:             if ($xl =~ /^([^:]+):(\w*)$/) {
1.645     raeburn  10576:                 unless (grep/^$1$/,@{$allcourses}) {
1.1075.2.119  raeburn  10577:                     push(@{$allcourses},$1);
1.645     raeburn  10578:                     $$LC_code{$1} = $2;
                   10579:                 }
                   10580:             }
                   10581:         }
                   10582:     }
1.1075.2.157  raeburn  10583: 
1.645     raeburn  10584:     if (@currsections > 0) {
1.1075.2.157  raeburn  10585:         foreach my $sec (@currsections) {
                   10586:             if ($sec =~ m/^(\w+):(\w*)$/ ) {
                   10587:                 my $instsec = $1;
1.645     raeburn  10588:                 my $lc_sec = $2;
1.1075.2.157  raeburn  10589:                 unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) {
                   10590:                     push(@{$unclutteredsec{$crskey}},$instsec);
                   10591:                     push(@{$unclutteredlcsec{$crskey}},$lc_sec);
                   10592:                 }
                   10593:             }
                   10594:         }
                   10595:     }
                   10596: 
                   10597:     if (@{$unclutteredsec{$crskey}} > 0) {
                   10598:         my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);
                   10599:         if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {
                   10600:             for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {
                   10601:                 my $sec = $coursecode.$formattedsec{$crskey}[$i];
                   10602:                 unless (grep/^\Q$sec\E$/,@{$allcourses}) {
1.1075.2.119  raeburn  10603:                     push(@{$allcourses},$sec);
1.1075.2.157  raeburn  10604:                     $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
1.645     raeburn  10605:                 }
                   10606:             }
                   10607:         }
                   10608:     }
                   10609:     return;
                   10610: }
                   10611: 
1.971     raeburn  10612: sub get_standard_codeitems {
                   10613:     return ('Year','Semester','Department','Number','Section');
                   10614: }
                   10615: 
1.112     bowersj2 10616: =pod
                   10617: 
1.780     raeburn  10618: =head1 Slot Helpers
                   10619: 
                   10620: =over 4
                   10621: 
                   10622: =item * sorted_slots()
                   10623: 
1.1040    raeburn  10624: Sorts an array of slot names in order of an optional sort key,
                   10625: default sort is by slot start time (earliest first). 
1.780     raeburn  10626: 
                   10627: Inputs:
                   10628: 
                   10629: =over 4
                   10630: 
                   10631: slotsarr  - Reference to array of unsorted slot names.
                   10632: 
                   10633: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   10634: 
1.1040    raeburn  10635: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   10636: 
1.549     albertel 10637: =back
                   10638: 
1.780     raeburn  10639: Returns:
                   10640: 
                   10641: =over 4
                   10642: 
1.1040    raeburn  10643: sorted   - An array of slot names sorted by a specified sort key 
                   10644:            (default sort key is start time of the slot).
1.780     raeburn  10645: 
                   10646: =back
                   10647: 
                   10648: =cut
                   10649: 
                   10650: 
                   10651: sub sorted_slots {
1.1040    raeburn  10652:     my ($slotsarr,$slots,$sortkey) = @_;
                   10653:     if ($sortkey eq '') {
                   10654:         $sortkey = 'starttime';
                   10655:     }
1.780     raeburn  10656:     my @sorted;
                   10657:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   10658:         @sorted =
                   10659:             sort {
                   10660:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  10661:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  10662:                      }
                   10663:                      if (ref($slots->{$a})) { return -1;}
                   10664:                      if (ref($slots->{$b})) { return 1;}
                   10665:                      return 0;
                   10666:                  } @{$slotsarr};
                   10667:     }
                   10668:     return @sorted;
                   10669: }
                   10670: 
1.1040    raeburn  10671: =pod
                   10672: 
                   10673: =item * get_future_slots()
                   10674: 
                   10675: Inputs:
                   10676: 
                   10677: =over 4
                   10678: 
                   10679: cnum - course number
                   10680: 
                   10681: cdom - course domain
                   10682: 
                   10683: now - current UNIX time
                   10684: 
                   10685: symb - optional symb
                   10686: 
                   10687: =back
                   10688: 
                   10689: Returns:
                   10690: 
                   10691: =over 4
                   10692: 
                   10693: sorted_reservable - ref to array of student_schedulable slots currently 
                   10694:                     reservable, ordered by end date of reservation period.
                   10695: 
                   10696: reservable_now - ref to hash of student_schedulable slots currently
                   10697:                  reservable.
                   10698: 
                   10699:     Keys in inner hash are:
                   10700:     (a) symb: either blank or symb to which slot use is restricted.
1.1075.2.104  raeburn  10701:     (b) endreserve: end date of reservation period.
                   10702:     (c) uniqueperiod: start,end dates when slot is to be uniquely
                   10703:         selected.
1.1040    raeburn  10704: 
                   10705: sorted_future - ref to array of student_schedulable slots reservable in
                   10706:                 the future, ordered by start date of reservation period.
                   10707: 
                   10708: future_reservable - ref to hash of student_schedulable slots reservable
                   10709:                     in the future.
                   10710: 
                   10711:     Keys in inner hash are:
                   10712:     (a) symb: either blank or symb to which slot use is restricted.
                   10713:     (b) startreserve:  start date of reservation period.
1.1075.2.104  raeburn  10714:     (c) uniqueperiod: start,end dates when slot is to be uniquely
                   10715:         selected.
1.1040    raeburn  10716: 
                   10717: =back
                   10718: 
                   10719: =cut
                   10720: 
                   10721: sub get_future_slots {
                   10722:     my ($cnum,$cdom,$now,$symb) = @_;
                   10723:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   10724:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   10725:     foreach my $slot (keys(%slots)) {
                   10726:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   10727:         if ($symb) {
                   10728:             next if (($slots{$slot}->{'symb'} ne '') && 
                   10729:                      ($slots{$slot}->{'symb'} ne $symb));
                   10730:         }
                   10731:         if (($slots{$slot}->{'starttime'} > $now) &&
                   10732:             ($slots{$slot}->{'endtime'} > $now)) {
                   10733:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   10734:                 my $userallowed = 0;
                   10735:                 if ($slots{$slot}->{'allowedsections'}) {
                   10736:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   10737:                     if (!defined($env{'request.role.sec'})
                   10738:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   10739:                         $userallowed=1;
                   10740:                     } else {
                   10741:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   10742:                             $userallowed=1;
                   10743:                         }
                   10744:                     }
                   10745:                     unless ($userallowed) {
                   10746:                         if (defined($env{'request.course.groups'})) {
                   10747:                             my @groups = split(/:/,$env{'request.course.groups'});
                   10748:                             foreach my $group (@groups) {
                   10749:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   10750:                                     $userallowed=1;
                   10751:                                     last;
                   10752:                                 }
                   10753:                             }
                   10754:                         }
                   10755:                     }
                   10756:                 }
                   10757:                 if ($slots{$slot}->{'allowedusers'}) {
                   10758:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   10759:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   10760:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   10761:                         $userallowed = 1;
                   10762:                     }
                   10763:                 }
                   10764:                 next unless($userallowed);
                   10765:             }
                   10766:             my $startreserve = $slots{$slot}->{'startreserve'};
                   10767:             my $endreserve = $slots{$slot}->{'endreserve'};
                   10768:             my $symb = $slots{$slot}->{'symb'};
1.1075.2.104  raeburn  10769:             my $uniqueperiod;
                   10770:             if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
                   10771:                 $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
                   10772:             }
1.1040    raeburn  10773:             if (($startreserve < $now) &&
                   10774:                 (!$endreserve || $endreserve > $now)) {
                   10775:                 my $lastres = $endreserve;
                   10776:                 if (!$lastres) {
                   10777:                     $lastres = $slots{$slot}->{'starttime'};
                   10778:                 }
                   10779:                 $reservable_now{$slot} = {
                   10780:                                            symb       => $symb,
1.1075.2.104  raeburn  10781:                                            endreserve => $lastres,
                   10782:                                            uniqueperiod => $uniqueperiod,   
1.1040    raeburn  10783:                                          };
                   10784:             } elsif (($startreserve > $now) &&
                   10785:                      (!$endreserve || $endreserve > $startreserve)) {
                   10786:                 $future_reservable{$slot} = {
                   10787:                                               symb         => $symb,
1.1075.2.104  raeburn  10788:                                               startreserve => $startreserve,
                   10789:                                               uniqueperiod => $uniqueperiod,
1.1040    raeburn  10790:                                             };
                   10791:             }
                   10792:         }
                   10793:     }
                   10794:     my @unsorted_reservable = keys(%reservable_now);
                   10795:     if (@unsorted_reservable > 0) {
                   10796:         @sorted_reservable = 
                   10797:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   10798:     }
                   10799:     my @unsorted_future = keys(%future_reservable);
                   10800:     if (@unsorted_future > 0) {
                   10801:         @sorted_future =
                   10802:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   10803:     }
                   10804:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   10805: }
1.780     raeburn  10806: 
                   10807: =pod
                   10808: 
1.1057    foxr     10809: =back
                   10810: 
1.549     albertel 10811: =head1 HTTP Helpers
                   10812: 
                   10813: =over 4
                   10814: 
1.648     raeburn  10815: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 10816: 
1.258     albertel 10817: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 10818: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 10819: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 10820: 
                   10821: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   10822: $possible_names is an ref to an array of form element names.  As an example:
                   10823: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 10824: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 10825: 
                   10826: =cut
1.1       albertel 10827: 
1.6       albertel 10828: sub get_unprocessed_cgi {
1.25      albertel 10829:   my ($query,$possible_names)= @_;
1.26      matthew  10830:   # $Apache::lonxml::debug=1;
1.356     albertel 10831:   foreach my $pair (split(/&/,$query)) {
                   10832:     my ($name, $value) = split(/=/,$pair);
1.369     www      10833:     $name = &unescape($name);
1.25      albertel 10834:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   10835:       $value =~ tr/+/ /;
                   10836:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 10837:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 10838:     }
1.16      harris41 10839:   }
1.6       albertel 10840: }
                   10841: 
1.112     bowersj2 10842: =pod
                   10843: 
1.648     raeburn  10844: =item * &cacheheader() 
1.112     bowersj2 10845: 
                   10846: returns cache-controlling header code
                   10847: 
                   10848: =cut
                   10849: 
1.7       albertel 10850: sub cacheheader {
1.258     albertel 10851:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 10852:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   10853:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 10854:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   10855:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 10856:     return $output;
1.7       albertel 10857: }
                   10858: 
1.112     bowersj2 10859: =pod
                   10860: 
1.648     raeburn  10861: =item * &no_cache($r) 
1.112     bowersj2 10862: 
                   10863: specifies header code to not have cache
                   10864: 
                   10865: =cut
                   10866: 
1.9       albertel 10867: sub no_cache {
1.216     albertel 10868:     my ($r) = @_;
                   10869:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 10870: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 10871:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   10872:     $r->no_cache(1);
                   10873:     $r->header_out("Expires" => $date);
                   10874:     $r->header_out("Pragma" => "no-cache");
1.123     www      10875: }
                   10876: 
                   10877: sub content_type {
1.181     albertel 10878:     my ($r,$type,$charset) = @_;
1.299     foxr     10879:     if ($r) {
                   10880: 	#  Note that printout.pl calls this with undef for $r.
                   10881: 	&no_cache($r);
                   10882:     }
1.258     albertel 10883:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 10884:     unless ($charset) {
                   10885: 	$charset=&Apache::lonlocal::current_encoding;
                   10886:     }
                   10887:     if ($charset) { $type.='; charset='.$charset; }
                   10888:     if ($r) {
                   10889: 	$r->content_type($type);
                   10890:     } else {
                   10891: 	print("Content-type: $type\n\n");
                   10892:     }
1.9       albertel 10893: }
1.25      albertel 10894: 
1.112     bowersj2 10895: =pod
                   10896: 
1.648     raeburn  10897: =item * &add_to_env($name,$value) 
1.112     bowersj2 10898: 
1.258     albertel 10899: adds $name to the %env hash with value
1.112     bowersj2 10900: $value, if $name already exists, the entry is converted to an array
                   10901: reference and $value is added to the array.
                   10902: 
                   10903: =cut
                   10904: 
1.25      albertel 10905: sub add_to_env {
                   10906:   my ($name,$value)=@_;
1.258     albertel 10907:   if (defined($env{$name})) {
                   10908:     if (ref($env{$name})) {
1.25      albertel 10909:       #already have multiple values
1.258     albertel 10910:       push(@{ $env{$name} },$value);
1.25      albertel 10911:     } else {
                   10912:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 10913:       my $first=$env{$name};
                   10914:       undef($env{$name});
                   10915:       push(@{ $env{$name} },$first,$value);
1.25      albertel 10916:     }
                   10917:   } else {
1.258     albertel 10918:     $env{$name}=$value;
1.25      albertel 10919:   }
1.31      albertel 10920: }
1.149     albertel 10921: 
                   10922: =pod
                   10923: 
1.648     raeburn  10924: =item * &get_env_multiple($name) 
1.149     albertel 10925: 
1.258     albertel 10926: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 10927: values may be defined and end up as an array ref.
                   10928: 
                   10929: returns an array of values
                   10930: 
                   10931: =cut
                   10932: 
                   10933: sub get_env_multiple {
                   10934:     my ($name) = @_;
                   10935:     my @values;
1.258     albertel 10936:     if (defined($env{$name})) {
1.149     albertel 10937:         # exists is it an array
1.258     albertel 10938:         if (ref($env{$name})) {
                   10939:             @values=@{ $env{$name} };
1.149     albertel 10940:         } else {
1.258     albertel 10941:             $values[0]=$env{$name};
1.149     albertel 10942:         }
                   10943:     }
                   10944:     return(@values);
                   10945: }
                   10946: 
1.660     raeburn  10947: sub ask_for_embedded_content {
                   10948:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  10949:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11  raeburn  10950:         %currsubfile,%unused,$rem);
1.1071    raeburn  10951:     my $counter = 0;
                   10952:     my $numnew = 0;
1.987     raeburn  10953:     my $numremref = 0;
                   10954:     my $numinvalid = 0;
                   10955:     my $numpathchg = 0;
                   10956:     my $numexisting = 0;
1.1071    raeburn  10957:     my $numunused = 0;
                   10958:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53  raeburn  10959:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  10960:     my $heading = &mt('Upload embedded files');
                   10961:     my $buttontext = &mt('Upload');
                   10962: 
1.1075.2.11  raeburn  10963:     if ($env{'request.course.id'}) {
1.1075.2.35  raeburn  10964:         if ($actionurl eq '/adm/dependencies') {
                   10965:             $navmap = Apache::lonnavmaps::navmap->new();
                   10966:         }
                   10967:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   10968:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11  raeburn  10969:     }
1.1075.2.35  raeburn  10970:     if (($actionurl eq '/adm/portfolio') ||
                   10971:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  10972:         my $current_path='/';
                   10973:         if ($env{'form.currentpath'}) {
                   10974:             $current_path = $env{'form.currentpath'};
                   10975:         }
                   10976:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35  raeburn  10977:             $udom = $cdom;
                   10978:             $uname = $cnum;
1.984     raeburn  10979:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   10980:         } else {
                   10981:             $udom = $env{'user.domain'};
                   10982:             $uname = $env{'user.name'};
                   10983:             $url = '/userfiles/portfolio';
                   10984:         }
1.987     raeburn  10985:         $toplevel = $url.'/';
1.984     raeburn  10986:         $url .= $current_path;
                   10987:         $getpropath = 1;
1.987     raeburn  10988:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   10989:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      10990:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  10991:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  10992:         $toplevel = $url;
1.984     raeburn  10993:         if ($rest ne '') {
1.987     raeburn  10994:             $url .= $rest;
                   10995:         }
                   10996:     } elsif ($actionurl eq '/adm/coursedocs') {
                   10997:         if (ref($args) eq 'HASH') {
1.1071    raeburn  10998:             $url = $args->{'docs_url'};
                   10999:             $toplevel = $url;
1.1075.2.11  raeburn  11000:             if ($args->{'context'} eq 'paste') {
                   11001:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   11002:                 ($path) =
                   11003:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   11004:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   11005:                 $fileloc =~ s{^/}{};
                   11006:             }
1.1071    raeburn  11007:         }
                   11008:     } elsif ($actionurl eq '/adm/dependencies') {
                   11009:         if ($env{'request.course.id'} ne '') {
                   11010:             if (ref($args) eq 'HASH') {
                   11011:                 $url = $args->{'docs_url'};
                   11012:                 $title = $args->{'docs_title'};
1.1075.2.35  raeburn  11013:                 $toplevel = $url;
                   11014:                 unless ($toplevel =~ m{^/}) {
                   11015:                     $toplevel = "/$url";
                   11016:                 }
1.1075.2.11  raeburn  11017:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35  raeburn  11018:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   11019:                     $path = $1;
                   11020:                 } else {
                   11021:                     ($path) =
                   11022:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   11023:                 }
1.1075.2.79  raeburn  11024:                 if ($toplevel=~/^\/*(uploaded|editupload)/) {
                   11025:                     $fileloc = $toplevel;
                   11026:                     $fileloc=~ s/^\s*(\S+)\s*$/$1/;
                   11027:                     my ($udom,$uname,$fname) =
                   11028:                         ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
                   11029:                     $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
                   11030:                 } else {
                   11031:                     $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   11032:                 }
1.1071    raeburn  11033:                 $fileloc =~ s{^/}{};
                   11034:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   11035:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   11036:             }
1.987     raeburn  11037:         }
1.1075.2.35  raeburn  11038:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   11039:         $udom = $cdom;
                   11040:         $uname = $cnum;
                   11041:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   11042:         $toplevel = $url;
                   11043:         $path = $url;
                   11044:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   11045:         $fileloc =~ s{^/}{};
                   11046:     }
                   11047:     foreach my $file (keys(%{$allfiles})) {
                   11048:         my $embed_file;
                   11049:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   11050:             $embed_file = $1;
                   11051:         } else {
                   11052:             $embed_file = $file;
                   11053:         }
1.1075.2.55  raeburn  11054:         my ($absolutepath,$cleaned_file);
                   11055:         if ($embed_file =~ m{^\w+://}) {
                   11056:             $cleaned_file = $embed_file;
1.1075.2.47  raeburn  11057:             $newfiles{$cleaned_file} = 1;
                   11058:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  11059:         } else {
1.1075.2.55  raeburn  11060:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  11061:             if ($embed_file =~ m{^/}) {
                   11062:                 $absolutepath = $embed_file;
                   11063:             }
1.1075.2.47  raeburn  11064:             if ($cleaned_file =~ m{/}) {
                   11065:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  11066:                 $path = &check_for_traversal($path,$url,$toplevel);
                   11067:                 my $item = $fname;
                   11068:                 if ($path ne '') {
                   11069:                     $item = $path.'/'.$fname;
                   11070:                     $subdependencies{$path}{$fname} = 1;
                   11071:                 } else {
                   11072:                     $dependencies{$item} = 1;
                   11073:                 }
                   11074:                 if ($absolutepath) {
                   11075:                     $mapping{$item} = $absolutepath;
                   11076:                 } else {
                   11077:                     $mapping{$item} = $embed_file;
                   11078:                 }
                   11079:             } else {
                   11080:                 $dependencies{$embed_file} = 1;
                   11081:                 if ($absolutepath) {
1.1075.2.47  raeburn  11082:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  11083:                 } else {
1.1075.2.47  raeburn  11084:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  11085:                 }
                   11086:             }
1.984     raeburn  11087:         }
                   11088:     }
1.1071    raeburn  11089:     my $dirptr = 16384;
1.984     raeburn  11090:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  11091:         $currsubfile{$path} = {};
1.1075.2.35  raeburn  11092:         if (($actionurl eq '/adm/portfolio') ||
                   11093:             ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  11094:             my ($sublistref,$listerror) =
                   11095:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   11096:             if (ref($sublistref) eq 'ARRAY') {
                   11097:                 foreach my $line (@{$sublistref}) {
                   11098:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  11099:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  11100:                 }
1.984     raeburn  11101:             }
1.987     raeburn  11102:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  11103:             if (opendir(my $dir,$url.'/'.$path)) {
                   11104:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  11105:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   11106:             }
1.1075.2.11  raeburn  11107:         } elsif (($actionurl eq '/adm/dependencies') ||
                   11108:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  11109:                   ($args->{'context'} eq 'paste')) ||
                   11110:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  11111:             if ($env{'request.course.id'} ne '') {
1.1075.2.35  raeburn  11112:                 my $dir;
                   11113:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   11114:                     $dir = $fileloc;
                   11115:                 } else {
                   11116:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   11117:                 }
1.1071    raeburn  11118:                 if ($dir ne '') {
                   11119:                     my ($sublistref,$listerror) =
                   11120:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   11121:                     if (ref($sublistref) eq 'ARRAY') {
                   11122:                         foreach my $line (@{$sublistref}) {
                   11123:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   11124:                                 undef,$mtime)=split(/\&/,$line,12);
                   11125:                             unless (($testdir&$dirptr) ||
                   11126:                                     ($file_name =~ /^\.\.?$/)) {
                   11127:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   11128:                             }
                   11129:                         }
                   11130:                     }
                   11131:                 }
1.984     raeburn  11132:             }
                   11133:         }
                   11134:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  11135:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  11136:                 my $item = $path.'/'.$file;
                   11137:                 unless ($mapping{$item} eq $item) {
                   11138:                     $pathchanges{$item} = 1;
                   11139:                 }
                   11140:                 $existing{$item} = 1;
                   11141:                 $numexisting ++;
                   11142:             } else {
                   11143:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  11144:             }
                   11145:         }
1.1071    raeburn  11146:         if ($actionurl eq '/adm/dependencies') {
                   11147:             foreach my $path (keys(%currsubfile)) {
                   11148:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   11149:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   11150:                          unless ($subdependencies{$path}{$file}) {
1.1075.2.11  raeburn  11151:                              next if (($rem ne '') &&
                   11152:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   11153:                                        (ref($navmap) &&
                   11154:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   11155:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   11156:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  11157:                              $unused{$path.'/'.$file} = 1; 
                   11158:                          }
                   11159:                     }
                   11160:                 }
                   11161:             }
                   11162:         }
1.984     raeburn  11163:     }
1.987     raeburn  11164:     my %currfile;
1.1075.2.35  raeburn  11165:     if (($actionurl eq '/adm/portfolio') ||
                   11166:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  11167:         my ($dirlistref,$listerror) =
                   11168:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   11169:         if (ref($dirlistref) eq 'ARRAY') {
                   11170:             foreach my $line (@{$dirlistref}) {
                   11171:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   11172:                 $currfile{$file_name} = 1;
                   11173:             }
1.984     raeburn  11174:         }
1.987     raeburn  11175:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  11176:         if (opendir(my $dir,$url)) {
1.987     raeburn  11177:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  11178:             map {$currfile{$_} = 1;} @dir_list;
                   11179:         }
1.1075.2.11  raeburn  11180:     } elsif (($actionurl eq '/adm/dependencies') ||
                   11181:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  11182:               ($args->{'context'} eq 'paste')) ||
                   11183:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  11184:         if ($env{'request.course.id'} ne '') {
                   11185:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   11186:             if ($dir ne '') {
                   11187:                 my ($dirlistref,$listerror) =
                   11188:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   11189:                 if (ref($dirlistref) eq 'ARRAY') {
                   11190:                     foreach my $line (@{$dirlistref}) {
                   11191:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   11192:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   11193:                         unless (($testdir&$dirptr) ||
                   11194:                                 ($file_name =~ /^\.\.?$/)) {
                   11195:                             $currfile{$file_name} = [$size,$mtime];
                   11196:                         }
                   11197:                     }
                   11198:                 }
                   11199:             }
                   11200:         }
1.984     raeburn  11201:     }
                   11202:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  11203:         if (exists($currfile{$file})) {
1.987     raeburn  11204:             unless ($mapping{$file} eq $file) {
                   11205:                 $pathchanges{$file} = 1;
                   11206:             }
                   11207:             $existing{$file} = 1;
                   11208:             $numexisting ++;
                   11209:         } else {
1.984     raeburn  11210:             $newfiles{$file} = 1;
                   11211:         }
                   11212:     }
1.1071    raeburn  11213:     foreach my $file (keys(%currfile)) {
                   11214:         unless (($file eq $filename) ||
                   11215:                 ($file eq $filename.'.bak') ||
                   11216:                 ($dependencies{$file})) {
1.1075.2.11  raeburn  11217:             if ($actionurl eq '/adm/dependencies') {
1.1075.2.35  raeburn  11218:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   11219:                     next if (($rem ne '') &&
                   11220:                              (($env{"httpref.$rem".$file} ne '') ||
                   11221:                               (ref($navmap) &&
                   11222:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   11223:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   11224:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   11225:                 }
1.1075.2.11  raeburn  11226:             }
1.1071    raeburn  11227:             $unused{$file} = 1;
                   11228:         }
                   11229:     }
1.1075.2.11  raeburn  11230:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   11231:         ($args->{'context'} eq 'paste')) {
                   11232:         $counter = scalar(keys(%existing));
                   11233:         $numpathchg = scalar(keys(%pathchanges));
                   11234:         return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35  raeburn  11235:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
                   11236:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   11237:         $counter = scalar(keys(%existing));
                   11238:         $numpathchg = scalar(keys(%pathchanges));
                   11239:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11  raeburn  11240:     }
1.984     raeburn  11241:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  11242:         if ($actionurl eq '/adm/dependencies') {
                   11243:             next if ($embed_file =~ m{^\w+://});
                   11244:         }
1.660     raeburn  11245:         $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  11246:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  11247:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  11248:         unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35  raeburn  11249:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   11250:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  11251:         }
1.1075.2.35  raeburn  11252:         $upload_output .= '</td>';
1.1071    raeburn  11253:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1075.2.35  raeburn  11254:             $upload_output.='<td align="right">'.
                   11255:                             '<span class="LC_info LC_fontsize_medium">'.
                   11256:                             &mt("URL points to web address").'</span>';
1.987     raeburn  11257:             $numremref++;
1.660     raeburn  11258:         } elsif ($args->{'error_on_invalid_names'}
                   11259:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35  raeburn  11260:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   11261:                             &mt('Invalid characters').'</span>';
1.987     raeburn  11262:             $numinvalid++;
1.660     raeburn  11263:         } else {
1.1075.2.35  raeburn  11264:             $upload_output .= '<td>'.
                   11265:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  11266:                                                      $embed_file,\%mapping,
1.1071    raeburn  11267:                                                      $allfiles,$codebase,'upload');
                   11268:             $counter ++;
                   11269:             $numnew ++;
1.987     raeburn  11270:         }
                   11271:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   11272:     }
                   11273:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  11274:         if ($actionurl eq '/adm/dependencies') {
                   11275:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   11276:             $modify_output .= &start_data_table_row().
                   11277:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   11278:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   11279:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   11280:                               '<td>'.$size.'</td>'.
                   11281:                               '<td>'.$mtime.'</td>'.
                   11282:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   11283:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   11284:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   11285:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   11286:                               &embedded_file_element('upload_embedded',$counter,
                   11287:                                                      $embed_file,\%mapping,
                   11288:                                                      $allfiles,$codebase,'modify').
                   11289:                               '</div></td>'.
                   11290:                               &end_data_table_row()."\n";
                   11291:             $counter ++;
                   11292:         } else {
                   11293:             $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  11294:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   11295:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   11296:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  11297:                               &Apache::loncommon::end_data_table_row()."\n";
                   11298:         }
                   11299:     }
                   11300:     my $delidx = $counter;
                   11301:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   11302:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   11303:         $delete_output .= &start_data_table_row().
                   11304:                           '<td><img src="'.&icon($oldfile).'" />'.
                   11305:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   11306:                           '<td>'.$size.'</td>'.
                   11307:                           '<td>'.$mtime.'</td>'.
                   11308:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   11309:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   11310:                           &embedded_file_element('upload_embedded',$delidx,
                   11311:                                                  $oldfile,\%mapping,$allfiles,
                   11312:                                                  $codebase,'delete').'</td>'.
                   11313:                           &end_data_table_row()."\n"; 
                   11314:         $numunused ++;
                   11315:         $delidx ++;
1.987     raeburn  11316:     }
                   11317:     if ($upload_output) {
                   11318:         $upload_output = &start_data_table().
                   11319:                          $upload_output.
                   11320:                          &end_data_table()."\n";
                   11321:     }
1.1071    raeburn  11322:     if ($modify_output) {
                   11323:         $modify_output = &start_data_table().
                   11324:                          &start_data_table_header_row().
                   11325:                          '<th>'.&mt('File').'</th>'.
                   11326:                          '<th>'.&mt('Size (KB)').'</th>'.
                   11327:                          '<th>'.&mt('Modified').'</th>'.
                   11328:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   11329:                          &end_data_table_header_row().
                   11330:                          $modify_output.
                   11331:                          &end_data_table()."\n";
                   11332:     }
                   11333:     if ($delete_output) {
                   11334:         $delete_output = &start_data_table().
                   11335:                          &start_data_table_header_row().
                   11336:                          '<th>'.&mt('File').'</th>'.
                   11337:                          '<th>'.&mt('Size (KB)').'</th>'.
                   11338:                          '<th>'.&mt('Modified').'</th>'.
                   11339:                          '<th>'.&mt('Delete?').'</th>'.
                   11340:                          &end_data_table_header_row().
                   11341:                          $delete_output.
                   11342:                          &end_data_table()."\n";
                   11343:     }
1.987     raeburn  11344:     my $applies = 0;
                   11345:     if ($numremref) {
                   11346:         $applies ++;
                   11347:     }
                   11348:     if ($numinvalid) {
                   11349:         $applies ++;
                   11350:     }
                   11351:     if ($numexisting) {
                   11352:         $applies ++;
                   11353:     }
1.1071    raeburn  11354:     if ($counter || $numunused) {
1.987     raeburn  11355:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   11356:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  11357:                   $state.'<h3>'.$heading.'</h3>'; 
                   11358:         if ($actionurl eq '/adm/dependencies') {
                   11359:             if ($numnew) {
                   11360:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   11361:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   11362:                            $upload_output.'<br />'."\n";
                   11363:             }
                   11364:             if ($numexisting) {
                   11365:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   11366:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   11367:                            $modify_output.'<br />'."\n";
                   11368:                            $buttontext = &mt('Save changes');
                   11369:             }
                   11370:             if ($numunused) {
                   11371:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   11372:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   11373:                            $delete_output.'<br />'."\n";
                   11374:                            $buttontext = &mt('Save changes');
                   11375:             }
                   11376:         } else {
                   11377:             $output .= $upload_output.'<br />'."\n";
                   11378:         }
                   11379:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   11380:                    $counter.'" />'."\n";
                   11381:         if ($actionurl eq '/adm/dependencies') { 
                   11382:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   11383:                        $numnew.'" />'."\n";
                   11384:         } elsif ($actionurl eq '') {
1.987     raeburn  11385:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   11386:         }
                   11387:     } elsif ($applies) {
                   11388:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   11389:         if ($applies > 1) {
                   11390:             $output .=  
1.1075.2.35  raeburn  11391:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  11392:             if ($numremref) {
                   11393:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   11394:             }
                   11395:             if ($numinvalid) {
                   11396:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   11397:             }
                   11398:             if ($numexisting) {
                   11399:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   11400:             }
                   11401:             $output .= '</ul><br />';
                   11402:         } elsif ($numremref) {
                   11403:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   11404:         } elsif ($numinvalid) {
                   11405:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   11406:         } elsif ($numexisting) {
                   11407:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   11408:         }
                   11409:         $output .= $upload_output.'<br />';
                   11410:     }
                   11411:     my ($pathchange_output,$chgcount);
1.1071    raeburn  11412:     $chgcount = $counter;
1.987     raeburn  11413:     if (keys(%pathchanges) > 0) {
                   11414:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  11415:             if ($counter) {
1.987     raeburn  11416:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   11417:                                                   $embed_file,\%mapping,
1.1071    raeburn  11418:                                                   $allfiles,$codebase,'change');
1.987     raeburn  11419:             } else {
                   11420:                 $pathchange_output .= 
                   11421:                     &start_data_table_row().
                   11422:                     '<td><input type ="checkbox" name="namechange" value="'.
                   11423:                     $chgcount.'" checked="checked" /></td>'.
                   11424:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   11425:                     '<td>'.$embed_file.
                   11426:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  11427:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  11428:                     '</td>'.&end_data_table_row();
1.660     raeburn  11429:             }
1.987     raeburn  11430:             $numpathchg ++;
                   11431:             $chgcount ++;
1.660     raeburn  11432:         }
                   11433:     }
1.1075.2.35  raeburn  11434:     if (($counter) || ($numunused)) {
1.987     raeburn  11435:         if ($numpathchg) {
                   11436:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   11437:                        $numpathchg.'" />'."\n";
                   11438:         }
                   11439:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   11440:             ($actionurl eq '/adm/imsimport')) {
                   11441:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   11442:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   11443:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  11444:         } elsif ($actionurl eq '/adm/dependencies') {
                   11445:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  11446:         }
1.1075.2.35  raeburn  11447:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  11448:     } elsif ($numpathchg) {
                   11449:         my %pathchange = ();
                   11450:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   11451:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   11452:             $output .= '<p>'.&mt('or').'</p>'; 
1.1075.2.35  raeburn  11453:         }
1.987     raeburn  11454:     }
1.1071    raeburn  11455:     return ($output,$counter,$numpathchg);
1.987     raeburn  11456: }
                   11457: 
1.1075.2.47  raeburn  11458: =pod
                   11459: 
                   11460: =item * clean_path($name)
                   11461: 
                   11462: Performs clean-up of directories, subdirectories and filename in an
                   11463: embedded object, referenced in an HTML file which is being uploaded
                   11464: to a course or portfolio, where
                   11465: "Upload embedded images/multimedia files if HTML file" checkbox was
                   11466: checked.
                   11467: 
                   11468: Clean-up is similar to replacements in lonnet::clean_filename()
                   11469: except each / between sub-directory and next level is preserved.
                   11470: 
                   11471: =cut
                   11472: 
                   11473: sub clean_path {
                   11474:     my ($embed_file) = @_;
                   11475:     $embed_file =~s{^/+}{};
                   11476:     my @contents;
                   11477:     if ($embed_file =~ m{/}) {
                   11478:         @contents = split(/\//,$embed_file);
                   11479:     } else {
                   11480:         @contents = ($embed_file);
                   11481:     }
                   11482:     my $lastidx = scalar(@contents)-1;
                   11483:     for (my $i=0; $i<=$lastidx; $i++) {
                   11484:         $contents[$i]=~s{\\}{/}g;
                   11485:         $contents[$i]=~s/\s+/\_/g;
                   11486:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   11487:         if ($i == $lastidx) {
                   11488:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   11489:         }
                   11490:     }
                   11491:     if ($lastidx > 0) {
                   11492:         return join('/',@contents);
                   11493:     } else {
                   11494:         return $contents[0];
                   11495:     }
                   11496: }
                   11497: 
1.987     raeburn  11498: sub embedded_file_element {
1.1071    raeburn  11499:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  11500:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   11501:                    (ref($codebase) eq 'HASH'));
                   11502:     my $output;
1.1071    raeburn  11503:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  11504:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   11505:     }
                   11506:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   11507:                &escape($embed_file).'" />';
                   11508:     unless (($context eq 'upload_embedded') && 
                   11509:             ($mapping->{$embed_file} eq $embed_file)) {
                   11510:         $output .='
                   11511:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   11512:     }
                   11513:     my $attrib;
                   11514:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   11515:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   11516:     }
                   11517:     $output .=
                   11518:         "\n\t\t".
                   11519:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   11520:         $attrib.'" />';
                   11521:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   11522:         $output .=
                   11523:             "\n\t\t".
                   11524:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   11525:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  11526:     }
1.987     raeburn  11527:     return $output;
1.660     raeburn  11528: }
                   11529: 
1.1071    raeburn  11530: sub get_dependency_details {
                   11531:     my ($currfile,$currsubfile,$embed_file) = @_;
                   11532:     my ($size,$mtime,$showsize,$showmtime);
                   11533:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   11534:         if ($embed_file =~ m{/}) {
                   11535:             my ($path,$fname) = split(/\//,$embed_file);
                   11536:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   11537:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   11538:             }
                   11539:         } else {
                   11540:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   11541:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   11542:             }
                   11543:         }
                   11544:         $showsize = $size/1024.0;
                   11545:         $showsize = sprintf("%.1f",$showsize);
                   11546:         if ($mtime > 0) {
                   11547:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   11548:         }
                   11549:     }
                   11550:     return ($showsize,$showmtime);
                   11551: }
                   11552: 
                   11553: sub ask_embedded_js {
                   11554:     return <<"END";
                   11555: <script type="text/javascript"">
                   11556: // <![CDATA[
                   11557: function toggleBrowse(counter) {
                   11558:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   11559:     var fileid = document.getElementById('embedded_item_'+counter);
                   11560:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   11561:     if (chkboxid.checked == true) {
                   11562:         uploaddivid.style.display='block';
                   11563:     } else {
                   11564:         uploaddivid.style.display='none';
                   11565:         fileid.value = '';
                   11566:     }
                   11567: }
                   11568: // ]]>
                   11569: </script>
                   11570: 
                   11571: END
                   11572: }
                   11573: 
1.661     raeburn  11574: sub upload_embedded {
                   11575:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  11576:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   11577:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  11578:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   11579:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   11580:         my $orig_uploaded_filename =
                   11581:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  11582:         foreach my $type ('orig','ref','attrib','codebase') {
                   11583:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   11584:                 $env{'form.embedded_'.$type.'_'.$i} =
                   11585:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   11586:             }
                   11587:         }
1.661     raeburn  11588:         my ($path,$fname) =
                   11589:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   11590:         # no path, whole string is fname
                   11591:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   11592:         $fname = &Apache::lonnet::clean_filename($fname);
                   11593:         # See if there is anything left
                   11594:         next if ($fname eq '');
                   11595: 
                   11596:         # Check if file already exists as a file or directory.
                   11597:         my ($state,$msg);
                   11598:         if ($context eq 'portfolio') {
                   11599:             my $port_path = $dirpath;
                   11600:             if ($group ne '') {
                   11601:                 $port_path = "groups/$group/$port_path";
                   11602:             }
1.987     raeburn  11603:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   11604:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  11605:                                               $dir_root,$port_path,$disk_quota,
                   11606:                                               $current_disk_usage,$uname,$udom);
                   11607:             if ($state eq 'will_exceed_quota'
1.984     raeburn  11608:                 || $state eq 'file_locked') {
1.661     raeburn  11609:                 $output .= $msg;
                   11610:                 next;
                   11611:             }
                   11612:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   11613:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   11614:             if ($state eq 'exists') {
                   11615:                 $output .= $msg;
                   11616:                 next;
                   11617:             }
                   11618:         }
                   11619:         # Check if extension is valid
                   11620:         if (($fname =~ /\.(\w+)$/) &&
                   11621:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53  raeburn  11622:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   11623:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  11624:             next;
                   11625:         } elsif (($fname =~ /\.(\w+)$/) &&
                   11626:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  11627:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  11628:             next;
                   11629:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34  raeburn  11630:             $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  11631:             next;
                   11632:         }
                   11633:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35  raeburn  11634:         my $subdir = $path;
                   11635:         $subdir =~ s{/+$}{};
1.661     raeburn  11636:         if ($context eq 'portfolio') {
1.984     raeburn  11637:             my $result;
                   11638:             if ($state eq 'existingfile') {
                   11639:                 $result=
                   11640:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35  raeburn  11641:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  11642:             } else {
1.984     raeburn  11643:                 $result=
                   11644:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  11645:                                                     $dirpath.
1.1075.2.35  raeburn  11646:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  11647:                 if ($result !~ m|^/uploaded/|) {
                   11648:                     $output .= '<span class="LC_error">'
                   11649:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   11650:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   11651:                                .'</span><br />';
                   11652:                     next;
                   11653:                 } else {
1.987     raeburn  11654:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11655:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  11656:                 }
1.661     raeburn  11657:             }
1.1075.2.35  raeburn  11658:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
                   11659:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   11660:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  11661:             my $result =
1.1075.2.35  raeburn  11662:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  11663:             if ($result !~ m|^/uploaded/|) {
                   11664:                 $output .= '<span class="LC_error">'
                   11665:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   11666:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   11667:                            .'</span><br />';
                   11668:                     next;
                   11669:             } else {
                   11670:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11671:                            $path.$fname.'</span>').'<br />';
1.1075.2.35  raeburn  11672:                 if ($context eq 'syllabus') {
                   11673:                     &Apache::lonnet::make_public_indefinitely($result);
                   11674:                 }
1.987     raeburn  11675:             }
1.661     raeburn  11676:         } else {
                   11677: # Save the file
                   11678:             my $target = $env{'form.embedded_item_'.$i};
                   11679:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   11680:             my $dest = $fullpath.$fname;
                   11681:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  11682:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  11683:             my $count;
                   11684:             my $filepath = $dir_root;
1.1027    raeburn  11685:             foreach my $subdir (@parts) {
                   11686:                 $filepath .= "/$subdir";
                   11687:                 if (!-e $filepath) {
1.661     raeburn  11688:                     mkdir($filepath,0770);
                   11689:                 }
                   11690:             }
                   11691:             my $fh;
                   11692:             if (!open($fh,'>'.$dest)) {
                   11693:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   11694:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  11695:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   11696:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  11697:                            '</span><br />';
                   11698:             } else {
                   11699:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   11700:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   11701:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  11702:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   11703:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  11704:                               '</span><br />';
                   11705:                 } else {
1.987     raeburn  11706:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11707:                                $url.'</span>').'<br />';
                   11708:                     unless ($context eq 'testbank') {
                   11709:                         $footer .= &mt('View embedded file: [_1]',
                   11710:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   11711:                     }
                   11712:                 }
                   11713:                 close($fh);
                   11714:             }
                   11715:         }
                   11716:         if ($env{'form.embedded_ref_'.$i}) {
                   11717:             $pathchange{$i} = 1;
                   11718:         }
                   11719:     }
                   11720:     if ($output) {
                   11721:         $output = '<p>'.$output.'</p>';
                   11722:     }
                   11723:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   11724:     $returnflag = 'ok';
1.1071    raeburn  11725:     my $numpathchgs = scalar(keys(%pathchange));
                   11726:     if ($numpathchgs > 0) {
1.987     raeburn  11727:         if ($context eq 'portfolio') {
                   11728:             $output .= '<p>'.&mt('or').'</p>';
                   11729:         } elsif ($context eq 'testbank') {
1.1071    raeburn  11730:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   11731:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  11732:             $returnflag = 'modify_orightml';
                   11733:         }
                   11734:     }
1.1071    raeburn  11735:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  11736: }
                   11737: 
                   11738: sub modify_html_form {
                   11739:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   11740:     my $end = 0;
                   11741:     my $modifyform;
                   11742:     if ($context eq 'upload_embedded') {
                   11743:         return unless (ref($pathchange) eq 'HASH');
                   11744:         if ($env{'form.number_embedded_items'}) {
                   11745:             $end += $env{'form.number_embedded_items'};
                   11746:         }
                   11747:         if ($env{'form.number_pathchange_items'}) {
                   11748:             $end += $env{'form.number_pathchange_items'};
                   11749:         }
                   11750:         if ($end) {
                   11751:             for (my $i=0; $i<$end; $i++) {
                   11752:                 if ($i < $env{'form.number_embedded_items'}) {
                   11753:                     next unless($pathchange->{$i});
                   11754:                 }
                   11755:                 $modifyform .=
                   11756:                     &start_data_table_row().
                   11757:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   11758:                     'checked="checked" /></td>'.
                   11759:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   11760:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   11761:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   11762:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   11763:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   11764:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   11765:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   11766:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   11767:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   11768:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   11769:                     &end_data_table_row();
1.1071    raeburn  11770:             }
1.987     raeburn  11771:         }
                   11772:     } else {
                   11773:         $modifyform = $pathchgtable;
                   11774:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   11775:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   11776:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   11777:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   11778:         }
                   11779:     }
                   11780:     if ($modifyform) {
1.1071    raeburn  11781:         if ($actionurl eq '/adm/dependencies') {
                   11782:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   11783:         }
1.987     raeburn  11784:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   11785:                '<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".
                   11786:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   11787:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   11788:                '</ol></p>'."\n".'<p>'.
                   11789:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   11790:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   11791:                &start_data_table()."\n".
                   11792:                &start_data_table_header_row().
                   11793:                '<th>'.&mt('Change?').'</th>'.
                   11794:                '<th>'.&mt('Current reference').'</th>'.
                   11795:                '<th>'.&mt('Required reference').'</th>'.
                   11796:                &end_data_table_header_row()."\n".
                   11797:                $modifyform.
                   11798:                &end_data_table().'<br />'."\n".$hiddenstate.
                   11799:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   11800:                '</form>'."\n";
                   11801:     }
                   11802:     return;
                   11803: }
                   11804: 
                   11805: sub modify_html_refs {
1.1075.2.35  raeburn  11806:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  11807:     my $container;
                   11808:     if ($context eq 'portfolio') {
                   11809:         $container = $env{'form.container'};
                   11810:     } elsif ($context eq 'coursedoc') {
                   11811:         $container = $env{'form.primaryurl'};
1.1071    raeburn  11812:     } elsif ($context eq 'manage_dependencies') {
                   11813:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   11814:         $container = "/$container";
1.1075.2.35  raeburn  11815:     } elsif ($context eq 'syllabus') {
                   11816:         $container = $url;
1.987     raeburn  11817:     } else {
1.1027    raeburn  11818:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  11819:     }
                   11820:     my (%allfiles,%codebase,$output,$content);
                   11821:     my @changes = &get_env_multiple('form.namechange');
1.1075.2.35  raeburn  11822:     unless ((@changes > 0)  || ($context eq 'syllabus')) {
1.1071    raeburn  11823:         if (wantarray) {
                   11824:             return ('',0,0); 
                   11825:         } else {
                   11826:             return;
                   11827:         }
                   11828:     }
                   11829:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  11830:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  11831:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   11832:             if (wantarray) {
                   11833:                 return ('',0,0);
                   11834:             } else {
                   11835:                 return;
                   11836:             }
                   11837:         } 
1.987     raeburn  11838:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  11839:         if ($content eq '-1') {
                   11840:             if (wantarray) {
                   11841:                 return ('',0,0);
                   11842:             } else {
                   11843:                 return;
                   11844:             }
                   11845:         }
1.987     raeburn  11846:     } else {
1.1071    raeburn  11847:         unless ($container =~ /^\Q$dir_root\E/) {
                   11848:             if (wantarray) {
                   11849:                 return ('',0,0);
                   11850:             } else {
                   11851:                 return;
                   11852:             }
                   11853:         } 
1.1075.2.128  raeburn  11854:         if (open(my $fh,'<',$container)) {
1.987     raeburn  11855:             $content = join('', <$fh>);
                   11856:             close($fh);
                   11857:         } else {
1.1071    raeburn  11858:             if (wantarray) {
                   11859:                 return ('',0,0);
                   11860:             } else {
                   11861:                 return;
                   11862:             }
1.987     raeburn  11863:         }
                   11864:     }
                   11865:     my ($count,$codebasecount) = (0,0);
                   11866:     my $mm = new File::MMagic;
                   11867:     my $mime_type = $mm->checktype_contents($content);
                   11868:     if ($mime_type eq 'text/html') {
                   11869:         my $parse_result = 
                   11870:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   11871:                                                     \%codebase,\$content);
                   11872:         if ($parse_result eq 'ok') {
                   11873:             foreach my $i (@changes) {
                   11874:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   11875:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   11876:                 if ($allfiles{$ref}) {
                   11877:                     my $newname =  $orig;
                   11878:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  11879:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  11880:                     if ($attrib_regexp =~ /:/) {
                   11881:                         $attrib_regexp =~ s/\:/|/g;
                   11882:                     }
                   11883:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   11884:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   11885:                         $count += $numchg;
1.1075.2.35  raeburn  11886:                         $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48  raeburn  11887:                         delete($allfiles{$ref});
1.987     raeburn  11888:                     }
                   11889:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  11890:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  11891:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   11892:                         $codebasecount ++;
                   11893:                     }
                   11894:                 }
                   11895:             }
1.1075.2.35  raeburn  11896:             my $skiprewrites;
1.987     raeburn  11897:             if ($count || $codebasecount) {
                   11898:                 my $saveresult;
1.1071    raeburn  11899:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  11900:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  11901:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   11902:                     if ($url eq $container) {
                   11903:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   11904:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   11905:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  11906:                                             $fname.'</span>').'</p>';
1.987     raeburn  11907:                     } else {
                   11908:                          $output = '<p class="LC_error">'.
                   11909:                                    &mt('Error: update failed for: [_1].',
                   11910:                                    '<span class="LC_filename">'.
                   11911:                                    $container.'</span>').'</p>';
                   11912:                     }
1.1075.2.35  raeburn  11913:                     if ($context eq 'syllabus') {
                   11914:                         unless ($saveresult eq 'ok') {
                   11915:                             $skiprewrites = 1;
                   11916:                         }
                   11917:                     }
1.987     raeburn  11918:                 } else {
1.1075.2.128  raeburn  11919:                     if (open(my $fh,'>',$container)) {
1.987     raeburn  11920:                         print $fh $content;
                   11921:                         close($fh);
                   11922:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   11923:                                   $count,'<span class="LC_filename">'.
                   11924:                                   $container.'</span>').'</p>';
1.661     raeburn  11925:                     } else {
1.987     raeburn  11926:                          $output = '<p class="LC_error">'.
                   11927:                                    &mt('Error: could not update [_1].',
                   11928:                                    '<span class="LC_filename">'.
                   11929:                                    $container.'</span>').'</p>';
1.661     raeburn  11930:                     }
                   11931:                 }
                   11932:             }
1.1075.2.35  raeburn  11933:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   11934:                 my ($actionurl,$state);
                   11935:                 $actionurl = "/public/$udom/$uname/syllabus";
                   11936:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   11937:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   11938:                                               \%codebase,
                   11939:                                               {'context' => 'rewrites',
                   11940:                                                'ignore_remote_references' => 1,});
                   11941:                 if (ref($mapping) eq 'HASH') {
                   11942:                     my $rewrites = 0;
                   11943:                     foreach my $key (keys(%{$mapping})) {
                   11944:                         next if ($key =~ m{^https?://});
                   11945:                         my $ref = $mapping->{$key};
                   11946:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   11947:                         my $attrib;
                   11948:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   11949:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   11950:                         }
                   11951:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   11952:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   11953:                             $rewrites += $numchg;
                   11954:                         }
                   11955:                     }
                   11956:                     if ($rewrites) {
                   11957:                         my $saveresult;
                   11958:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   11959:                         if ($url eq $container) {
                   11960:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   11961:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   11962:                                             $count,'<span class="LC_filename">'.
                   11963:                                             $fname.'</span>').'</p>';
                   11964:                         } else {
                   11965:                             $output .= '<p class="LC_error">'.
                   11966:                                        &mt('Error: could not update links in [_1].',
                   11967:                                        '<span class="LC_filename">'.
                   11968:                                        $container.'</span>').'</p>';
                   11969: 
                   11970:                         }
                   11971:                     }
                   11972:                 }
                   11973:             }
1.987     raeburn  11974:         } else {
                   11975:             &logthis('Failed to parse '.$container.
                   11976:                      ' to modify references: '.$parse_result);
1.661     raeburn  11977:         }
                   11978:     }
1.1071    raeburn  11979:     if (wantarray) {
                   11980:         return ($output,$count,$codebasecount);
                   11981:     } else {
                   11982:         return $output;
                   11983:     }
1.661     raeburn  11984: }
                   11985: 
                   11986: sub check_for_existing {
                   11987:     my ($path,$fname,$element) = @_;
                   11988:     my ($state,$msg);
                   11989:     if (-d $path.'/'.$fname) {
                   11990:         $state = 'exists';
                   11991:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   11992:     } elsif (-e $path.'/'.$fname) {
                   11993:         $state = 'exists';
                   11994:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   11995:     }
                   11996:     if ($state eq 'exists') {
                   11997:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   11998:     }
                   11999:     return ($state,$msg);
                   12000: }
                   12001: 
                   12002: sub check_for_upload {
                   12003:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   12004:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  12005:     my $filesize = length($env{'form.'.$element});
                   12006:     if (!$filesize) {
                   12007:         my $msg = '<span class="LC_error">'.
                   12008:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   12009:                       '<span class="LC_filename">'.$fname.'</span>',
                   12010:                       $filesize).'<br />'.
1.1007    raeburn  12011:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  12012:                   '</span>';
                   12013:         return ('zero_bytes',$msg);
                   12014:     }
                   12015:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  12016:     my $getpropath = 1;
1.1021    raeburn  12017:     my ($dirlistref,$listerror) =
                   12018:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  12019:     my $found_file = 0;
                   12020:     my $locked_file = 0;
1.991     raeburn  12021:     my @lockers;
                   12022:     my $navmap;
                   12023:     if ($env{'request.course.id'}) {
                   12024:         $navmap = Apache::lonnavmaps::navmap->new();
                   12025:     }
1.1021    raeburn  12026:     if (ref($dirlistref) eq 'ARRAY') {
                   12027:         foreach my $line (@{$dirlistref}) {
                   12028:             my ($file_name,$rest)=split(/\&/,$line,2);
                   12029:             if ($file_name eq $fname){
                   12030:                 $file_name = $path.$file_name;
                   12031:                 if ($group ne '') {
                   12032:                     $file_name = $group.$file_name;
                   12033:                 }
                   12034:                 $found_file = 1;
                   12035:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   12036:                     foreach my $lock (@lockers) {
                   12037:                         if (ref($lock) eq 'ARRAY') {
                   12038:                             my ($symb,$crsid) = @{$lock};
                   12039:                             if ($crsid eq $env{'request.course.id'}) {
                   12040:                                 if (ref($navmap)) {
                   12041:                                     my $res = $navmap->getBySymb($symb);
                   12042:                                     foreach my $part (@{$res->parts()}) { 
                   12043:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   12044:                                         unless (($slot_status == $res->RESERVED) ||
                   12045:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   12046:                                             $locked_file = 1;
                   12047:                                         }
1.991     raeburn  12048:                                     }
1.1021    raeburn  12049:                                 } else {
                   12050:                                     $locked_file = 1;
1.991     raeburn  12051:                                 }
                   12052:                             } else {
                   12053:                                 $locked_file = 1;
                   12054:                             }
                   12055:                         }
1.1021    raeburn  12056:                    }
                   12057:                 } else {
                   12058:                     my @info = split(/\&/,$rest);
                   12059:                     my $currsize = $info[6]/1000;
                   12060:                     if ($currsize < $filesize) {
                   12061:                         my $extra = $filesize - $currsize;
                   12062:                         if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69  raeburn  12063:                             my $msg = '<p class="LC_warning">'.
1.1021    raeburn  12064:                                       &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',
1.1075.2.69  raeburn  12065:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                   12066:                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   12067:                                                    $disk_quota,$current_disk_usage).'</p>';
1.1021    raeburn  12068:                             return ('will_exceed_quota',$msg);
                   12069:                         }
1.984     raeburn  12070:                     }
                   12071:                 }
1.661     raeburn  12072:             }
                   12073:         }
                   12074:     }
                   12075:     if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69  raeburn  12076:         my $msg = '<p class="LC_warning">'.
                   12077:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
                   12078:                   '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661     raeburn  12079:         return ('will_exceed_quota',$msg);
                   12080:     } elsif ($found_file) {
                   12081:         if ($locked_file) {
1.1075.2.69  raeburn  12082:             my $msg = '<p class="LC_warning">';
1.661     raeburn  12083:             $msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>','<span class="LC_filename">'.$port_path.$env{'form.currentpath'}.'</span>');
1.1075.2.69  raeburn  12084:             $msg .= '</p>';
1.661     raeburn  12085:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   12086:             return ('file_locked',$msg);
                   12087:         } else {
1.1075.2.69  raeburn  12088:             my $msg = '<p class="LC_error">';
1.984     raeburn  12089:             $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.1075.2.69  raeburn  12090:             $msg .= '</p>';
1.984     raeburn  12091:             return ('existingfile',$msg);
1.661     raeburn  12092:         }
                   12093:     }
                   12094: }
                   12095: 
1.987     raeburn  12096: sub check_for_traversal {
                   12097:     my ($path,$url,$toplevel) = @_;
                   12098:     my @parts=split(/\//,$path);
                   12099:     my $cleanpath;
                   12100:     my $fullpath = $url;
                   12101:     for (my $i=0;$i<@parts;$i++) {
                   12102:         next if ($parts[$i] eq '.');
                   12103:         if ($parts[$i] eq '..') {
                   12104:             $fullpath =~ s{([^/]+/)$}{};
                   12105:         } else {
                   12106:             $fullpath .= $parts[$i].'/';
                   12107:         }
                   12108:     }
                   12109:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   12110:         $cleanpath = $1;
                   12111:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   12112:         my $curr_toprel = $1;
                   12113:         my @parts = split(/\//,$curr_toprel);
                   12114:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   12115:         my @urlparts = split(/\//,$url_toprel);
                   12116:         my $doubledots;
                   12117:         my $startdiff = -1;
                   12118:         for (my $i=0; $i<@urlparts; $i++) {
                   12119:             if ($startdiff == -1) {
                   12120:                 unless ($urlparts[$i] eq $parts[$i]) {
                   12121:                     $startdiff = $i;
                   12122:                     $doubledots .= '../';
                   12123:                 }
                   12124:             } else {
                   12125:                 $doubledots .= '../';
                   12126:             }
                   12127:         }
                   12128:         if ($startdiff > -1) {
                   12129:             $cleanpath = $doubledots;
                   12130:             for (my $i=$startdiff; $i<@parts; $i++) {
                   12131:                 $cleanpath .= $parts[$i].'/';
                   12132:             }
                   12133:         }
                   12134:     }
                   12135:     $cleanpath =~ s{(/)$}{};
                   12136:     return $cleanpath;
                   12137: }
1.31      albertel 12138: 
1.1053    raeburn  12139: sub is_archive_file {
                   12140:     my ($mimetype) = @_;
                   12141:     if (($mimetype eq 'application/octet-stream') ||
                   12142:         ($mimetype eq 'application/x-stuffit') ||
                   12143:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   12144:         return 1;
                   12145:     }
                   12146:     return;
                   12147: }
                   12148: 
                   12149: sub decompress_form {
1.1065    raeburn  12150:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  12151:     my %lt = &Apache::lonlocal::texthash (
                   12152:         this => 'This file is an archive file.',
1.1067    raeburn  12153:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  12154:         itsc => 'Its contents are as follows:',
1.1053    raeburn  12155:         youm => 'You may wish to extract its contents.',
                   12156:         extr => 'Extract contents',
1.1067    raeburn  12157:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   12158:         proa => 'Process automatically?',
1.1053    raeburn  12159:         yes  => 'Yes',
                   12160:         no   => 'No',
1.1067    raeburn  12161:         fold => 'Title for folder containing movie',
                   12162:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  12163:     );
1.1065    raeburn  12164:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  12165:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  12166:     my $info = &list_archive_contents($fileloc,\@paths);
                   12167:     if (@paths) {
                   12168:         foreach my $path (@paths) {
                   12169:             $path =~ s{^/}{};
1.1067    raeburn  12170:             if ($path =~ m{^([^/]+)/$}) {
                   12171:                 $topdir = $1;
                   12172:             }
1.1065    raeburn  12173:             if ($path =~ m{^([^/]+)/}) {
                   12174:                 $toplevel{$1} = $path;
                   12175:             } else {
                   12176:                 $toplevel{$path} = $path;
                   12177:             }
                   12178:         }
                   12179:     }
1.1067    raeburn  12180:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59  raeburn  12181:         my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067    raeburn  12182:                         "$topdir/media/",
                   12183:                         "$topdir/media/$topdir.mp4",
                   12184:                         "$topdir/media/FirstFrame.png",
                   12185:                         "$topdir/media/player.swf",
                   12186:                         "$topdir/media/swfobject.js",
                   12187:                         "$topdir/media/expressInstall.swf");
1.1075.2.81  raeburn  12188:         my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1075.2.59  raeburn  12189:                          "$topdir/$topdir.mp4",
                   12190:                          "$topdir/$topdir\_config.xml",
                   12191:                          "$topdir/$topdir\_controller.swf",
                   12192:                          "$topdir/$topdir\_embed.css",
                   12193:                          "$topdir/$topdir\_First_Frame.png",
                   12194:                          "$topdir/$topdir\_player.html",
                   12195:                          "$topdir/$topdir\_Thumbnails.png",
                   12196:                          "$topdir/playerProductInstall.swf",
                   12197:                          "$topdir/scripts/",
                   12198:                          "$topdir/scripts/config_xml.js",
                   12199:                          "$topdir/scripts/handlebars.js",
                   12200:                          "$topdir/scripts/jquery-1.7.1.min.js",
                   12201:                          "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                   12202:                          "$topdir/scripts/modernizr.js",
                   12203:                          "$topdir/scripts/player-min.js",
                   12204:                          "$topdir/scripts/swfobject.js",
                   12205:                          "$topdir/skins/",
                   12206:                          "$topdir/skins/configuration_express.xml",
                   12207:                          "$topdir/skins/express_show/",
                   12208:                          "$topdir/skins/express_show/player-min.css",
                   12209:                          "$topdir/skins/express_show/spritesheet.png");
1.1075.2.81  raeburn  12210:         my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
                   12211:                          "$topdir/$topdir.mp4",
                   12212:                          "$topdir/$topdir\_config.xml",
                   12213:                          "$topdir/$topdir\_controller.swf",
                   12214:                          "$topdir/$topdir\_embed.css",
                   12215:                          "$topdir/$topdir\_First_Frame.png",
                   12216:                          "$topdir/$topdir\_player.html",
                   12217:                          "$topdir/$topdir\_Thumbnails.png",
                   12218:                          "$topdir/playerProductInstall.swf",
                   12219:                          "$topdir/scripts/",
                   12220:                          "$topdir/scripts/config_xml.js",
                   12221:                          "$topdir/scripts/techsmith-smart-player.min.js",
                   12222:                          "$topdir/skins/",
                   12223:                          "$topdir/skins/configuration_express.xml",
                   12224:                          "$topdir/skins/express_show/",
                   12225:                          "$topdir/skins/express_show/spritesheet.min.css",
                   12226:                          "$topdir/skins/express_show/spritesheet.png",
                   12227:                          "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1075.2.59  raeburn  12228:         my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067    raeburn  12229:         if (@diffs == 0) {
1.1075.2.59  raeburn  12230:             $is_camtasia = 6;
                   12231:         } else {
1.1075.2.81  raeburn  12232:             @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1075.2.59  raeburn  12233:             if (@diffs == 0) {
                   12234:                 $is_camtasia = 8;
1.1075.2.81  raeburn  12235:             } else {
                   12236:                 @diffs = &compare_arrays(\@paths,\@camtasia8_4);
                   12237:                 if (@diffs == 0) {
                   12238:                     $is_camtasia = 8;
                   12239:                 }
1.1075.2.59  raeburn  12240:             }
1.1067    raeburn  12241:         }
                   12242:     }
                   12243:     my $output;
                   12244:     if ($is_camtasia) {
                   12245:         $output = <<"ENDCAM";
                   12246: <script type="text/javascript" language="Javascript">
                   12247: // <![CDATA[
                   12248: 
                   12249: function camtasiaToggle() {
                   12250:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   12251:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59  raeburn  12252:             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067    raeburn  12253:                 document.getElementById('camtasia_titles').style.display='block';
                   12254:             } else {
                   12255:                 document.getElementById('camtasia_titles').style.display='none';
                   12256:             }
                   12257:         }
                   12258:     }
                   12259:     return;
                   12260: }
                   12261: 
                   12262: // ]]>
                   12263: </script>
                   12264: <p>$lt{'camt'}</p>
                   12265: ENDCAM
1.1065    raeburn  12266:     } else {
1.1067    raeburn  12267:         $output = '<p>'.$lt{'this'};
                   12268:         if ($info eq '') {
                   12269:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   12270:         } else {
                   12271:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   12272:                        '<div><pre>'.$info.'</pre></div>';
                   12273:         }
1.1065    raeburn  12274:     }
1.1067    raeburn  12275:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  12276:     my $duplicates;
                   12277:     my $num = 0;
                   12278:     if (ref($dirlist) eq 'ARRAY') {
                   12279:         foreach my $item (@{$dirlist}) {
                   12280:             if (ref($item) eq 'ARRAY') {
                   12281:                 if (exists($toplevel{$item->[0]})) {
                   12282:                     $duplicates .= 
                   12283:                         &start_data_table_row().
                   12284:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   12285:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   12286:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   12287:                         'value="1" />'.&mt('Yes').'</label>'.
                   12288:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   12289:                         '<td>'.$item->[0].'</td>';
                   12290:                     if ($item->[2]) {
                   12291:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   12292:                     } else {
                   12293:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   12294:                     }
                   12295:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   12296:                                    '<td>'.
                   12297:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   12298:                                    '</td>'.
                   12299:                                    &end_data_table_row();
                   12300:                     $num ++;
                   12301:                 }
                   12302:             }
                   12303:         }
                   12304:     }
                   12305:     my $itemcount;
                   12306:     if (@paths > 0) {
                   12307:         $itemcount = scalar(@paths);
                   12308:     } else {
                   12309:         $itemcount = 1;
                   12310:     }
1.1067    raeburn  12311:     if ($is_camtasia) {
                   12312:         $output .= $lt{'auto'}.'<br />'.
                   12313:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59  raeburn  12314:                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067    raeburn  12315:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   12316:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   12317:                    $lt{'no'}.'</label></span><br />'.
                   12318:                    '<div id="camtasia_titles" style="display:block">'.
                   12319:                    &Apache::lonhtmlcommon::start_pick_box().
                   12320:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   12321:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   12322:                    &Apache::lonhtmlcommon::row_closure().
                   12323:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   12324:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   12325:                    &Apache::lonhtmlcommon::row_closure(1).
                   12326:                    &Apache::lonhtmlcommon::end_pick_box().
                   12327:                    '</div>';
                   12328:     }
1.1065    raeburn  12329:     $output .= 
                   12330:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  12331:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   12332:         "\n";
1.1065    raeburn  12333:     if ($duplicates ne '') {
                   12334:         $output .= '<p><span class="LC_warning">'.
                   12335:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   12336:                    &start_data_table().
                   12337:                    &start_data_table_header_row().
                   12338:                    '<th>'.&mt('Overwrite?').'</th>'.
                   12339:                    '<th>'.&mt('Name').'</th>'.
                   12340:                    '<th>'.&mt('Type').'</th>'.
                   12341:                    '<th>'.&mt('Size').'</th>'.
                   12342:                    '<th>'.&mt('Last modified').'</th>'.
                   12343:                    &end_data_table_header_row().
                   12344:                    $duplicates.
                   12345:                    &end_data_table().
                   12346:                    '</p>';
                   12347:     }
1.1067    raeburn  12348:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  12349:     if (ref($hiddenelements) eq 'HASH') {
                   12350:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   12351:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   12352:         }
                   12353:     }
                   12354:     $output .= <<"END";
1.1067    raeburn  12355: <br />
1.1053    raeburn  12356: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   12357: </form>
                   12358: $noextract
                   12359: END
                   12360:     return $output;
                   12361: }
                   12362: 
1.1065    raeburn  12363: sub decompression_utility {
                   12364:     my ($program) = @_;
                   12365:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   12366:     my $location;
                   12367:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   12368:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   12369:                          '/usr/sbin/') {
                   12370:             if (-x $dir.$program) {
                   12371:                 $location = $dir.$program;
                   12372:                 last;
                   12373:             }
                   12374:         }
                   12375:     }
                   12376:     return $location;
                   12377: }
                   12378: 
                   12379: sub list_archive_contents {
                   12380:     my ($file,$pathsref) = @_;
                   12381:     my (@cmd,$output);
                   12382:     my $needsregexp;
                   12383:     if ($file =~ /\.zip$/) {
                   12384:         @cmd = (&decompression_utility('unzip'),"-l");
                   12385:         $needsregexp = 1;
                   12386:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   12387:              ($file =~ /\.tgz$/)) {
                   12388:         @cmd = (&decompression_utility('tar'),"-ztf");
                   12389:     } elsif ($file =~ /\.tar\.bz2$/) {
                   12390:         @cmd = (&decompression_utility('tar'),"-jtf");
                   12391:     } elsif ($file =~ m|\.tar$|) {
                   12392:         @cmd = (&decompression_utility('tar'),"-tf");
                   12393:     }
                   12394:     if (@cmd) {
                   12395:         undef($!);
                   12396:         undef($@);
                   12397:         if (open(my $fh,"-|", @cmd, $file)) {
                   12398:             while (my $line = <$fh>) {
                   12399:                 $output .= $line;
                   12400:                 chomp($line);
                   12401:                 my $item;
                   12402:                 if ($needsregexp) {
                   12403:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   12404:                 } else {
                   12405:                     $item = $line;
                   12406:                 }
                   12407:                 if ($item ne '') {
                   12408:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   12409:                         push(@{$pathsref},$item);
                   12410:                     } 
                   12411:                 }
                   12412:             }
                   12413:             close($fh);
                   12414:         }
                   12415:     }
                   12416:     return $output;
                   12417: }
                   12418: 
1.1053    raeburn  12419: sub decompress_uploaded_file {
                   12420:     my ($file,$dir) = @_;
                   12421:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   12422:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   12423:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   12424:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   12425:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   12426:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   12427:     my $decompressed = $env{'cgi.decompressed'};
                   12428:     &Apache::lonnet::delenv('cgi.file');
                   12429:     &Apache::lonnet::delenv('cgi.dir');
                   12430:     &Apache::lonnet::delenv('cgi.decompressed');
                   12431:     return ($decompressed,$result);
                   12432: }
                   12433: 
1.1055    raeburn  12434: sub process_decompression {
                   12435:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1075.2.128  raeburn  12436:     unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
                   12437:         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12438:                &mt('Unexpected file path.').'</p>'."\n";
                   12439:     }
                   12440:     unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
                   12441:         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12442:                &mt('Unexpected course context.').'</p>'."\n";
                   12443:     }
                   12444:     unless ($file eq &Apache::lonnet::clean_filename($file)) {
                   12445:         return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12446:                &mt('Filename contained unexpected characters.').'</p>'."\n";
                   12447:     }
1.1055    raeburn  12448:     my ($dir,$error,$warning,$output);
1.1075.2.69  raeburn  12449:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34  raeburn  12450:         $error = &mt('Filename not a supported archive file type.').
                   12451:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  12452:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   12453:     } else {
                   12454:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   12455:         if ($docuhome eq 'no_host') {
                   12456:             $error = &mt('Could not determine home server for course.');
                   12457:         } else {
                   12458:             my @ids=&Apache::lonnet::current_machine_ids();
                   12459:             my $currdir = "$dir_root/$destination";
                   12460:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   12461:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   12462:                        "$dir_root/$destination";
                   12463:             } else {
                   12464:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   12465:                        "$dir_root/$docudom/$docuname/$destination";
                   12466:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   12467:                     $error = &mt('Archive file not found.');
                   12468:                 }
                   12469:             }
1.1065    raeburn  12470:             my (@to_overwrite,@to_skip);
                   12471:             if ($env{'form.archive_overwrite_total'} > 0) {
                   12472:                 my $total = $env{'form.archive_overwrite_total'};
                   12473:                 for (my $i=0; $i<$total; $i++) {
                   12474:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   12475:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   12476:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   12477:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   12478:                     }
                   12479:                 }
                   12480:             }
                   12481:             my $numskip = scalar(@to_skip);
1.1075.2.128  raeburn  12482:             my $numoverwrite = scalar(@to_overwrite);
                   12483:             if (($numskip) && (!$numoverwrite)) {
1.1065    raeburn  12484:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   12485:             } elsif ($dir eq '') {
1.1055    raeburn  12486:                 $error = &mt('Directory containing archive file unavailable.');
                   12487:             } elsif (!$error) {
1.1065    raeburn  12488:                 my ($decompressed,$display);
1.1075.2.128  raeburn  12489:                 if (($numskip) || ($numoverwrite)) {
1.1065    raeburn  12490:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   12491:                     mkdir("$dir/$tempdir",0755);
1.1075.2.128  raeburn  12492:                     if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
                   12493:                         ($decompressed,$display) =
                   12494:                             &decompress_uploaded_file($file,"$dir/$tempdir");
                   12495:                         foreach my $item (@to_skip) {
                   12496:                             if (($item ne '') && ($item !~ /\.\./)) {
                   12497:                                 if (-f "$dir/$tempdir/$item") {
                   12498:                                     unlink("$dir/$tempdir/$item");
                   12499:                                 } elsif (-d "$dir/$tempdir/$item") {
                   12500:                                     &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
                   12501:                                 }
                   12502:                             }
                   12503:                         }
                   12504:                         foreach my $item (@to_overwrite) {
                   12505:                             if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
                   12506:                                 if (($item ne '') && ($item !~ /\.\./)) {
                   12507:                                     if (-f "$dir/$item") {
                   12508:                                         unlink("$dir/$item");
                   12509:                                     } elsif (-d "$dir/$item") {
                   12510:                                         &File::Path::remove_tree("$dir/$item",{ safe => 1 });
                   12511:                                     }
                   12512:                                     &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
                   12513:                                 }
1.1065    raeburn  12514:                             }
                   12515:                         }
1.1075.2.128  raeburn  12516:                         if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
                   12517:                             &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
                   12518:                         }
1.1065    raeburn  12519:                     }
                   12520:                 } else {
                   12521:                     ($decompressed,$display) = 
                   12522:                         &decompress_uploaded_file($file,$dir);
                   12523:                 }
1.1055    raeburn  12524:                 if ($decompressed eq 'ok') {
1.1065    raeburn  12525:                     $output = '<p class="LC_info">'.
                   12526:                               &mt('Files extracted successfully from archive.').
                   12527:                               '</p>'."\n";
1.1055    raeburn  12528:                     my ($warning,$result,@contents);
                   12529:                     my ($newdirlistref,$newlisterror) =
                   12530:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   12531:                                                  $docuname,1);
                   12532:                     my (%is_dir,%changes,@newitems);
                   12533:                     my $dirptr = 16384;
1.1065    raeburn  12534:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  12535:                         foreach my $dir_line (@{$newdirlistref}) {
                   12536:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1075.2.128  raeburn  12537:                             unless (($item =~ /^\.+$/) || ($item eq $file)) { 
1.1055    raeburn  12538:                                 push(@newitems,$item);
                   12539:                                 if ($dirptr&$testdir) {
                   12540:                                     $is_dir{$item} = 1;
                   12541:                                 }
                   12542:                                 $changes{$item} = 1;
                   12543:                             }
                   12544:                         }
                   12545:                     }
                   12546:                     if (keys(%changes) > 0) {
                   12547:                         foreach my $item (sort(@newitems)) {
                   12548:                             if ($changes{$item}) {
                   12549:                                 push(@contents,$item);
                   12550:                             }
                   12551:                         }
                   12552:                     }
                   12553:                     if (@contents > 0) {
1.1067    raeburn  12554:                         my $wantform;
                   12555:                         unless ($env{'form.autoextract_camtasia'}) {
                   12556:                             $wantform = 1;
                   12557:                         }
1.1056    raeburn  12558:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  12559:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   12560:                                                                 $currdir,\%is_dir,
                   12561:                                                                 \%children,\%parent,
1.1056    raeburn  12562:                                                                 \@contents,\%dirorder,
                   12563:                                                                 \%titles,$wantform);
1.1055    raeburn  12564:                         if ($datatable ne '') {
                   12565:                             $output .= &archive_options_form('decompressed',$datatable,
                   12566:                                                              $count,$hiddenelem);
1.1065    raeburn  12567:                             my $startcount = 6;
1.1055    raeburn  12568:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  12569:                                                            \%titles,\%children);
1.1055    raeburn  12570:                         }
1.1067    raeburn  12571:                         if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59  raeburn  12572:                             my $version = $env{'form.autoextract_camtasia'};
1.1067    raeburn  12573:                             my %displayed;
                   12574:                             my $total = 1;
                   12575:                             $env{'form.archive_directory'} = [];
                   12576:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   12577:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   12578:                                 $path =~ s{/$}{};
                   12579:                                 my $item;
                   12580:                                 if ($path ne '') {
                   12581:                                     $item = "$path/$titles{$i}";
                   12582:                                 } else {
                   12583:                                     $item = $titles{$i};
                   12584:                                 }
                   12585:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   12586:                                 if ($item eq $contents[0]) {
                   12587:                                     push(@{$env{'form.archive_directory'}},$i);
                   12588:                                     $env{'form.archive_'.$i} = 'display';
                   12589:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   12590:                                     $displayed{'folder'} = $i;
1.1075.2.59  raeburn  12591:                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                   12592:                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067    raeburn  12593:                                     $env{'form.archive_'.$i} = 'display';
                   12594:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   12595:                                     $displayed{'web'} = $i;
                   12596:                                 } else {
1.1075.2.59  raeburn  12597:                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                   12598:                                         ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                   12599:                                              ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067    raeburn  12600:                                         push(@{$env{'form.archive_directory'}},$i);
                   12601:                                     }
                   12602:                                     $env{'form.archive_'.$i} = 'dependency';
                   12603:                                 }
                   12604:                                 $total ++;
                   12605:                             }
                   12606:                             for (my $i=1; $i<$total; $i++) {
                   12607:                                 next if ($i == $displayed{'web'});
                   12608:                                 next if ($i == $displayed{'folder'});
                   12609:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   12610:                             }
                   12611:                             $env{'form.phase'} = 'decompress_cleanup';
                   12612:                             $env{'form.archivedelete'} = 1;
                   12613:                             $env{'form.archive_count'} = $total-1;
                   12614:                             $output .=
                   12615:                                 &process_extracted_files('coursedocs',$docudom,
                   12616:                                                          $docuname,$destination,
                   12617:                                                          $dir_root,$hiddenelem);
                   12618:                         }
1.1055    raeburn  12619:                     } else {
                   12620:                         $warning = &mt('No new items extracted from archive file.');
                   12621:                     }
                   12622:                 } else {
                   12623:                     $output = $display;
                   12624:                     $error = &mt('An error occurred during extraction from the archive file.');
                   12625:                 }
                   12626:             }
                   12627:         }
                   12628:     }
                   12629:     if ($error) {
                   12630:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12631:                    $error.'</p>'."\n";
                   12632:     }
                   12633:     if ($warning) {
                   12634:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12635:     }
                   12636:     return $output;
                   12637: }
                   12638: 
                   12639: sub get_extracted {
1.1056    raeburn  12640:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   12641:         $titles,$wantform) = @_;
1.1055    raeburn  12642:     my $count = 0;
                   12643:     my $depth = 0;
                   12644:     my $datatable;
1.1056    raeburn  12645:     my @hierarchy;
1.1055    raeburn  12646:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  12647:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   12648:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  12649:     foreach my $item (@{$contents}) {
                   12650:         $count ++;
1.1056    raeburn  12651:         @{$dirorder->{$count}} = @hierarchy;
                   12652:         $titles->{$count} = $item;
1.1055    raeburn  12653:         &archive_hierarchy($depth,$count,$parent,$children);
                   12654:         if ($wantform) {
                   12655:             $datatable .= &archive_row($is_dir->{$item},$item,
                   12656:                                        $currdir,$depth,$count);
                   12657:         }
                   12658:         if ($is_dir->{$item}) {
                   12659:             $depth ++;
1.1056    raeburn  12660:             push(@hierarchy,$count);
                   12661:             $parent->{$depth} = $count;
1.1055    raeburn  12662:             $datatable .=
                   12663:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  12664:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   12665:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  12666:             $depth --;
1.1056    raeburn  12667:             pop(@hierarchy);
1.1055    raeburn  12668:         }
                   12669:     }
                   12670:     return ($count,$datatable);
                   12671: }
                   12672: 
                   12673: sub recurse_extracted_archive {
1.1056    raeburn  12674:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   12675:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  12676:     my $result='';
1.1056    raeburn  12677:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   12678:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   12679:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  12680:         return $result;
                   12681:     }
                   12682:     my $dirptr = 16384;
                   12683:     my ($newdirlistref,$newlisterror) =
                   12684:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   12685:     if (ref($newdirlistref) eq 'ARRAY') {
                   12686:         foreach my $dir_line (@{$newdirlistref}) {
                   12687:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   12688:             unless ($item =~ /^\.+$/) {
                   12689:                 $$count ++;
1.1056    raeburn  12690:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   12691:                 $titles->{$$count} = $item;
1.1055    raeburn  12692:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  12693: 
1.1055    raeburn  12694:                 my $is_dir;
                   12695:                 if ($dirptr&$testdir) {
                   12696:                     $is_dir = 1;
                   12697:                 }
                   12698:                 if ($wantform) {
                   12699:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   12700:                 }
                   12701:                 if ($is_dir) {
                   12702:                     $$depth ++;
1.1056    raeburn  12703:                     push(@{$hierarchy},$$count);
                   12704:                     $parent->{$$depth} = $$count;
1.1055    raeburn  12705:                     $result .=
                   12706:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   12707:                                                    $docuname,$depth,$count,
1.1056    raeburn  12708:                                                    $hierarchy,$dirorder,$children,
                   12709:                                                    $parent,$titles,$wantform);
1.1055    raeburn  12710:                     $$depth --;
1.1056    raeburn  12711:                     pop(@{$hierarchy});
1.1055    raeburn  12712:                 }
                   12713:             }
                   12714:         }
                   12715:     }
                   12716:     return $result;
                   12717: }
                   12718: 
                   12719: sub archive_hierarchy {
                   12720:     my ($depth,$count,$parent,$children) =@_;
                   12721:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   12722:         if (exists($parent->{$depth})) {
                   12723:              $children->{$parent->{$depth}} .= $count.':';
                   12724:         }
                   12725:     }
                   12726:     return;
                   12727: }
                   12728: 
                   12729: sub archive_row {
                   12730:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   12731:     my ($name) = ($item =~ m{([^/]+)$});
                   12732:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  12733:                                        'display'    => 'Add as file',
1.1055    raeburn  12734:                                        'dependency' => 'Include as dependency',
                   12735:                                        'discard'    => 'Discard',
                   12736:                                       );
                   12737:     if ($is_dir) {
1.1059    raeburn  12738:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  12739:     }
1.1056    raeburn  12740:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   12741:     my $offset = 0;
1.1055    raeburn  12742:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  12743:         $offset ++;
1.1065    raeburn  12744:         if ($action ne 'display') {
                   12745:             $offset ++;
                   12746:         }  
1.1055    raeburn  12747:         $output .= '<td><span class="LC_nobreak">'.
                   12748:                    '<label><input type="radio" name="archive_'.$count.
                   12749:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   12750:         my $text = $choices{$action};
                   12751:         if ($is_dir) {
                   12752:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   12753:             if ($action eq 'display') {
1.1059    raeburn  12754:                 $text = &mt('Add as folder');
1.1055    raeburn  12755:             }
1.1056    raeburn  12756:         } else {
                   12757:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   12758: 
                   12759:         }
                   12760:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   12761:         if ($action eq 'dependency') {
                   12762:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   12763:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   12764:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   12765:                        '<option value=""></option>'."\n".
                   12766:                        '</select>'."\n".
                   12767:                        '</div>';
1.1059    raeburn  12768:         } elsif ($action eq 'display') {
                   12769:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   12770:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   12771:                        '</div>';
1.1055    raeburn  12772:         }
1.1056    raeburn  12773:         $output .= '</td>';
1.1055    raeburn  12774:     }
                   12775:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   12776:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   12777:     for (my $i=0; $i<$depth; $i++) {
                   12778:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   12779:     }
                   12780:     if ($is_dir) {
                   12781:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   12782:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   12783:     } else {
                   12784:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   12785:     }
                   12786:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   12787:                &end_data_table_row();
                   12788:     return $output;
                   12789: }
                   12790: 
                   12791: sub archive_options_form {
1.1065    raeburn  12792:     my ($form,$display,$count,$hiddenelem) = @_;
                   12793:     my %lt = &Apache::lonlocal::texthash(
                   12794:                perm => 'Permanently remove archive file?',
                   12795:                hows => 'How should each extracted item be incorporated in the course?',
                   12796:                cont => 'Content actions for all',
                   12797:                addf => 'Add as folder/file',
                   12798:                incd => 'Include as dependency for a displayed file',
                   12799:                disc => 'Discard',
                   12800:                no   => 'No',
                   12801:                yes  => 'Yes',
                   12802:                save => 'Save',
                   12803:     );
                   12804:     my $output = <<"END";
                   12805: <form name="$form" method="post" action="">
                   12806: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   12807: <label>
                   12808:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   12809: </label>
                   12810: &nbsp;
                   12811: <label>
                   12812:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   12813: </span>
                   12814: </p>
                   12815: <input type="hidden" name="phase" value="decompress_cleanup" />
                   12816: <br />$lt{'hows'}
                   12817: <div class="LC_columnSection">
                   12818:   <fieldset>
                   12819:     <legend>$lt{'cont'}</legend>
                   12820:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   12821:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   12822:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   12823:   </fieldset>
                   12824: </div>
                   12825: END
                   12826:     return $output.
1.1055    raeburn  12827:            &start_data_table()."\n".
1.1065    raeburn  12828:            $display."\n".
1.1055    raeburn  12829:            &end_data_table()."\n".
                   12830:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   12831:            $hiddenelem.
1.1065    raeburn  12832:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  12833:            '</form>';
                   12834: }
                   12835: 
                   12836: sub archive_javascript {
1.1056    raeburn  12837:     my ($startcount,$numitems,$titles,$children) = @_;
                   12838:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  12839:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  12840:     my $scripttag = <<START;
                   12841: <script type="text/javascript">
                   12842: // <![CDATA[
                   12843: 
                   12844: function checkAll(form,prefix) {
                   12845:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   12846:     for (var i=0; i < form.elements.length; i++) {
                   12847:         var id = form.elements[i].id;
                   12848:         if ((id != '') && (id != undefined)) {
                   12849:             if (idstr.test(id)) {
                   12850:                 if (form.elements[i].type == 'radio') {
                   12851:                     form.elements[i].checked = true;
1.1056    raeburn  12852:                     var nostart = i-$startcount;
1.1059    raeburn  12853:                     var offset = nostart%7;
                   12854:                     var count = (nostart-offset)/7;    
1.1056    raeburn  12855:                     dependencyCheck(form,count,offset);
1.1055    raeburn  12856:                 }
                   12857:             }
                   12858:         }
                   12859:     }
                   12860: }
                   12861: 
                   12862: function propagateCheck(form,count) {
                   12863:     if (count > 0) {
1.1059    raeburn  12864:         var startelement = $startcount + ((count-1) * 7);
                   12865:         for (var j=1; j<6; j++) {
                   12866:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  12867:                 var item = startelement + j; 
                   12868:                 if (form.elements[item].type == 'radio') {
                   12869:                     if (form.elements[item].checked) {
                   12870:                         containerCheck(form,count,j);
                   12871:                         break;
                   12872:                     }
1.1055    raeburn  12873:                 }
                   12874:             }
                   12875:         }
                   12876:     }
                   12877: }
                   12878: 
                   12879: numitems = $numitems
1.1056    raeburn  12880: var titles = new Array(numitems);
                   12881: var parents = new Array(numitems);
1.1055    raeburn  12882: for (var i=0; i<numitems; i++) {
1.1056    raeburn  12883:     parents[i] = new Array;
1.1055    raeburn  12884: }
1.1059    raeburn  12885: var maintitle = '$maintitle';
1.1055    raeburn  12886: 
                   12887: START
                   12888: 
1.1056    raeburn  12889:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   12890:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  12891:         for (my $i=0; $i<@contents; $i ++) {
                   12892:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   12893:         }
                   12894:     }
                   12895: 
1.1056    raeburn  12896:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   12897:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   12898:     }
                   12899: 
1.1055    raeburn  12900:     $scripttag .= <<END;
                   12901: 
                   12902: function containerCheck(form,count,offset) {
                   12903:     if (count > 0) {
1.1056    raeburn  12904:         dependencyCheck(form,count,offset);
1.1059    raeburn  12905:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  12906:         form.elements[item].checked = true;
                   12907:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12908:             if (parents[count].length > 0) {
                   12909:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  12910:                     containerCheck(form,parents[count][j],offset);
                   12911:                 }
                   12912:             }
                   12913:         }
                   12914:     }
                   12915: }
                   12916: 
                   12917: function dependencyCheck(form,count,offset) {
                   12918:     if (count > 0) {
1.1059    raeburn  12919:         var chosen = (offset+$startcount)+7*(count-1);
                   12920:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  12921:         var currtype = form.elements[depitem].type;
                   12922:         if (form.elements[chosen].value == 'dependency') {
                   12923:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   12924:             form.elements[depitem].options.length = 0;
                   12925:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11  raeburn  12926:             for (var i=1; i<=numitems; i++) {
                   12927:                 if (i == count) {
                   12928:                     continue;
                   12929:                 }
1.1059    raeburn  12930:                 var startelement = $startcount + (i-1) * 7;
                   12931:                 for (var j=1; j<6; j++) {
                   12932:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  12933:                         var item = startelement + j;
                   12934:                         if (form.elements[item].type == 'radio') {
                   12935:                             if (form.elements[item].checked) {
                   12936:                                 if (form.elements[item].value == 'display') {
                   12937:                                     var n = form.elements[depitem].options.length;
                   12938:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   12939:                                 }
                   12940:                             }
                   12941:                         }
                   12942:                     }
                   12943:                 }
                   12944:             }
                   12945:         } else {
                   12946:             document.getElementById('arc_depon_'+count).style.display='none';
                   12947:             form.elements[depitem].options.length = 0;
                   12948:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   12949:         }
1.1059    raeburn  12950:         titleCheck(form,count,offset);
1.1056    raeburn  12951:     }
                   12952: }
                   12953: 
                   12954: function propagateSelect(form,count,offset) {
                   12955:     if (count > 0) {
1.1065    raeburn  12956:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  12957:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   12958:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12959:             if (parents[count].length > 0) {
                   12960:                 for (var j=0; j<parents[count].length; j++) {
                   12961:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  12962:                 }
                   12963:             }
                   12964:         }
                   12965:     }
                   12966: }
1.1056    raeburn  12967: 
                   12968: function containerSelect(form,count,offset,picked) {
                   12969:     if (count > 0) {
1.1065    raeburn  12970:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  12971:         if (form.elements[item].type == 'radio') {
                   12972:             if (form.elements[item].value == 'dependency') {
                   12973:                 if (form.elements[item+1].type == 'select-one') {
                   12974:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   12975:                         if (form.elements[item+1].options[i].value == picked) {
                   12976:                             form.elements[item+1].selectedIndex = i;
                   12977:                             break;
                   12978:                         }
                   12979:                     }
                   12980:                 }
                   12981:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12982:                     if (parents[count].length > 0) {
                   12983:                         for (var j=0; j<parents[count].length; j++) {
                   12984:                             containerSelect(form,parents[count][j],offset,picked);
                   12985:                         }
                   12986:                     }
                   12987:                 }
                   12988:             }
                   12989:         }
                   12990:     }
                   12991: }
                   12992: 
1.1059    raeburn  12993: function titleCheck(form,count,offset) {
                   12994:     if (count > 0) {
                   12995:         var chosen = (offset+$startcount)+7*(count-1);
                   12996:         var depitem = $startcount + ((count-1) * 7) + 2;
                   12997:         var currtype = form.elements[depitem].type;
                   12998:         if (form.elements[chosen].value == 'display') {
                   12999:             document.getElementById('arc_title_'+count).style.display='block';
                   13000:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   13001:                 document.getElementById('archive_title_'+count).value=maintitle;
                   13002:             }
                   13003:         } else {
                   13004:             document.getElementById('arc_title_'+count).style.display='none';
                   13005:             if (currtype == 'text') { 
                   13006:                 document.getElementById('archive_title_'+count).value='';
                   13007:             }
                   13008:         }
                   13009:     }
                   13010:     return;
                   13011: }
                   13012: 
1.1055    raeburn  13013: // ]]>
                   13014: </script>
                   13015: END
                   13016:     return $scripttag;
                   13017: }
                   13018: 
                   13019: sub process_extracted_files {
1.1067    raeburn  13020:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  13021:     my $numitems = $env{'form.archive_count'};
1.1075.2.128  raeburn  13022:     return if ((!$numitems) || ($numitems =~ /\D/));
1.1055    raeburn  13023:     my @ids=&Apache::lonnet::current_machine_ids();
                   13024:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  13025:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  13026:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   13027:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   13028:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   13029:         $pathtocheck = "$dir_root/$destination";
                   13030:         $dir = $dir_root;
                   13031:         $ishome = 1;
                   13032:     } else {
                   13033:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   13034:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1075.2.128  raeburn  13035:         $dir = "$dir_root/$docudom/$docuname";
1.1055    raeburn  13036:     }
                   13037:     my $currdir = "$dir_root/$destination";
                   13038:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   13039:     if ($env{'form.folderpath'}) {
                   13040:         my @items = split('&',$env{'form.folderpath'});
                   13041:         $folders{'0'} = $items[-2];
1.1075.2.17  raeburn  13042:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   13043:             $containers{'0'}='page';
                   13044:         } else {
                   13045:             $containers{'0'}='sequence';
                   13046:         }
1.1055    raeburn  13047:     }
                   13048:     my @archdirs = &get_env_multiple('form.archive_directory');
                   13049:     if ($numitems) {
                   13050:         for (my $i=1; $i<=$numitems; $i++) {
                   13051:             my $path = $env{'form.archive_content_'.$i};
                   13052:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   13053:                 my $item = $1;
                   13054:                 $toplevelitems{$item} = $i;
                   13055:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   13056:                     $is_dir{$item} = 1;
                   13057:                 }
                   13058:             }
                   13059:         }
                   13060:     }
1.1067    raeburn  13061:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  13062:     if (keys(%toplevelitems) > 0) {
                   13063:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  13064:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   13065:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  13066:     }
1.1066    raeburn  13067:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  13068:     if ($numitems) {
                   13069:         for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11  raeburn  13070:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  13071:             my $path = $env{'form.archive_content_'.$i};
                   13072:             if ($path =~ /^\Q$pathtocheck\E/) {
                   13073:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   13074:                     if ($prefix ne '' && $path ne '') {
                   13075:                         if (-e $prefix.$path) {
1.1066    raeburn  13076:                             if ((@archdirs > 0) && 
                   13077:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   13078:                                 $todeletedir{$prefix.$path} = 1;
                   13079:                             } else {
                   13080:                                 $todelete{$prefix.$path} = 1;
                   13081:                             }
1.1055    raeburn  13082:                         }
                   13083:                     }
                   13084:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  13085:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  13086:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  13087:                     $docstitle = $env{'form.archive_title_'.$i};
                   13088:                     if ($docstitle eq '') {
                   13089:                         $docstitle = $title;
                   13090:                     }
1.1055    raeburn  13091:                     $outer = 0;
1.1056    raeburn  13092:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   13093:                         if (@{$dirorder{$i}} > 0) {
                   13094:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  13095:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   13096:                                     $outer = $item;
                   13097:                                     last;
                   13098:                                 }
                   13099:                             }
                   13100:                         }
                   13101:                     }
                   13102:                     my ($errtext,$fatal) = 
                   13103:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   13104:                                                '/'.$folders{$outer}.'.'.
                   13105:                                                $containers{$outer});
                   13106:                     next if ($fatal);
                   13107:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   13108:                         if ($context eq 'coursedocs') {
1.1056    raeburn  13109:                             $mapinner{$i} = time;
1.1055    raeburn  13110:                             $folders{$i} = 'default_'.$mapinner{$i};
                   13111:                             $containers{$i} = 'sequence';
                   13112:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   13113:                                       $folders{$i}.'.'.$containers{$i};
                   13114:                             my $newidx = &LONCAPA::map::getresidx();
                   13115:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  13116:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  13117:                             push(@LONCAPA::map::order,$newidx);
                   13118:                             my ($outtext,$errtext) =
                   13119:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   13120:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  13121:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  13122:                             $newseqid{$i} = $newidx;
1.1067    raeburn  13123:                             unless ($errtext) {
1.1075.2.128  raeburn  13124:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',
                   13125:                                                        &HTML::Entities::encode($docstitle,'<>&"'))..
                   13126:                                             '</li>'."\n";
1.1067    raeburn  13127:                             }
1.1055    raeburn  13128:                         }
                   13129:                     } else {
                   13130:                         if ($context eq 'coursedocs') {
                   13131:                             my $newidx=&LONCAPA::map::getresidx();
                   13132:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   13133:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   13134:                                       $title;
1.1075.2.128  raeburn  13135:                             if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) {
                   13136:                                 if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   13137:                                     mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
1.1067    raeburn  13138:                                 }
1.1075.2.128  raeburn  13139:                                 if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   13140:                                     mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   13141:                                 }
                   13142:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   13143:                                     if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
                   13144:                                         $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
                   13145:                                         unless ($ishome) {
                   13146:                                             my $fetch = "$newdest{$i}/$title";
                   13147:                                             $fetch =~ s/^\Q$prefix$dir\E//;
                   13148:                                             $prompttofetch{$fetch} = 1;
                   13149:                                         }
                   13150:                                    }
                   13151:                                 }
                   13152:                                 $LONCAPA::map::resources[$newidx]=
                   13153:                                     $docstitle.':'.$url.':false:normal:res';
                   13154:                                 push(@LONCAPA::map::order, $newidx);
                   13155:                                 my ($outtext,$errtext)=
                   13156:                                     &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   13157:                                                             $docuname.'/'.$folders{$outer}.
                   13158:                                                             '.'.$containers{$outer},1,1);
                   13159:                                 unless ($errtext) {
                   13160:                                     if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   13161:                                         $result .= '<li>'.&mt('File: [_1] added to course',
                   13162:                                                               &HTML::Entities::encode($docstitle,'<>&"')).
                   13163:                                                    '</li>'."\n";
                   13164:                                     }
1.1067    raeburn  13165:                                 }
1.1075.2.128  raeburn  13166:                             } else {
                   13167:                                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                   13168:                                                 &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1067    raeburn  13169:                             }
1.1055    raeburn  13170:                         }
                   13171:                     }
1.1075.2.11  raeburn  13172:                 }
                   13173:             } else {
1.1075.2.128  raeburn  13174:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                   13175:                                 &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1075.2.11  raeburn  13176:             }
                   13177:         }
                   13178:         for (my $i=1; $i<=$numitems; $i++) {
                   13179:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   13180:             my $path = $env{'form.archive_content_'.$i};
                   13181:             if ($path =~ /^\Q$pathtocheck\E/) {
                   13182:                 my ($title) = ($path =~ m{/([^/]+)$});
                   13183:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   13184:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   13185:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   13186:                         my ($itemidx,$fullpath,$relpath);
                   13187:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   13188:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  13189:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11  raeburn  13190:                                 if ($dirorder{$i}->[$j] eq $container) {
                   13191:                                     $itemidx = $j;
1.1056    raeburn  13192:                                 }
                   13193:                             }
1.1075.2.11  raeburn  13194:                         }
                   13195:                         if ($itemidx eq '') {
                   13196:                             $itemidx =  0;
                   13197:                         }
                   13198:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   13199:                             if ($mapinner{$referrer{$i}}) {
                   13200:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   13201:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   13202:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   13203:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   13204:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   13205:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   13206:                                             if (!-e $fullpath) {
                   13207:                                                 mkdir($fullpath,0755);
1.1056    raeburn  13208:                                             }
                   13209:                                         }
1.1075.2.11  raeburn  13210:                                     } else {
                   13211:                                         last;
1.1056    raeburn  13212:                                     }
1.1075.2.11  raeburn  13213:                                 }
                   13214:                             }
                   13215:                         } elsif ($newdest{$referrer{$i}}) {
                   13216:                             $fullpath = $newdest{$referrer{$i}};
                   13217:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   13218:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   13219:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   13220:                                     last;
                   13221:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   13222:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   13223:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   13224:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   13225:                                         if (!-e $fullpath) {
                   13226:                                             mkdir($fullpath,0755);
1.1056    raeburn  13227:                                         }
                   13228:                                     }
1.1075.2.11  raeburn  13229:                                 } else {
                   13230:                                     last;
1.1056    raeburn  13231:                                 }
1.1075.2.11  raeburn  13232:                             }
                   13233:                         }
                   13234:                         if ($fullpath ne '') {
                   13235:                             if (-e "$prefix$path") {
1.1075.2.128  raeburn  13236:                                 unless (rename("$prefix$path","$fullpath/$title")) {
                   13237:                                      $warning .= &mt('Failed to rename dependency').'<br />';
                   13238:                                 }
1.1075.2.11  raeburn  13239:                             }
                   13240:                             if (-e "$fullpath/$title") {
                   13241:                                 my $showpath;
                   13242:                                 if ($relpath ne '') {
                   13243:                                     $showpath = "$relpath/$title";
                   13244:                                 } else {
                   13245:                                     $showpath = "/$title";
1.1056    raeburn  13246:                                 }
1.1075.2.128  raeburn  13247:                                 $result .= '<li>'.&mt('[_1] included as a dependency',
                   13248:                                                       &HTML::Entities::encode($showpath,'<>&"')).
                   13249:                                            '</li>'."\n";
                   13250:                                 unless ($ishome) {
                   13251:                                     my $fetch = "$fullpath/$title";
                   13252:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   13253:                                     $prompttofetch{$fetch} = 1;
                   13254:                                 }
1.1055    raeburn  13255:                             }
                   13256:                         }
                   13257:                     }
1.1075.2.11  raeburn  13258:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   13259:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1075.2.128  raeburn  13260:                                     &HTML::Entities::encode($path,'<>&"'),
                   13261:                                     &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
                   13262:                                 '<br />';
1.1055    raeburn  13263:                 }
                   13264:             } else {
1.1075.2.128  raeburn  13265:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
                   13266:                                 &HTML::Entities::encode($path)).'<br />';
1.1055    raeburn  13267:             }
                   13268:         }
                   13269:         if (keys(%todelete)) {
                   13270:             foreach my $key (keys(%todelete)) {
                   13271:                 unlink($key);
1.1066    raeburn  13272:             }
                   13273:         }
                   13274:         if (keys(%todeletedir)) {
                   13275:             foreach my $key (keys(%todeletedir)) {
                   13276:                 rmdir($key);
                   13277:             }
                   13278:         }
                   13279:         foreach my $dir (sort(keys(%is_dir))) {
                   13280:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   13281:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  13282:             }
                   13283:         }
1.1067    raeburn  13284:         if ($result ne '') {
                   13285:             $output .= '<ul>'."\n".
                   13286:                        $result."\n".
                   13287:                        '</ul>';
                   13288:         }
                   13289:         unless ($ishome) {
                   13290:             my $replicationfail;
                   13291:             foreach my $item (keys(%prompttofetch)) {
                   13292:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   13293:                 unless ($fetchresult eq 'ok') {
                   13294:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   13295:                 }
                   13296:             }
                   13297:             if ($replicationfail) {
                   13298:                 $output .= '<p class="LC_error">'.
                   13299:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   13300:                            $replicationfail.
                   13301:                            '</ul></p>';
                   13302:             }
                   13303:         }
1.1055    raeburn  13304:     } else {
                   13305:         $warning = &mt('No items found in archive.');
                   13306:     }
                   13307:     if ($error) {
                   13308:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   13309:                    $error.'</p>'."\n";
                   13310:     }
                   13311:     if ($warning) {
                   13312:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   13313:     }
                   13314:     return $output;
                   13315: }
                   13316: 
1.1066    raeburn  13317: sub cleanup_empty_dirs {
                   13318:     my ($path) = @_;
                   13319:     if (($path ne '') && (-d $path)) {
                   13320:         if (opendir(my $dirh,$path)) {
                   13321:             my @dircontents = grep(!/^\./,readdir($dirh));
                   13322:             my $numitems = 0;
                   13323:             foreach my $item (@dircontents) {
                   13324:                 if (-d "$path/$item") {
1.1075.2.28  raeburn  13325:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  13326:                     if (-e "$path/$item") {
                   13327:                         $numitems ++;
                   13328:                     }
                   13329:                 } else {
                   13330:                     $numitems ++;
                   13331:                 }
                   13332:             }
                   13333:             if ($numitems == 0) {
                   13334:                 rmdir($path);
                   13335:             }
                   13336:             closedir($dirh);
                   13337:         }
                   13338:     }
                   13339:     return;
                   13340: }
                   13341: 
1.41      ng       13342: =pod
1.45      matthew  13343: 
1.1075.2.56  raeburn  13344: =item * &get_folder_hierarchy()
1.1068    raeburn  13345: 
                   13346: Provides hierarchy of names of folders/sub-folders containing the current
                   13347: item,
                   13348: 
                   13349: Inputs: 3
                   13350:      - $navmap - navmaps object
                   13351: 
                   13352:      - $map - url for map (either the trigger itself, or map containing
                   13353:                            the resource, which is the trigger).
                   13354: 
                   13355:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   13356: 
                   13357: Outputs: 1 @pathitems - array of folder/subfolder names.
                   13358: 
                   13359: =cut
                   13360: 
                   13361: sub get_folder_hierarchy {
                   13362:     my ($navmap,$map,$showitem) = @_;
                   13363:     my @pathitems;
                   13364:     if (ref($navmap)) {
                   13365:         my $mapres = $navmap->getResourceByUrl($map);
                   13366:         if (ref($mapres)) {
                   13367:             my $pcslist = $mapres->map_hierarchy();
                   13368:             if ($pcslist ne '') {
                   13369:                 my @pcs = split(/,/,$pcslist);
                   13370:                 foreach my $pc (@pcs) {
                   13371:                     if ($pc == 1) {
1.1075.2.38  raeburn  13372:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  13373:                     } else {
                   13374:                         my $res = $navmap->getByMapPc($pc);
                   13375:                         if (ref($res)) {
                   13376:                             my $title = $res->compTitle();
                   13377:                             $title =~ s/\W+/_/g;
                   13378:                             if ($title ne '') {
                   13379:                                 push(@pathitems,$title);
                   13380:                             }
                   13381:                         }
                   13382:                     }
                   13383:                 }
                   13384:             }
1.1071    raeburn  13385:             if ($showitem) {
                   13386:                 if ($mapres->{ID} eq '0.0') {
1.1075.2.38  raeburn  13387:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  13388:                 } else {
                   13389:                     my $maptitle = $mapres->compTitle();
                   13390:                     $maptitle =~ s/\W+/_/g;
                   13391:                     if ($maptitle ne '') {
                   13392:                         push(@pathitems,$maptitle);
                   13393:                     }
1.1068    raeburn  13394:                 }
                   13395:             }
                   13396:         }
                   13397:     }
                   13398:     return @pathitems;
                   13399: }
                   13400: 
                   13401: =pod
                   13402: 
1.1015    raeburn  13403: =item * &get_turnedin_filepath()
                   13404: 
                   13405: Determines path in a user's portfolio file for storage of files uploaded
                   13406: to a specific essayresponse or dropbox item.
                   13407: 
                   13408: Inputs: 3 required + 1 optional.
                   13409: $symb is symb for resource, $uname and $udom are for current user (required).
                   13410: $caller is optional (can be "submission", if routine is called when storing
                   13411: an upoaded file when "Submit Answer" button was pressed).
                   13412: 
                   13413: Returns array containing $path and $multiresp. 
                   13414: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   13415: than one file upload item.  Callers of routine should append partid as a 
                   13416: subdirectory to $path in cases where $multiresp is 1.
                   13417: 
                   13418: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   13419: 
                   13420: =cut
                   13421: 
                   13422: sub get_turnedin_filepath {
                   13423:     my ($symb,$uname,$udom,$caller) = @_;
                   13424:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   13425:     my $turnindir;
                   13426:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   13427:     $turnindir = $userhash{'turnindir'};
                   13428:     my ($path,$multiresp);
                   13429:     if ($turnindir eq '') {
                   13430:         if ($caller eq 'submission') {
                   13431:             $turnindir = &mt('turned in');
                   13432:             $turnindir =~ s/\W+/_/g;
                   13433:             my %newhash = (
                   13434:                             'turnindir' => $turnindir,
                   13435:                           );
                   13436:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   13437:         }
                   13438:     }
                   13439:     if ($turnindir ne '') {
                   13440:         $path = '/'.$turnindir.'/';
                   13441:         my ($multipart,$turnin,@pathitems);
                   13442:         my $navmap = Apache::lonnavmaps::navmap->new();
                   13443:         if (defined($navmap)) {
                   13444:             my $mapres = $navmap->getResourceByUrl($map);
                   13445:             if (ref($mapres)) {
                   13446:                 my $pcslist = $mapres->map_hierarchy();
                   13447:                 if ($pcslist ne '') {
                   13448:                     foreach my $pc (split(/,/,$pcslist)) {
                   13449:                         my $res = $navmap->getByMapPc($pc);
                   13450:                         if (ref($res)) {
                   13451:                             my $title = $res->compTitle();
                   13452:                             $title =~ s/\W+/_/g;
                   13453:                             if ($title ne '') {
1.1075.2.48  raeburn  13454:                                 if (($pc > 1) && (length($title) > 12)) {
                   13455:                                     $title = substr($title,0,12);
                   13456:                                 }
1.1015    raeburn  13457:                                 push(@pathitems,$title);
                   13458:                             }
                   13459:                         }
                   13460:                     }
                   13461:                 }
                   13462:                 my $maptitle = $mapres->compTitle();
                   13463:                 $maptitle =~ s/\W+/_/g;
                   13464:                 if ($maptitle ne '') {
1.1075.2.48  raeburn  13465:                     if (length($maptitle) > 12) {
                   13466:                         $maptitle = substr($maptitle,0,12);
                   13467:                     }
1.1015    raeburn  13468:                     push(@pathitems,$maptitle);
                   13469:                 }
                   13470:                 unless ($env{'request.state'} eq 'construct') {
                   13471:                     my $res = $navmap->getBySymb($symb);
                   13472:                     if (ref($res)) {
                   13473:                         my $partlist = $res->parts();
                   13474:                         my $totaluploads = 0;
                   13475:                         if (ref($partlist) eq 'ARRAY') {
                   13476:                             foreach my $part (@{$partlist}) {
                   13477:                                 my @types = $res->responseType($part);
                   13478:                                 my @ids = $res->responseIds($part);
                   13479:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   13480:                                     if ($types[$i] eq 'essay') {
                   13481:                                         my $partid = $part.'_'.$ids[$i];
                   13482:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   13483:                                             $totaluploads ++;
                   13484:                                         }
                   13485:                                     }
                   13486:                                 }
                   13487:                             }
                   13488:                             if ($totaluploads > 1) {
                   13489:                                 $multiresp = 1;
                   13490:                             }
                   13491:                         }
                   13492:                     }
                   13493:                 }
                   13494:             } else {
                   13495:                 return;
                   13496:             }
                   13497:         } else {
                   13498:             return;
                   13499:         }
                   13500:         my $restitle=&Apache::lonnet::gettitle($symb);
                   13501:         $restitle =~ s/\W+/_/g;
                   13502:         if ($restitle eq '') {
                   13503:             $restitle = ($resurl =~ m{/[^/]+$});
                   13504:             if ($restitle eq '') {
                   13505:                 $restitle = time;
                   13506:             }
                   13507:         }
1.1075.2.48  raeburn  13508:         if (length($restitle) > 12) {
                   13509:             $restitle = substr($restitle,0,12);
                   13510:         }
1.1015    raeburn  13511:         push(@pathitems,$restitle);
                   13512:         $path .= join('/',@pathitems);
                   13513:     }
                   13514:     return ($path,$multiresp);
                   13515: }
                   13516: 
                   13517: =pod
                   13518: 
1.464     albertel 13519: =back
1.41      ng       13520: 
1.112     bowersj2 13521: =head1 CSV Upload/Handling functions
1.38      albertel 13522: 
1.41      ng       13523: =over 4
                   13524: 
1.648     raeburn  13525: =item * &upfile_store($r)
1.41      ng       13526: 
                   13527: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 13528: needs $env{'form.upfile'}
1.41      ng       13529: returns $datatoken to be put into hidden field
                   13530: 
                   13531: =cut
1.31      albertel 13532: 
                   13533: sub upfile_store {
                   13534:     my $r=shift;
1.258     albertel 13535:     $env{'form.upfile'}=~s/\r/\n/gs;
                   13536:     $env{'form.upfile'}=~s/\f/\n/gs;
                   13537:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   13538:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 13539: 
1.1075.2.128  raeburn  13540:     my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
                   13541:                                      '_enroll_'.$env{'request.course.id'}.'_'.
                   13542:                                      time.'_'.$$);
                   13543:     return if ($datatoken eq '');
                   13544: 
1.31      albertel 13545:     {
1.158     raeburn  13546:         my $datafile = $r->dir_config('lonDaemons').
                   13547:                            '/tmp/'.$datatoken.'.tmp';
1.1075.2.128  raeburn  13548:         if ( open(my $fh,'>',$datafile) ) {
1.258     albertel 13549:             print $fh $env{'form.upfile'};
1.158     raeburn  13550:             close($fh);
                   13551:         }
1.31      albertel 13552:     }
                   13553:     return $datatoken;
                   13554: }
                   13555: 
1.56      matthew  13556: =pod
                   13557: 
1.1075.2.128  raeburn  13558: =item * &load_tmp_file($r,$datatoken)
1.41      ng       13559: 
                   13560: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1075.2.128  raeburn  13561: $datatoken is the name to assign to the temporary file.
1.258     albertel 13562: sets $env{'form.upfile'} to the contents of the file
1.41      ng       13563: 
                   13564: =cut
1.31      albertel 13565: 
                   13566: sub load_tmp_file {
1.1075.2.128  raeburn  13567:     my ($r,$datatoken) = @_;
                   13568:     return if ($datatoken eq '');
1.31      albertel 13569:     my @studentdata=();
                   13570:     {
1.158     raeburn  13571:         my $studentfile = $r->dir_config('lonDaemons').
1.1075.2.128  raeburn  13572:                               '/tmp/'.$datatoken.'.tmp';
                   13573:         if ( open(my $fh,'<',$studentfile) ) {
1.158     raeburn  13574:             @studentdata=<$fh>;
                   13575:             close($fh);
                   13576:         }
1.31      albertel 13577:     }
1.258     albertel 13578:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 13579: }
                   13580: 
1.1075.2.128  raeburn  13581: sub valid_datatoken {
                   13582:     my ($datatoken) = @_;
1.1075.2.131  raeburn  13583:     if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
1.1075.2.128  raeburn  13584:         return $datatoken;
                   13585:     }
                   13586:     return;
                   13587: }
                   13588: 
1.56      matthew  13589: =pod
                   13590: 
1.648     raeburn  13591: =item * &upfile_record_sep()
1.41      ng       13592: 
                   13593: Separate uploaded file into records
                   13594: returns array of records,
1.258     albertel 13595: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       13596: 
                   13597: =cut
1.31      albertel 13598: 
                   13599: sub upfile_record_sep {
1.258     albertel 13600:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 13601:     } else {
1.248     albertel 13602: 	my @records;
1.258     albertel 13603: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 13604: 	    if ($line=~/^\s*$/) { next; }
                   13605: 	    push(@records,$line);
                   13606: 	}
                   13607: 	return @records;
1.31      albertel 13608:     }
                   13609: }
                   13610: 
1.56      matthew  13611: =pod
                   13612: 
1.648     raeburn  13613: =item * &record_sep($record)
1.41      ng       13614: 
1.258     albertel 13615: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       13616: 
                   13617: =cut
                   13618: 
1.263     www      13619: sub takeleft {
                   13620:     my $index=shift;
                   13621:     return substr('0000'.$index,-4,4);
                   13622: }
                   13623: 
1.31      albertel 13624: sub record_sep {
                   13625:     my $record=shift;
                   13626:     my %components=();
1.258     albertel 13627:     if ($env{'form.upfiletype'} eq 'xml') {
                   13628:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 13629:         my $i=0;
1.356     albertel 13630:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 13631:             $field=~s/^(\"|\')//;
                   13632:             $field=~s/(\"|\')$//;
1.263     www      13633:             $components{&takeleft($i)}=$field;
1.31      albertel 13634:             $i++;
                   13635:         }
1.258     albertel 13636:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 13637:         my $i=0;
1.356     albertel 13638:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 13639:             $field=~s/^(\"|\')//;
                   13640:             $field=~s/(\"|\')$//;
1.263     www      13641:             $components{&takeleft($i)}=$field;
1.31      albertel 13642:             $i++;
                   13643:         }
                   13644:     } else {
1.561     www      13645:         my $separator=',';
1.480     banghart 13646:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      13647:             $separator=';';
1.480     banghart 13648:         }
1.31      albertel 13649:         my $i=0;
1.561     www      13650: # the character we are looking for to indicate the end of a quote or a record 
                   13651:         my $looking_for=$separator;
                   13652: # do not add the characters to the fields
                   13653:         my $ignore=0;
                   13654: # we just encountered a separator (or the beginning of the record)
                   13655:         my $just_found_separator=1;
                   13656: # store the field we are working on here
                   13657:         my $field='';
                   13658: # work our way through all characters in record
                   13659:         foreach my $character ($record=~/(.)/g) {
                   13660:             if ($character eq $looking_for) {
                   13661:                if ($character ne $separator) {
                   13662: # Found the end of a quote, again looking for separator
                   13663:                   $looking_for=$separator;
                   13664:                   $ignore=1;
                   13665:                } else {
                   13666: # Found a separator, store away what we got
                   13667:                   $components{&takeleft($i)}=$field;
                   13668: 	          $i++;
                   13669:                   $just_found_separator=1;
                   13670:                   $ignore=0;
                   13671:                   $field='';
                   13672:                }
                   13673:                next;
                   13674:             }
                   13675: # single or double quotation marks after a separator indicate beginning of a quote
                   13676: # we are now looking for the end of the quote and need to ignore separators
                   13677:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   13678:                $looking_for=$character;
                   13679:                next;
                   13680:             }
                   13681: # ignore would be true after we reached the end of a quote
                   13682:             if ($ignore) { next; }
                   13683:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   13684:             $field.=$character;
                   13685:             $just_found_separator=0; 
1.31      albertel 13686:         }
1.561     www      13687: # catch the very last entry, since we never encountered the separator
                   13688:         $components{&takeleft($i)}=$field;
1.31      albertel 13689:     }
                   13690:     return %components;
                   13691: }
                   13692: 
1.144     matthew  13693: ######################################################
                   13694: ######################################################
                   13695: 
1.56      matthew  13696: =pod
                   13697: 
1.648     raeburn  13698: =item * &upfile_select_html()
1.41      ng       13699: 
1.144     matthew  13700: Return HTML code to select a file from the users machine and specify 
                   13701: the file type.
1.41      ng       13702: 
                   13703: =cut
                   13704: 
1.144     matthew  13705: ######################################################
                   13706: ######################################################
1.31      albertel 13707: sub upfile_select_html {
1.144     matthew  13708:     my %Types = (
                   13709:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 13710:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  13711:                  space => &mt('Space separated'),
                   13712:                  tab   => &mt('Tabulator separated'),
                   13713: #                 xml   => &mt('HTML/XML'),
                   13714:                  );
                   13715:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  13716:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  13717:     foreach my $type (sort(keys(%Types))) {
                   13718:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   13719:     }
                   13720:     $Str .= "</select>\n";
                   13721:     return $Str;
1.31      albertel 13722: }
                   13723: 
1.301     albertel 13724: sub get_samples {
                   13725:     my ($records,$toget) = @_;
                   13726:     my @samples=({});
                   13727:     my $got=0;
                   13728:     foreach my $rec (@$records) {
                   13729: 	my %temp = &record_sep($rec);
                   13730: 	if (! grep(/\S/, values(%temp))) { next; }
                   13731: 	if (%temp) {
                   13732: 	    $samples[$got]=\%temp;
                   13733: 	    $got++;
                   13734: 	    if ($got == $toget) { last; }
                   13735: 	}
                   13736:     }
                   13737:     return \@samples;
                   13738: }
                   13739: 
1.144     matthew  13740: ######################################################
                   13741: ######################################################
                   13742: 
1.56      matthew  13743: =pod
                   13744: 
1.648     raeburn  13745: =item * &csv_print_samples($r,$records)
1.41      ng       13746: 
                   13747: Prints a table of sample values from each column uploaded $r is an
                   13748: Apache Request ref, $records is an arrayref from
                   13749: &Apache::loncommon::upfile_record_sep
                   13750: 
                   13751: =cut
                   13752: 
1.144     matthew  13753: ######################################################
                   13754: ######################################################
1.31      albertel 13755: sub csv_print_samples {
                   13756:     my ($r,$records) = @_;
1.662     bisitz   13757:     my $samples = &get_samples($records,5);
1.301     albertel 13758: 
1.594     raeburn  13759:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   13760:               &start_data_table_header_row());
1.356     albertel 13761:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   13762:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  13763:     $r->print(&end_data_table_header_row());
1.301     albertel 13764:     foreach my $hash (@$samples) {
1.594     raeburn  13765: 	$r->print(&start_data_table_row());
1.356     albertel 13766: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 13767: 	    $r->print('<td>');
1.356     albertel 13768: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 13769: 	    $r->print('</td>');
                   13770: 	}
1.594     raeburn  13771: 	$r->print(&end_data_table_row());
1.31      albertel 13772:     }
1.594     raeburn  13773:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 13774: }
                   13775: 
1.144     matthew  13776: ######################################################
                   13777: ######################################################
                   13778: 
1.56      matthew  13779: =pod
                   13780: 
1.648     raeburn  13781: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       13782: 
                   13783: Prints a table to create associations between values and table columns.
1.144     matthew  13784: 
1.41      ng       13785: $r is an Apache Request ref,
                   13786: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  13787: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       13788: 
                   13789: =cut
                   13790: 
1.144     matthew  13791: ######################################################
                   13792: ######################################################
1.31      albertel 13793: sub csv_print_select_table {
                   13794:     my ($r,$records,$d) = @_;
1.301     albertel 13795:     my $i=0;
                   13796:     my $samples = &get_samples($records,1);
1.144     matthew  13797:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  13798: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  13799:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  13800:               '<th>'.&mt('Column').'</th>'.
                   13801:               &end_data_table_header_row()."\n");
1.356     albertel 13802:     foreach my $array_ref (@$d) {
                   13803: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  13804: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 13805: 
1.875     bisitz   13806: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  13807: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 13808: 	$r->print('<option value="none"></option>');
1.356     albertel 13809: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   13810: 	    $r->print('<option value="'.$sample.'"'.
                   13811:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   13812:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 13813: 	}
1.594     raeburn  13814: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 13815: 	$i++;
                   13816:     }
1.594     raeburn  13817:     $r->print(&end_data_table());
1.31      albertel 13818:     $i--;
                   13819:     return $i;
                   13820: }
1.56      matthew  13821: 
1.144     matthew  13822: ######################################################
                   13823: ######################################################
                   13824: 
1.56      matthew  13825: =pod
1.31      albertel 13826: 
1.648     raeburn  13827: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       13828: 
                   13829: Prints a table of sample values from the upload and can make associate samples to internal names.
                   13830: 
                   13831: $r is an Apache Request ref,
                   13832: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   13833: $d is an array of 2 element arrays (internal name, displayed name)
                   13834: 
                   13835: =cut
                   13836: 
1.144     matthew  13837: ######################################################
                   13838: ######################################################
1.31      albertel 13839: sub csv_samples_select_table {
                   13840:     my ($r,$records,$d) = @_;
                   13841:     my $i=0;
1.144     matthew  13842:     #
1.662     bisitz   13843:     my $max_samples = 5;
                   13844:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  13845:     $r->print(&start_data_table().
                   13846:               &start_data_table_header_row().'<th>'.
                   13847:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   13848:               &end_data_table_header_row());
1.301     albertel 13849: 
                   13850:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  13851: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  13852: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 13853: 	foreach my $option (@$d) {
                   13854: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  13855: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 13856:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  13857:                       $display.'</option>');
1.31      albertel 13858: 	}
                   13859: 	$r->print('</select></td><td>');
1.662     bisitz   13860: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 13861: 	    if (defined($samples->[$line]{$key})) { 
                   13862: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   13863: 	    }
                   13864: 	}
1.594     raeburn  13865: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 13866: 	$i++;
                   13867:     }
1.594     raeburn  13868:     $r->print(&end_data_table());
1.31      albertel 13869:     $i--;
                   13870:     return($i);
1.115     matthew  13871: }
                   13872: 
1.144     matthew  13873: ######################################################
                   13874: ######################################################
                   13875: 
1.115     matthew  13876: =pod
                   13877: 
1.648     raeburn  13878: =item * &clean_excel_name($name)
1.115     matthew  13879: 
                   13880: Returns a replacement for $name which does not contain any illegal characters.
                   13881: 
                   13882: =cut
                   13883: 
1.144     matthew  13884: ######################################################
                   13885: ######################################################
1.115     matthew  13886: sub clean_excel_name {
                   13887:     my ($name) = @_;
                   13888:     $name =~ s/[:\*\?\/\\]//g;
                   13889:     if (length($name) > 31) {
                   13890:         $name = substr($name,0,31);
                   13891:     }
                   13892:     return $name;
1.25      albertel 13893: }
1.84      albertel 13894: 
1.85      albertel 13895: =pod
                   13896: 
1.648     raeburn  13897: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 13898: 
                   13899: Returns either 1 or undef
                   13900: 
                   13901: 1 if the part is to be hidden, undef if it is to be shown
                   13902: 
                   13903: Arguments are:
                   13904: 
                   13905: $id the id of the part to be checked
                   13906: $symb, optional the symb of the resource to check
                   13907: $udom, optional the domain of the user to check for
                   13908: $uname, optional the username of the user to check for
                   13909: 
                   13910: =cut
1.84      albertel 13911: 
                   13912: sub check_if_partid_hidden {
                   13913:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 13914:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 13915: 					 $symb,$udom,$uname);
1.141     albertel 13916:     my $truth=1;
                   13917:     #if the string starts with !, then the list is the list to show not hide
                   13918:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 13919:     my @hiddenlist=split(/,/,$hiddenparts);
                   13920:     foreach my $checkid (@hiddenlist) {
1.141     albertel 13921: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 13922:     }
1.141     albertel 13923:     return !$truth;
1.84      albertel 13924: }
1.127     matthew  13925: 
1.138     matthew  13926: 
                   13927: ############################################################
                   13928: ############################################################
                   13929: 
                   13930: =pod
                   13931: 
1.157     matthew  13932: =back 
                   13933: 
1.138     matthew  13934: =head1 cgi-bin script and graphing routines
                   13935: 
1.157     matthew  13936: =over 4
                   13937: 
1.648     raeburn  13938: =item * &get_cgi_id()
1.138     matthew  13939: 
                   13940: Inputs: none
                   13941: 
                   13942: Returns an id which can be used to pass environment variables
                   13943: to various cgi-bin scripts.  These environment variables will
                   13944: be removed from the users environment after a given time by
                   13945: the routine &Apache::lonnet::transfer_profile_to_env.
                   13946: 
                   13947: =cut
                   13948: 
                   13949: ############################################################
                   13950: ############################################################
1.152     albertel 13951: my $uniq=0;
1.136     matthew  13952: sub get_cgi_id {
1.154     albertel 13953:     $uniq=($uniq+1)%100000;
1.280     albertel 13954:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  13955: }
                   13956: 
1.127     matthew  13957: ############################################################
                   13958: ############################################################
                   13959: 
                   13960: =pod
                   13961: 
1.648     raeburn  13962: =item * &DrawBarGraph()
1.127     matthew  13963: 
1.138     matthew  13964: Facilitates the plotting of data in a (stacked) bar graph.
                   13965: Puts plot definition data into the users environment in order for 
                   13966: graph.png to plot it.  Returns an <img> tag for the plot.
                   13967: The bars on the plot are labeled '1','2',...,'n'.
                   13968: 
                   13969: Inputs:
                   13970: 
                   13971: =over 4
                   13972: 
                   13973: =item $Title: string, the title of the plot
                   13974: 
                   13975: =item $xlabel: string, text describing the X-axis of the plot
                   13976: 
                   13977: =item $ylabel: string, text describing the Y-axis of the plot
                   13978: 
                   13979: =item $Max: scalar, the maximum Y value to use in the plot
                   13980: If $Max is < any data point, the graph will not be rendered.
                   13981: 
1.140     matthew  13982: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  13983: they are plotted.  If undefined, default values will be used.
                   13984: 
1.178     matthew  13985: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   13986: 
1.138     matthew  13987: =item @Values: An array of array references.  Each array reference holds data
                   13988: to be plotted in a stacked bar chart.
                   13989: 
1.239     matthew  13990: =item If the final element of @Values is a hash reference the key/value
                   13991: pairs will be added to the graph definition.
                   13992: 
1.138     matthew  13993: =back
                   13994: 
                   13995: Returns:
                   13996: 
                   13997: An <img> tag which references graph.png and the appropriate identifying
                   13998: information for the plot.
                   13999: 
1.127     matthew  14000: =cut
                   14001: 
                   14002: ############################################################
                   14003: ############################################################
1.134     matthew  14004: sub DrawBarGraph {
1.178     matthew  14005:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  14006:     #
                   14007:     if (! defined($colors)) {
                   14008:         $colors = ['#33ff00', 
                   14009:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   14010:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   14011:                   ]; 
                   14012:     }
1.228     matthew  14013:     my $extra_settings = {};
                   14014:     if (ref($Values[-1]) eq 'HASH') {
                   14015:         $extra_settings = pop(@Values);
                   14016:     }
1.127     matthew  14017:     #
1.136     matthew  14018:     my $identifier = &get_cgi_id();
                   14019:     my $id = 'cgi.'.$identifier;        
1.129     matthew  14020:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  14021:         return '';
                   14022:     }
1.225     matthew  14023:     #
                   14024:     my @Labels;
                   14025:     if (defined($labels)) {
                   14026:         @Labels = @$labels;
                   14027:     } else {
                   14028:         for (my $i=0;$i<@{$Values[0]};$i++) {
1.1075.2.119  raeburn  14029:             push(@Labels,$i+1);
1.225     matthew  14030:         }
                   14031:     }
                   14032:     #
1.129     matthew  14033:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  14034:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  14035:     my %ValuesHash;
                   14036:     my $NumSets=1;
                   14037:     foreach my $array (@Values) {
                   14038:         next if (! ref($array));
1.136     matthew  14039:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  14040:             join(',',@$array);
1.129     matthew  14041:     }
1.127     matthew  14042:     #
1.136     matthew  14043:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  14044:     if ($NumBars < 3) {
                   14045:         $width = 120+$NumBars*32;
1.220     matthew  14046:         $xskip = 1;
1.225     matthew  14047:         $bar_width = 30;
                   14048:     } elsif ($NumBars < 5) {
                   14049:         $width = 120+$NumBars*20;
                   14050:         $xskip = 1;
                   14051:         $bar_width = 20;
1.220     matthew  14052:     } elsif ($NumBars < 10) {
1.136     matthew  14053:         $width = 120+$NumBars*15;
                   14054:         $xskip = 1;
                   14055:         $bar_width = 15;
                   14056:     } elsif ($NumBars <= 25) {
                   14057:         $width = 120+$NumBars*11;
                   14058:         $xskip = 5;
                   14059:         $bar_width = 8;
                   14060:     } elsif ($NumBars <= 50) {
                   14061:         $width = 120+$NumBars*8;
                   14062:         $xskip = 5;
                   14063:         $bar_width = 4;
                   14064:     } else {
                   14065:         $width = 120+$NumBars*8;
                   14066:         $xskip = 5;
                   14067:         $bar_width = 4;
                   14068:     }
                   14069:     #
1.137     matthew  14070:     $Max = 1 if ($Max < 1);
                   14071:     if ( int($Max) < $Max ) {
                   14072:         $Max++;
                   14073:         $Max = int($Max);
                   14074:     }
1.127     matthew  14075:     $Title  = '' if (! defined($Title));
                   14076:     $xlabel = '' if (! defined($xlabel));
                   14077:     $ylabel = '' if (! defined($ylabel));
1.369     www      14078:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   14079:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   14080:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  14081:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  14082:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   14083:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   14084:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   14085:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   14086:     $ValuesHash{$id.'.height'}   = $height;
                   14087:     $ValuesHash{$id.'.width'}    = $width;
                   14088:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   14089:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   14090:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  14091:     #
1.228     matthew  14092:     # Deal with other parameters
                   14093:     while (my ($key,$value) = each(%$extra_settings)) {
                   14094:         $ValuesHash{$id.'.'.$key} = $value;
                   14095:     }
                   14096:     #
1.646     raeburn  14097:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  14098:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   14099: }
                   14100: 
                   14101: ############################################################
                   14102: ############################################################
                   14103: 
                   14104: =pod
                   14105: 
1.648     raeburn  14106: =item * &DrawXYGraph()
1.137     matthew  14107: 
1.138     matthew  14108: Facilitates the plotting of data in an XY graph.
                   14109: Puts plot definition data into the users environment in order for 
                   14110: graph.png to plot it.  Returns an <img> tag for the plot.
                   14111: 
                   14112: Inputs:
                   14113: 
                   14114: =over 4
                   14115: 
                   14116: =item $Title: string, the title of the plot
                   14117: 
                   14118: =item $xlabel: string, text describing the X-axis of the plot
                   14119: 
                   14120: =item $ylabel: string, text describing the Y-axis of the plot
                   14121: 
                   14122: =item $Max: scalar, the maximum Y value to use in the plot
                   14123: If $Max is < any data point, the graph will not be rendered.
                   14124: 
                   14125: =item $colors: Array ref containing the hex color codes for the data to be 
                   14126: plotted in.  If undefined, default values will be used.
                   14127: 
                   14128: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   14129: 
                   14130: =item $Ydata: Array ref containing Array refs.  
1.185     www      14131: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  14132: 
                   14133: =item %Values: hash indicating or overriding any default values which are 
                   14134: passed to graph.png.  
                   14135: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   14136: 
                   14137: =back
                   14138: 
                   14139: Returns:
                   14140: 
                   14141: An <img> tag which references graph.png and the appropriate identifying
                   14142: information for the plot.
                   14143: 
1.137     matthew  14144: =cut
                   14145: 
                   14146: ############################################################
                   14147: ############################################################
                   14148: sub DrawXYGraph {
                   14149:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   14150:     #
                   14151:     # Create the identifier for the graph
                   14152:     my $identifier = &get_cgi_id();
                   14153:     my $id = 'cgi.'.$identifier;
                   14154:     #
                   14155:     $Title  = '' if (! defined($Title));
                   14156:     $xlabel = '' if (! defined($xlabel));
                   14157:     $ylabel = '' if (! defined($ylabel));
                   14158:     my %ValuesHash = 
                   14159:         (
1.369     www      14160:          $id.'.title'  => &escape($Title),
                   14161:          $id.'.xlabel' => &escape($xlabel),
                   14162:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  14163:          $id.'.y_max_value'=> $Max,
                   14164:          $id.'.labels'     => join(',',@$Xlabels),
                   14165:          $id.'.PlotType'   => 'XY',
                   14166:          );
                   14167:     #
                   14168:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   14169:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   14170:     }
                   14171:     #
                   14172:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   14173:         return '';
                   14174:     }
                   14175:     my $NumSets=1;
1.138     matthew  14176:     foreach my $array (@{$Ydata}){
1.137     matthew  14177:         next if (! ref($array));
                   14178:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   14179:     }
1.138     matthew  14180:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  14181:     #
                   14182:     # Deal with other parameters
                   14183:     while (my ($key,$value) = each(%Values)) {
                   14184:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  14185:     }
                   14186:     #
1.646     raeburn  14187:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  14188:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   14189: }
                   14190: 
                   14191: ############################################################
                   14192: ############################################################
                   14193: 
                   14194: =pod
                   14195: 
1.648     raeburn  14196: =item * &DrawXYYGraph()
1.138     matthew  14197: 
                   14198: Facilitates the plotting of data in an XY graph with two Y axes.
                   14199: Puts plot definition data into the users environment in order for 
                   14200: graph.png to plot it.  Returns an <img> tag for the plot.
                   14201: 
                   14202: Inputs:
                   14203: 
                   14204: =over 4
                   14205: 
                   14206: =item $Title: string, the title of the plot
                   14207: 
                   14208: =item $xlabel: string, text describing the X-axis of the plot
                   14209: 
                   14210: =item $ylabel: string, text describing the Y-axis of the plot
                   14211: 
                   14212: =item $colors: Array ref containing the hex color codes for the data to be 
                   14213: plotted in.  If undefined, default values will be used.
                   14214: 
                   14215: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   14216: 
                   14217: =item $Ydata1: The first data set
                   14218: 
                   14219: =item $Min1: The minimum value of the left Y-axis
                   14220: 
                   14221: =item $Max1: The maximum value of the left Y-axis
                   14222: 
                   14223: =item $Ydata2: The second data set
                   14224: 
                   14225: =item $Min2: The minimum value of the right Y-axis
                   14226: 
                   14227: =item $Max2: The maximum value of the left Y-axis
                   14228: 
                   14229: =item %Values: hash indicating or overriding any default values which are 
                   14230: passed to graph.png.  
                   14231: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   14232: 
                   14233: =back
                   14234: 
                   14235: Returns:
                   14236: 
                   14237: An <img> tag which references graph.png and the appropriate identifying
                   14238: information for the plot.
1.136     matthew  14239: 
                   14240: =cut
                   14241: 
                   14242: ############################################################
                   14243: ############################################################
1.137     matthew  14244: sub DrawXYYGraph {
                   14245:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   14246:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  14247:     #
                   14248:     # Create the identifier for the graph
                   14249:     my $identifier = &get_cgi_id();
                   14250:     my $id = 'cgi.'.$identifier;
                   14251:     #
                   14252:     $Title  = '' if (! defined($Title));
                   14253:     $xlabel = '' if (! defined($xlabel));
                   14254:     $ylabel = '' if (! defined($ylabel));
                   14255:     my %ValuesHash = 
                   14256:         (
1.369     www      14257:          $id.'.title'  => &escape($Title),
                   14258:          $id.'.xlabel' => &escape($xlabel),
                   14259:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  14260:          $id.'.labels' => join(',',@$Xlabels),
                   14261:          $id.'.PlotType' => 'XY',
                   14262:          $id.'.NumSets' => 2,
1.137     matthew  14263:          $id.'.two_axes' => 1,
                   14264:          $id.'.y1_max_value' => $Max1,
                   14265:          $id.'.y1_min_value' => $Min1,
                   14266:          $id.'.y2_max_value' => $Max2,
                   14267:          $id.'.y2_min_value' => $Min2,
1.136     matthew  14268:          );
                   14269:     #
1.137     matthew  14270:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   14271:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   14272:     }
                   14273:     #
                   14274:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   14275:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  14276:         return '';
                   14277:     }
                   14278:     my $NumSets=1;
1.137     matthew  14279:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  14280:         next if (! ref($array));
                   14281:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  14282:     }
                   14283:     #
                   14284:     # Deal with other parameters
                   14285:     while (my ($key,$value) = each(%Values)) {
                   14286:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  14287:     }
                   14288:     #
1.646     raeburn  14289:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 14290:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  14291: }
                   14292: 
                   14293: ############################################################
                   14294: ############################################################
                   14295: 
                   14296: =pod
                   14297: 
1.157     matthew  14298: =back 
                   14299: 
1.139     matthew  14300: =head1 Statistics helper routines?  
                   14301: 
                   14302: Bad place for them but what the hell.
                   14303: 
1.157     matthew  14304: =over 4
                   14305: 
1.648     raeburn  14306: =item * &chartlink()
1.139     matthew  14307: 
                   14308: Returns a link to the chart for a specific student.  
                   14309: 
                   14310: Inputs:
                   14311: 
                   14312: =over 4
                   14313: 
                   14314: =item $linktext: The text of the link
                   14315: 
                   14316: =item $sname: The students username
                   14317: 
                   14318: =item $sdomain: The students domain
                   14319: 
                   14320: =back
                   14321: 
1.157     matthew  14322: =back
                   14323: 
1.139     matthew  14324: =cut
                   14325: 
                   14326: ############################################################
                   14327: ############################################################
                   14328: sub chartlink {
                   14329:     my ($linktext, $sname, $sdomain) = @_;
                   14330:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      14331:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 14332:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  14333:        '">'.$linktext.'</a>';
1.153     matthew  14334: }
                   14335: 
                   14336: #######################################################
                   14337: #######################################################
                   14338: 
                   14339: =pod
                   14340: 
                   14341: =head1 Course Environment Routines
1.157     matthew  14342: 
                   14343: =over 4
1.153     matthew  14344: 
1.648     raeburn  14345: =item * &restore_course_settings()
1.153     matthew  14346: 
1.648     raeburn  14347: =item * &store_course_settings()
1.153     matthew  14348: 
                   14349: Restores/Store indicated form parameters from the course environment.
                   14350: Will not overwrite existing values of the form parameters.
                   14351: 
                   14352: Inputs: 
                   14353: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   14354: 
                   14355: a hash ref describing the data to be stored.  For example:
                   14356:    
                   14357: %Save_Parameters = ('Status' => 'scalar',
                   14358:     'chartoutputmode' => 'scalar',
                   14359:     'chartoutputdata' => 'scalar',
                   14360:     'Section' => 'array',
1.373     raeburn  14361:     'Group' => 'array',
1.153     matthew  14362:     'StudentData' => 'array',
                   14363:     'Maps' => 'array');
                   14364: 
                   14365: Returns: both routines return nothing
                   14366: 
1.631     raeburn  14367: =back
                   14368: 
1.153     matthew  14369: =cut
                   14370: 
                   14371: #######################################################
                   14372: #######################################################
                   14373: sub store_course_settings {
1.496     albertel 14374:     return &store_settings($env{'request.course.id'},@_);
                   14375: }
                   14376: 
                   14377: sub store_settings {
1.153     matthew  14378:     # save to the environment
                   14379:     # appenv the same items, just to be safe
1.300     albertel 14380:     my $udom  = $env{'user.domain'};
                   14381:     my $uname = $env{'user.name'};
1.496     albertel 14382:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  14383:     my %SaveHash;
                   14384:     my %AppHash;
                   14385:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 14386:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 14387:         my $envname = 'environment.'.$basename;
1.258     albertel 14388:         if (exists($env{'form.'.$setting})) {
1.153     matthew  14389:             # Save this value away
                   14390:             if ($type eq 'scalar' &&
1.258     albertel 14391:                 (! exists($env{$envname}) || 
                   14392:                  $env{$envname} ne $env{'form.'.$setting})) {
                   14393:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   14394:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  14395:             } elsif ($type eq 'array') {
                   14396:                 my $stored_form;
1.258     albertel 14397:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  14398:                     $stored_form = join(',',
                   14399:                                         map {
1.369     www      14400:                                             &escape($_);
1.258     albertel 14401:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  14402:                 } else {
                   14403:                     $stored_form = 
1.369     www      14404:                         &escape($env{'form.'.$setting});
1.153     matthew  14405:                 }
                   14406:                 # Determine if the array contents are the same.
1.258     albertel 14407:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  14408:                     $SaveHash{$basename} = $stored_form;
                   14409:                     $AppHash{$envname}   = $stored_form;
                   14410:                 }
                   14411:             }
                   14412:         }
                   14413:     }
                   14414:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 14415:                                           $udom,$uname);
1.153     matthew  14416:     if ($put_result !~ /^(ok|delayed)/) {
                   14417:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   14418:                                  'got error:'.$put_result);
                   14419:     }
                   14420:     # Make sure these settings stick around in this session, too
1.646     raeburn  14421:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  14422:     return;
                   14423: }
                   14424: 
                   14425: sub restore_course_settings {
1.499     albertel 14426:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 14427: }
                   14428: 
                   14429: sub restore_settings {
                   14430:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  14431:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 14432:         next if (exists($env{'form.'.$setting}));
1.496     albertel 14433:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  14434:             '.'.$setting;
1.258     albertel 14435:         if (exists($env{$envname})) {
1.153     matthew  14436:             if ($type eq 'scalar') {
1.258     albertel 14437:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  14438:             } elsif ($type eq 'array') {
1.258     albertel 14439:                 $env{'form.'.$setting} = [ 
1.153     matthew  14440:                                            map { 
1.369     www      14441:                                                &unescape($_); 
1.258     albertel 14442:                                            } split(',',$env{$envname})
1.153     matthew  14443:                                            ];
                   14444:             }
                   14445:         }
                   14446:     }
1.127     matthew  14447: }
                   14448: 
1.618     raeburn  14449: #######################################################
                   14450: #######################################################
                   14451: 
                   14452: =pod
                   14453: 
                   14454: =head1 Domain E-mail Routines  
                   14455: 
                   14456: =over 4
                   14457: 
1.648     raeburn  14458: =item * &build_recipient_list()
1.618     raeburn  14459: 
1.1075.2.44  raeburn  14460: Build recipient lists for following types of e-mail:
1.766     raeburn  14461: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44  raeburn  14462: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   14463: module change checking, student/employee ID conflict checks, as
                   14464: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   14465: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  14466: 
                   14467: Inputs:
1.1075.2.44  raeburn  14468: defmail (scalar - email address of default recipient),
                   14469: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   14470: requestsmail, updatesmail, or idconflictsmail).
                   14471: 
1.619     raeburn  14472: defdom (domain for which to retrieve configuration settings),
1.1075.2.44  raeburn  14473: 
                   14474: origmail (scalar - email address of recipient from loncapa.conf,
                   14475: i.e., predates configuration by DC via domainprefs.pm
1.618     raeburn  14476: 
1.1075.2.139  raeburn  14477: $requname username of requester (if mailing type is helpdeskmail)
                   14478: 
                   14479: $requdom domain of requester (if mailing type is helpdeskmail)
                   14480: 
                   14481: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
                   14482: 
1.655     raeburn  14483: Returns: comma separated list of addresses to which to send e-mail.
                   14484: 
                   14485: =back
1.618     raeburn  14486: 
                   14487: =cut
                   14488: 
                   14489: ############################################################
                   14490: ############################################################
                   14491: sub build_recipient_list {
1.1075.2.139  raeburn  14492:     my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618     raeburn  14493:     my @recipients;
1.1075.2.122  raeburn  14494:     my ($otheremails,$lastresort,$allbcc,$addtext);
1.618     raeburn  14495:     my %domconfig =
1.1075.2.122  raeburn  14496:         &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618     raeburn  14497:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  14498:         if (exists($domconfig{'contacts'}{$mailing})) {
                   14499:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   14500:                 my @contacts = ('adminemail','supportemail');
                   14501:                 foreach my $item (@contacts) {
                   14502:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   14503:                         my $addr = $domconfig{'contacts'}{$item}; 
                   14504:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   14505:                             push(@recipients,$addr);
                   14506:                         }
1.619     raeburn  14507:                     }
1.1075.2.122  raeburn  14508:                 }
                   14509:                 $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
                   14510:                 if ($mailing eq 'helpdeskmail') {
                   14511:                     if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
                   14512:                         my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
                   14513:                         my @ok_bccs;
                   14514:                         foreach my $bcc (@bccs) {
                   14515:                             $bcc =~ s/^\s+//g;
                   14516:                             $bcc =~ s/\s+$//g;
                   14517:                             if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                   14518:                                 if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                   14519:                                     push(@ok_bccs,$bcc);
                   14520:                                 }
                   14521:                             }
                   14522:                         }
                   14523:                         if (@ok_bccs > 0) {
                   14524:                             $allbcc = join(', ',@ok_bccs);
                   14525:                         }
                   14526:                     }
                   14527:                     $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618     raeburn  14528:                 }
                   14529:             }
1.766     raeburn  14530:         } elsif ($origmail ne '') {
1.1075.2.122  raeburn  14531:             $lastresort = $origmail;
1.618     raeburn  14532:         }
1.1075.2.139  raeburn  14533:         if ($mailing eq 'helpdeskmail') {
                   14534:             if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
                   14535:                 (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
                   14536:                 my ($inststatus,$inststatus_checked);
                   14537:                 if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
                   14538:                     ($env{'user.domain'} ne 'public')) {
                   14539:                     $inststatus_checked = 1;
                   14540:                     $inststatus = $env{'environment.inststatus'};
                   14541:                 }
                   14542:                 unless ($inststatus_checked) {
                   14543:                     if (($requname ne '') && ($requdom ne '')) {
                   14544:                         if (($requname =~ /^$match_username$/) &&
                   14545:                             ($requdom =~ /^$match_domain$/) &&
                   14546:                             (&Apache::lonnet::domain($requdom))) {
                   14547:                             my $requhome = &Apache::lonnet::homeserver($requname,
                   14548:                                                                       $requdom);
                   14549:                             unless ($requhome eq 'no_host') {
                   14550:                                 my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
                   14551:                                 $inststatus = $userenv{'inststatus'};
                   14552:                                 $inststatus_checked = 1;
                   14553:                             }
                   14554:                         }
                   14555:                     }
                   14556:                 }
                   14557:                 unless ($inststatus_checked) {
                   14558:                     if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
                   14559:                         my %srch = (srchby     => 'email',
                   14560:                                     srchdomain => $defdom,
                   14561:                                     srchterm   => $reqemail,
                   14562:                                     srchtype   => 'exact');
                   14563:                         my %srch_results = &Apache::lonnet::usersearch(\%srch);
                   14564:                         foreach my $uname (keys(%srch_results)) {
                   14565:                             if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
                   14566:                                 $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
                   14567:                                 $inststatus_checked = 1;
                   14568:                                 last;
                   14569:                             }
                   14570:                         }
                   14571:                         unless ($inststatus_checked) {
                   14572:                             my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
                   14573:                             if ($dirsrchres eq 'ok') {
                   14574:                                 foreach my $uname (keys(%srch_results)) {
                   14575:                                     if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
                   14576:                                         $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
                   14577:                                         $inststatus_checked = 1;
                   14578:                                         last;
                   14579:                                     }
                   14580:                                 }
                   14581:                             }
                   14582:                         }
                   14583:                     }
                   14584:                 }
                   14585:                 if ($inststatus ne '') {
                   14586:                     foreach my $status (split(/\:/,$inststatus)) {
                   14587:                         if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
                   14588:                             my @contacts = ('adminemail','supportemail');
                   14589:                             foreach my $item (@contacts) {
                   14590:                                 if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
                   14591:                                     my $addr = $domconfig{'contacts'}{'overrides'}{$status};
                   14592:                                     if (!grep(/^\Q$addr\E$/,@recipients)) {
                   14593:                                         push(@recipients,$addr);
                   14594:                                     }
                   14595:                                 }
                   14596:                             }
                   14597:                             $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
                   14598:                             if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
                   14599:                                 my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
                   14600:                                 my @ok_bccs;
                   14601:                                 foreach my $bcc (@bccs) {
                   14602:                                     $bcc =~ s/^\s+//g;
                   14603:                                     $bcc =~ s/\s+$//g;
                   14604:                                     if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                   14605:                                         if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                   14606:                                             push(@ok_bccs,$bcc);
                   14607:                                         }
                   14608:                                     }
                   14609:                                 }
                   14610:                                 if (@ok_bccs > 0) {
                   14611:                                     $allbcc = join(', ',@ok_bccs);
                   14612:                                 }
                   14613:                             }
                   14614:                             $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
                   14615:                             last;
                   14616:                         }
                   14617:                     }
                   14618:                 }
                   14619:             }
                   14620:         }
1.619     raeburn  14621:     } elsif ($origmail ne '') {
1.1075.2.122  raeburn  14622:         $lastresort = $origmail;
                   14623:     }
1.1075.2.128  raeburn  14624:     if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1075.2.122  raeburn  14625:         unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
                   14626:             my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   14627:             my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
                   14628:             my %what = (
                   14629:                           perlvar => 1,
                   14630:                        );
                   14631:             my $primary = &Apache::lonnet::domain($defdom,'primary');
                   14632:             if ($primary) {
                   14633:                 my $gotaddr;
                   14634:                 my ($result,$returnhash) =
                   14635:                     &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
                   14636:                 if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
                   14637:                     if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
                   14638:                         $lastresort = $returnhash->{'lonSupportEMail'};
                   14639:                         $gotaddr = 1;
                   14640:                     }
                   14641:                 }
                   14642:                 unless ($gotaddr) {
                   14643:                     my $uintdom = &Apache::lonnet::internet_dom($primary);
                   14644:                     my $intdom = &Apache::lonnet::internet_dom($lonhost);
                   14645:                     unless ($uintdom eq $intdom) {
                   14646:                         my %domconfig =
                   14647:                             &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
                   14648:                         if (ref($domconfig{'contacts'}) eq 'HASH') {
                   14649:                             if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
                   14650:                                 my @contacts = ('adminemail','supportemail');
                   14651:                                 foreach my $item (@contacts) {
                   14652:                                     if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
                   14653:                                         my $addr = $domconfig{'contacts'}{$item};
                   14654:                                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   14655:                                             push(@recipients,$addr);
                   14656:                                         }
                   14657:                                     }
                   14658:                                 }
                   14659:                                 if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
                   14660:                                     $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
                   14661:                                 }
                   14662:                                 if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
                   14663:                                     my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
                   14664:                                     my @ok_bccs;
                   14665:                                     foreach my $bcc (@bccs) {
                   14666:                                         $bcc =~ s/^\s+//g;
                   14667:                                         $bcc =~ s/\s+$//g;
                   14668:                                         if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                   14669:                                             if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                   14670:                                                 push(@ok_bccs,$bcc);
                   14671:                                             }
                   14672:                                         }
                   14673:                                     }
                   14674:                                     if (@ok_bccs > 0) {
                   14675:                                         $allbcc = join(', ',@ok_bccs);
                   14676:                                     }
                   14677:                                 }
                   14678:                                 $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
                   14679:                             }
                   14680:                         }
                   14681:                     }
                   14682:                 }
                   14683:             }
                   14684:         }
1.618     raeburn  14685:     }
1.688     raeburn  14686:     if (defined($defmail)) {
                   14687:         if ($defmail ne '') {
                   14688:             push(@recipients,$defmail);
                   14689:         }
1.618     raeburn  14690:     }
                   14691:     if ($otheremails) {
1.619     raeburn  14692:         my @others;
                   14693:         if ($otheremails =~ /,/) {
                   14694:             @others = split(/,/,$otheremails);
1.618     raeburn  14695:         } else {
1.619     raeburn  14696:             push(@others,$otheremails);
                   14697:         }
                   14698:         foreach my $addr (@others) {
                   14699:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   14700:                 push(@recipients,$addr);
                   14701:             }
1.618     raeburn  14702:         }
                   14703:     }
1.1075.2.128  raeburn  14704:     if ($mailing eq 'helpdeskmail') {
1.1075.2.122  raeburn  14705:         if ((!@recipients) && ($lastresort ne '')) {
                   14706:             push(@recipients,$lastresort);
                   14707:         }
                   14708:     } elsif ($lastresort ne '') {
                   14709:         if (!grep(/^\Q$lastresort\E$/,@recipients)) {
                   14710:             push(@recipients,$lastresort);
                   14711:         }
                   14712:     }
                   14713:     my $recipientlist = join(',',@recipients);
                   14714:     if (wantarray) {
                   14715:         return ($recipientlist,$allbcc,$addtext);
                   14716:     } else {
                   14717:         return $recipientlist;
                   14718:     }
1.618     raeburn  14719: }
                   14720: 
1.127     matthew  14721: ############################################################
                   14722: ############################################################
1.154     albertel 14723: 
1.655     raeburn  14724: =pod
                   14725: 
                   14726: =head1 Course Catalog Routines
                   14727: 
                   14728: =over 4
                   14729: 
                   14730: =item * &gather_categories()
                   14731: 
                   14732: Converts category definitions - keys of categories hash stored in  
                   14733: coursecategories in configuration.db on the primary library server in a 
                   14734: domain - to an array.  Also generates javascript and idx hash used to 
                   14735: generate Domain Coordinator interface for editing Course Categories.
                   14736: 
                   14737: Inputs:
1.663     raeburn  14738: 
1.655     raeburn  14739: categories (reference to hash of category definitions).
1.663     raeburn  14740: 
1.655     raeburn  14741: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14742:       categories and subcategories).
1.663     raeburn  14743: 
1.655     raeburn  14744: idx (reference to hash of counters used in Domain Coordinator interface for 
                   14745:       editing Course Categories).
1.663     raeburn  14746: 
1.655     raeburn  14747: jsarray (reference to array of categories used to create Javascript arrays for
                   14748:          Domain Coordinator interface for editing Course Categories).
                   14749: 
                   14750: Returns: nothing
                   14751: 
                   14752: Side effects: populates cats, idx and jsarray. 
                   14753: 
                   14754: =cut
                   14755: 
                   14756: sub gather_categories {
                   14757:     my ($categories,$cats,$idx,$jsarray) = @_;
                   14758:     my %counters;
                   14759:     my $num = 0;
                   14760:     foreach my $item (keys(%{$categories})) {
                   14761:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   14762:         if ($container eq '' && $depth == 0) {
                   14763:             $cats->[$depth][$categories->{$item}] = $cat;
                   14764:         } else {
                   14765:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   14766:         }
                   14767:         my ($escitem,$tail) = split(/:/,$item,2);
                   14768:         if ($counters{$tail} eq '') {
                   14769:             $counters{$tail} = $num;
                   14770:             $num ++;
                   14771:         }
                   14772:         if (ref($idx) eq 'HASH') {
                   14773:             $idx->{$item} = $counters{$tail};
                   14774:         }
                   14775:         if (ref($jsarray) eq 'ARRAY') {
                   14776:             push(@{$jsarray->[$counters{$tail}]},$item);
                   14777:         }
                   14778:     }
                   14779:     return;
                   14780: }
                   14781: 
                   14782: =pod
                   14783: 
                   14784: =item * &extract_categories()
                   14785: 
                   14786: Used to generate breadcrumb trails for course categories.
                   14787: 
                   14788: Inputs:
1.663     raeburn  14789: 
1.655     raeburn  14790: categories (reference to hash of category definitions).
1.663     raeburn  14791: 
1.655     raeburn  14792: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14793:       categories and subcategories).
1.663     raeburn  14794: 
1.655     raeburn  14795: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  14796: 
1.655     raeburn  14797: allitems (reference to hash - key is category key 
                   14798:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  14799: 
1.655     raeburn  14800: idx (reference to hash of counters used in Domain Coordinator interface for
                   14801:       editing Course Categories).
1.663     raeburn  14802: 
1.655     raeburn  14803: jsarray (reference to array of categories used to create Javascript arrays for
                   14804:          Domain Coordinator interface for editing Course Categories).
                   14805: 
1.665     raeburn  14806: subcats (reference to hash of arrays containing all subcategories within each 
                   14807:          category, -recursive)
                   14808: 
1.1075.2.132  raeburn  14809: maxd (reference to hash used to hold max depth for all top-level categories).
                   14810: 
1.655     raeburn  14811: Returns: nothing
                   14812: 
                   14813: Side effects: populates trails and allitems hash references.
                   14814: 
                   14815: =cut
                   14816: 
                   14817: sub extract_categories {
1.1075.2.132  raeburn  14818:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
1.655     raeburn  14819:     if (ref($categories) eq 'HASH') {
                   14820:         &gather_categories($categories,$cats,$idx,$jsarray);
                   14821:         if (ref($cats->[0]) eq 'ARRAY') {
                   14822:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   14823:                 my $name = $cats->[0][$i];
                   14824:                 my $item = &escape($name).'::0';
                   14825:                 my $trailstr;
                   14826:                 if ($name eq 'instcode') {
                   14827:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  14828:                 } elsif ($name eq 'communities') {
                   14829:                     $trailstr = &mt('Communities');
1.655     raeburn  14830:                 } else {
                   14831:                     $trailstr = $name;
                   14832:                 }
                   14833:                 if ($allitems->{$item} eq '') {
                   14834:                     push(@{$trails},$trailstr);
                   14835:                     $allitems->{$item} = scalar(@{$trails})-1;
                   14836:                 }
                   14837:                 my @parents = ($name);
                   14838:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   14839:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   14840:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  14841:                         if (ref($subcats) eq 'HASH') {
                   14842:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   14843:                         }
1.1075.2.132  raeburn  14844:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
1.665     raeburn  14845:                     }
                   14846:                 } else {
                   14847:                     if (ref($subcats) eq 'HASH') {
                   14848:                         $subcats->{$item} = [];
1.655     raeburn  14849:                     }
1.1075.2.132  raeburn  14850:                     if (ref($maxd) eq 'HASH') {
                   14851:                         $maxd->{$name} = 1;
                   14852:                     }
1.655     raeburn  14853:                 }
                   14854:             }
                   14855:         }
                   14856:     }
                   14857:     return;
                   14858: }
                   14859: 
                   14860: =pod
                   14861: 
1.1075.2.56  raeburn  14862: =item * &recurse_categories()
1.655     raeburn  14863: 
                   14864: Recursively used to generate breadcrumb trails for course categories.
                   14865: 
                   14866: Inputs:
1.663     raeburn  14867: 
1.655     raeburn  14868: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14869:       categories and subcategories).
1.663     raeburn  14870: 
1.655     raeburn  14871: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  14872: 
                   14873: category (current course category, for which breadcrumb trail is being generated).
                   14874: 
                   14875: trails (reference to array of breadcrumb trails for each category).
                   14876: 
1.655     raeburn  14877: allitems (reference to hash - key is category key
                   14878:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  14879: 
1.655     raeburn  14880: parents (array containing containers directories for current category, 
                   14881:          back to top level). 
                   14882: 
                   14883: Returns: nothing
                   14884: 
                   14885: Side effects: populates trails and allitems hash references
                   14886: 
                   14887: =cut
                   14888: 
                   14889: sub recurse_categories {
1.1075.2.132  raeburn  14890:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
1.655     raeburn  14891:     my $shallower = $depth - 1;
                   14892:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   14893:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   14894:             my $name = $cats->[$depth]{$category}[$k];
                   14895:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   14896:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   14897:             if ($allitems->{$item} eq '') {
                   14898:                 push(@{$trails},$trailstr);
                   14899:                 $allitems->{$item} = scalar(@{$trails})-1;
                   14900:             }
                   14901:             my $deeper = $depth+1;
                   14902:             push(@{$parents},$category);
1.665     raeburn  14903:             if (ref($subcats) eq 'HASH') {
                   14904:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   14905:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   14906:                     my $higher;
                   14907:                     if ($j > 0) {
                   14908:                         $higher = &escape($parents->[$j]).':'.
                   14909:                                   &escape($parents->[$j-1]).':'.$j;
                   14910:                     } else {
                   14911:                         $higher = &escape($parents->[$j]).'::'.$j;
                   14912:                     }
                   14913:                     push(@{$subcats->{$higher}},$subcat);
                   14914:                 }
                   14915:             }
                   14916:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
1.1075.2.132  raeburn  14917:                                 $subcats,$maxd);
1.655     raeburn  14918:             pop(@{$parents});
                   14919:         }
                   14920:     } else {
                   14921:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1075.2.132  raeburn  14922:         my $trailstr = join(' &raquo; ',(@{$parents},$category));
1.655     raeburn  14923:         if ($allitems->{$item} eq '') {
                   14924:             push(@{$trails},$trailstr);
                   14925:             $allitems->{$item} = scalar(@{$trails})-1;
                   14926:         }
1.1075.2.132  raeburn  14927:         if (ref($maxd) eq 'HASH') {
                   14928:             if ($depth > $maxd->{$parents->[0]}) {
                   14929:                 $maxd->{$parents->[0]} = $depth;
                   14930:             }
                   14931:         }
1.655     raeburn  14932:     }
                   14933:     return;
                   14934: }
                   14935: 
1.663     raeburn  14936: =pod
                   14937: 
1.1075.2.56  raeburn  14938: =item * &assign_categories_table()
1.663     raeburn  14939: 
                   14940: Create a datatable for display of hierarchical categories in a domain,
                   14941: with checkboxes to allow a course to be categorized. 
                   14942: 
                   14943: Inputs:
                   14944: 
                   14945: cathash - reference to hash of categories defined for the domain (from
                   14946:           configuration.db)
                   14947: 
                   14948: currcat - scalar with an & separated list of categories assigned to a course. 
                   14949: 
1.919     raeburn  14950: type    - scalar contains course type (Course or Community).
                   14951: 
1.1075.2.117  raeburn  14952: disabled - scalar (optional) contains disabled="disabled" if input elements are
                   14953:            to be readonly (e.g., Domain Helpdesk role viewing course settings).
                   14954: 
1.663     raeburn  14955: Returns: $output (markup to be displayed) 
                   14956: 
                   14957: =cut
                   14958: 
                   14959: sub assign_categories_table {
1.1075.2.117  raeburn  14960:     my ($cathash,$currcat,$type,$disabled) = @_;
1.663     raeburn  14961:     my $output;
                   14962:     if (ref($cathash) eq 'HASH') {
1.1075.2.132  raeburn  14963:         my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
                   14964:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
1.663     raeburn  14965:         $maxdepth = scalar(@cats);
                   14966:         if (@cats > 0) {
                   14967:             my $itemcount = 0;
                   14968:             if (ref($cats[0]) eq 'ARRAY') {
                   14969:                 my @currcategories;
                   14970:                 if ($currcat ne '') {
                   14971:                     @currcategories = split('&',$currcat);
                   14972:                 }
1.919     raeburn  14973:                 my $table;
1.663     raeburn  14974:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   14975:                     my $parent = $cats[0][$i];
1.919     raeburn  14976:                     next if ($parent eq 'instcode');
                   14977:                     if ($type eq 'Community') {
                   14978:                         next unless ($parent eq 'communities');
                   14979:                     } else {
                   14980:                         next if ($parent eq 'communities');
                   14981:                     }
1.663     raeburn  14982:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   14983:                     my $item = &escape($parent).'::0';
                   14984:                     my $checked = '';
                   14985:                     if (@currcategories > 0) {
                   14986:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   14987:                             $checked = ' checked="checked"';
1.663     raeburn  14988:                         }
                   14989:                     }
1.919     raeburn  14990:                     my $parent_title = $parent;
                   14991:                     if ($parent eq 'communities') {
                   14992:                         $parent_title = &mt('Communities');
                   14993:                     }
                   14994:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   14995:                               '<input type="checkbox" name="usecategory" value="'.
1.1075.2.117  raeburn  14996:                               $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919     raeburn  14997:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  14998:                     my $depth = 1;
                   14999:                     push(@path,$parent);
1.1075.2.117  raeburn  15000:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663     raeburn  15001:                     pop(@path);
1.919     raeburn  15002:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  15003:                     $itemcount ++;
                   15004:                 }
1.919     raeburn  15005:                 if ($itemcount) {
                   15006:                     $output = &Apache::loncommon::start_data_table().
                   15007:                               $table.
                   15008:                               &Apache::loncommon::end_data_table();
                   15009:                 }
1.663     raeburn  15010:             }
                   15011:         }
                   15012:     }
                   15013:     return $output;
                   15014: }
                   15015: 
                   15016: =pod
                   15017: 
1.1075.2.56  raeburn  15018: =item * &assign_category_rows()
1.663     raeburn  15019: 
                   15020: Create a datatable row for display of nested categories in a domain,
                   15021: with checkboxes to allow a course to be categorized,called recursively.
                   15022: 
                   15023: Inputs:
                   15024: 
                   15025: itemcount - track row number for alternating colors
                   15026: 
                   15027: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   15028:       categories and subcategories.
                   15029: 
                   15030: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   15031: 
                   15032: parent - parent of current category item
                   15033: 
                   15034: path - Array containing all categories back up through the hierarchy from the
                   15035:        current category to the top level.
                   15036: 
                   15037: currcategories - reference to array of current categories assigned to the course
                   15038: 
1.1075.2.117  raeburn  15039: disabled - scalar (optional) contains disabled="disabled" if input elements are
                   15040:            to be readonly (e.g., Domain Helpdesk role viewing course settings).
                   15041: 
1.663     raeburn  15042: Returns: $output (markup to be displayed).
                   15043: 
                   15044: =cut
                   15045: 
                   15046: sub assign_category_rows {
1.1075.2.117  raeburn  15047:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663     raeburn  15048:     my ($text,$name,$item,$chgstr);
                   15049:     if (ref($cats) eq 'ARRAY') {
                   15050:         my $maxdepth = scalar(@{$cats});
                   15051:         if (ref($cats->[$depth]) eq 'HASH') {
                   15052:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   15053:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   15054:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45  raeburn  15055:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  15056:                 for (my $j=0; $j<$numchildren; $j++) {
                   15057:                     $name = $cats->[$depth]{$parent}[$j];
                   15058:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   15059:                     my $deeper = $depth+1;
                   15060:                     my $checked = '';
                   15061:                     if (ref($currcategories) eq 'ARRAY') {
                   15062:                         if (@{$currcategories} > 0) {
                   15063:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   15064:                                 $checked = ' checked="checked"';
1.663     raeburn  15065:                             }
                   15066:                         }
                   15067:                     }
1.664     raeburn  15068:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   15069:                              '<input type="checkbox" name="usecategory" value="'.
1.1075.2.117  raeburn  15070:                              $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675     raeburn  15071:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   15072:                              '</td><td>';
1.663     raeburn  15073:                     if (ref($path) eq 'ARRAY') {
                   15074:                         push(@{$path},$name);
1.1075.2.117  raeburn  15075:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663     raeburn  15076:                         pop(@{$path});
                   15077:                     }
                   15078:                     $text .= '</td></tr>';
                   15079:                 }
                   15080:                 $text .= '</table></td>';
                   15081:             }
                   15082:         }
                   15083:     }
                   15084:     return $text;
                   15085: }
                   15086: 
1.1075.2.69  raeburn  15087: =pod
                   15088: 
                   15089: =back
                   15090: 
                   15091: =cut
                   15092: 
1.655     raeburn  15093: ############################################################
                   15094: ############################################################
                   15095: 
                   15096: 
1.443     albertel 15097: sub commit_customrole {
1.664     raeburn  15098:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  15099:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 15100:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   15101:                          ($end?', ending '.localtime($end):'').': <b>'.
                   15102:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  15103:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 15104:                  '</b><br />';
                   15105:     return $output;
                   15106: }
                   15107: 
                   15108: sub commit_standardrole {
1.1075.2.31  raeburn  15109:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  15110:     my ($output,$logmsg,$linefeed);
                   15111:     if ($context eq 'auto') {
                   15112:         $linefeed = "\n";
                   15113:     } else {
                   15114:         $linefeed = "<br />\n";
                   15115:     }  
1.443     albertel 15116:     if ($three eq 'st') {
1.541     raeburn  15117:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31  raeburn  15118:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  15119:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  15120:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   15121:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 15122:         } else {
1.541     raeburn  15123:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 15124:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  15125:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   15126:             if ($context eq 'auto') {
                   15127:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   15128:             } else {
                   15129:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   15130:                &mt('Add to classlist').': <b>ok</b>';
                   15131:             }
                   15132:             $output .= $linefeed;
1.443     albertel 15133:         }
                   15134:     } else {
                   15135:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   15136:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  15137:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  15138:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  15139:         if ($context eq 'auto') {
                   15140:             $output .= $result.$linefeed;
                   15141:         } else {
                   15142:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   15143:         }
1.443     albertel 15144:     }
                   15145:     return $output;
                   15146: }
                   15147: 
                   15148: sub commit_studentrole {
1.1075.2.31  raeburn  15149:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   15150:         $credits) = @_;
1.626     raeburn  15151:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  15152:     if ($context eq 'auto') {
                   15153:         $linefeed = "\n";
                   15154:     } else {
                   15155:         $linefeed = '<br />'."\n";
                   15156:     }
1.443     albertel 15157:     if (defined($one) && defined($two)) {
                   15158:         my $cid=$one.'_'.$two;
                   15159:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   15160:         my $secchange = 0;
                   15161:         my $expire_role_result;
                   15162:         my $modify_section_result;
1.628     raeburn  15163:         if ($oldsec ne '-1') { 
                   15164:             if ($oldsec ne $sec) {
1.443     albertel 15165:                 $secchange = 1;
1.628     raeburn  15166:                 my $now = time;
1.443     albertel 15167:                 my $uurl='/'.$cid;
                   15168:                 $uurl=~s/\_/\//g;
                   15169:                 if ($oldsec) {
                   15170:                     $uurl.='/'.$oldsec;
                   15171:                 }
1.626     raeburn  15172:                 $oldsecurl = $uurl;
1.628     raeburn  15173:                 $expire_role_result = 
1.652     raeburn  15174:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  15175:                 if ($env{'request.course.sec'} ne '') { 
                   15176:                     if ($expire_role_result eq 'refused') {
                   15177:                         my @roles = ('st');
                   15178:                         my @statuses = ('previous');
                   15179:                         my @roledoms = ($one);
                   15180:                         my $withsec = 1;
                   15181:                         my %roleshash = 
                   15182:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   15183:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   15184:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   15185:                             my ($oldstart,$oldend) = 
                   15186:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   15187:                             if ($oldend > 0 && $oldend <= $now) {
                   15188:                                 $expire_role_result = 'ok';
                   15189:                             }
                   15190:                         }
                   15191:                     }
                   15192:                 }
1.443     albertel 15193:                 $result = $expire_role_result;
                   15194:             }
                   15195:         }
                   15196:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31  raeburn  15197:             $modify_section_result = 
                   15198:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   15199:                                                            undef,undef,undef,$sec,
                   15200:                                                            $end,$start,'','',$cid,
                   15201:                                                            '',$context,$credits);
1.443     albertel 15202:             if ($modify_section_result =~ /^ok/) {
                   15203:                 if ($secchange == 1) {
1.628     raeburn  15204:                     if ($sec eq '') {
                   15205:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   15206:                     } else {
                   15207:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   15208:                     }
1.443     albertel 15209:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  15210:                     if ($sec eq '') {
                   15211:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   15212:                     } else {
                   15213:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   15214:                     }
1.443     albertel 15215:                 } else {
1.628     raeburn  15216:                     if ($sec eq '') {
                   15217:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   15218:                     } else {
                   15219:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   15220:                     }
1.443     albertel 15221:                 }
                   15222:             } else {
1.628     raeburn  15223:                 if ($secchange) {       
                   15224:                     $$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;
                   15225:                 } else {
                   15226:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   15227:                 }
1.443     albertel 15228:             }
                   15229:             $result = $modify_section_result;
                   15230:         } elsif ($secchange == 1) {
1.628     raeburn  15231:             if ($oldsec eq '') {
1.1075.2.20  raeburn  15232:                 $$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  15233:             } else {
                   15234:                 $$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;
                   15235:             }
1.626     raeburn  15236:             if ($expire_role_result eq 'refused') {
                   15237:                 my $newsecurl = '/'.$cid;
                   15238:                 $newsecurl =~ s/\_/\//g;
                   15239:                 if ($sec ne '') {
                   15240:                     $newsecurl.='/'.$sec;
                   15241:                 }
                   15242:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   15243:                     if ($sec eq '') {
                   15244:                         $$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;
                   15245:                     } else {
                   15246:                         $$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;
                   15247:                     }
                   15248:                 }
                   15249:             }
1.443     albertel 15250:         }
                   15251:     } else {
1.626     raeburn  15252:         $$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 15253:         $result = "error: incomplete course id\n";
                   15254:     }
                   15255:     return $result;
                   15256: }
                   15257: 
1.1075.2.25  raeburn  15258: sub show_role_extent {
                   15259:     my ($scope,$context,$role) = @_;
                   15260:     $scope =~ s{^/}{};
                   15261:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   15262:     push(@courseroles,'co');
                   15263:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   15264:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   15265:         $scope =~ s{/}{_};
                   15266:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   15267:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   15268:         my ($audom,$auname) = split(/\//,$scope);
                   15269:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   15270:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   15271:     } else {
                   15272:         $scope =~ s{/$}{};
                   15273:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   15274:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   15275:     }
                   15276: }
                   15277: 
1.443     albertel 15278: ############################################################
                   15279: ############################################################
                   15280: 
1.566     albertel 15281: sub check_clone {
1.578     raeburn  15282:     my ($args,$linefeed) = @_;
1.566     albertel 15283:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   15284:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   15285:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   15286:     my $clonemsg;
                   15287:     my $can_clone = 0;
1.944     raeburn  15288:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  15289:     if ($lctype ne 'community') {
                   15290:         $lctype = 'course';
                   15291:     }
1.566     albertel 15292:     if ($clonehome eq 'no_host') {
1.944     raeburn  15293:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  15294:             $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
                   15295:         } else {
                   15296:             $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
                   15297:         }     
1.566     albertel 15298:     } else {
                   15299: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  15300:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  15301:             if ($clonedesc{'type'} ne 'Community') {
                   15302:                  $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
                   15303:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   15304:             }
                   15305:         }
1.1075.2.119  raeburn  15306: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882     raeburn  15307:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 15308: 	    $can_clone = 1;
                   15309: 	} else {
1.1075.2.95  raeburn  15310: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566     albertel 15311: 						 $args->{'clonedomain'},$args->{'clonecourse'});
1.1075.2.95  raeburn  15312:             if ($clonehash{'cloners'} eq '') {
                   15313:                 my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
                   15314:                 if ($domdefs{'canclone'}) {
                   15315:                     unless ($domdefs{'canclone'} eq 'none') {
                   15316:                         if ($domdefs{'canclone'} eq 'domain') {
                   15317:                             if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
                   15318:                                 $can_clone = 1;
                   15319:                             }
                   15320:                         } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
                   15321:                                  ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                   15322:                             if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
                   15323:                                                                           $clonehash{'internal.coursecode'},$args->{'crscode'})) {
                   15324:                                 $can_clone = 1;
                   15325:                             }
                   15326:                         }
                   15327:                     }
1.908     raeburn  15328:                 }
1.1075.2.95  raeburn  15329:             } else {
                   15330: 	        my @cloners = split(/,/,$clonehash{'cloners'});
                   15331:                 if (grep(/^\*$/,@cloners)) {
1.942     raeburn  15332:                     $can_clone = 1;
1.1075.2.95  raeburn  15333:                 } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942     raeburn  15334:                     $can_clone = 1;
1.1075.2.96  raeburn  15335:                 } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   15336:                     $can_clone = 1;
1.1075.2.95  raeburn  15337:                 }
                   15338:                 unless ($can_clone) {
1.1075.2.96  raeburn  15339:                     if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
                   15340:                         ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
1.1075.2.95  raeburn  15341:                         my (%gotdomdefaults,%gotcodedefaults);
                   15342:                         foreach my $cloner (@cloners) {
                   15343:                             if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
                   15344:                                 ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
                   15345:                                 my (%codedefaults,@code_order);
                   15346:                                 if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
                   15347:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
                   15348:                                         %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
                   15349:                                     }
                   15350:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
                   15351:                                         @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
                   15352:                                     }
                   15353:                                 } else {
                   15354:                                     &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
                   15355:                                                                             \%codedefaults,
                   15356:                                                                             \@code_order);
                   15357:                                     $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
                   15358:                                     $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
                   15359:                                 }
                   15360:                                 if (@code_order > 0) {
                   15361:                                     if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
                   15362:                                                                                 $cloner,$clonehash{'internal.coursecode'},
                   15363:                                                                                 $args->{'crscode'})) {
                   15364:                                         $can_clone = 1;
                   15365:                                         last;
                   15366:                                     }
                   15367:                                 }
                   15368:                             }
                   15369:                         }
                   15370:                     }
1.1075.2.96  raeburn  15371:                 }
                   15372:             }
                   15373:             unless ($can_clone) {
                   15374:                 my $ccrole = 'cc';
                   15375:                 if ($args->{'crstype'} eq 'Community') {
                   15376:                     $ccrole = 'co';
                   15377:                 }
                   15378:                 my %roleshash =
                   15379:                     &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   15380:                                                   $args->{'ccdomain'},
                   15381:                                                   'userroles',['active'],[$ccrole],
                   15382:                                                   [$args->{'clonedomain'}]);
                   15383:                 if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
                   15384:                     $can_clone = 1;
                   15385:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
                   15386:                                                           $args->{'ccuname'},$args->{'ccdomain'})) {
                   15387:                     $can_clone = 1;
1.1075.2.95  raeburn  15388:                 }
                   15389:             }
                   15390:             unless ($can_clone) {
                   15391:                 if ($args->{'crstype'} eq 'Community') {
                   15392:                     $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
                   15393:                 } else {
                   15394:                     $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
1.578     raeburn  15395: 	        }
1.566     albertel 15396: 	    }
1.578     raeburn  15397:         }
1.566     albertel 15398:     }
                   15399:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   15400: }
                   15401: 
1.444     albertel 15402: sub construct_course {
1.1075.2.119  raeburn  15403:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
                   15404:         $cnum,$category,$coderef) = @_;
1.444     albertel 15405:     my $outcome;
1.541     raeburn  15406:     my $linefeed =  '<br />'."\n";
                   15407:     if ($context eq 'auto') {
                   15408:         $linefeed = "\n";
                   15409:     }
1.566     albertel 15410: 
                   15411: #
                   15412: # Are we cloning?
                   15413: #
                   15414:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   15415:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  15416: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 15417: 	if ($context ne 'auto') {
1.578     raeburn  15418:             if ($clonemsg ne '') {
                   15419: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   15420:             }
1.566     albertel 15421: 	}
                   15422: 	$outcome .= $clonemsg.$linefeed;
                   15423: 
                   15424:         if (!$can_clone) {
                   15425: 	    return (0,$outcome);
                   15426: 	}
                   15427:     }
                   15428: 
1.444     albertel 15429: #
                   15430: # Open course
                   15431: #
                   15432:     my $crstype = lc($args->{'crstype'});
                   15433:     my %cenv=();
                   15434:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   15435:                                              $args->{'cdescr'},
                   15436:                                              $args->{'curl'},
                   15437:                                              $args->{'course_home'},
                   15438:                                              $args->{'nonstandard'},
                   15439:                                              $args->{'crscode'},
                   15440:                                              $args->{'ccuname'}.':'.
                   15441:                                              $args->{'ccdomain'},
1.882     raeburn  15442:                                              $args->{'crstype'},
1.885     raeburn  15443:                                              $cnum,$context,$category);
1.444     albertel 15444: 
                   15445:     # Note: The testing routines depend on this being output; see 
                   15446:     # Utils::Course. This needs to at least be output as a comment
                   15447:     # if anyone ever decides to not show this, and Utils::Course::new
                   15448:     # will need to be suitably modified.
1.541     raeburn  15449:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  15450:     if ($$courseid =~ /^error:/) {
                   15451:         return (0,$outcome);
                   15452:     }
                   15453: 
1.444     albertel 15454: #
                   15455: # Check if created correctly
                   15456: #
1.479     albertel 15457:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 15458:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  15459:     if ($crsuhome eq 'no_host') {
                   15460:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   15461:         return (0,$outcome);
                   15462:     }
1.541     raeburn  15463:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 15464: 
1.444     albertel 15465: #
1.566     albertel 15466: # Do the cloning
                   15467: #   
                   15468:     if ($can_clone && $cloneid) {
                   15469: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   15470: 	if ($context ne 'auto') {
                   15471: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   15472: 	}
                   15473: 	$outcome .= $clonemsg.$linefeed;
                   15474: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 15475: # Copy all files
1.637     www      15476: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 15477: # Restore URL
1.566     albertel 15478: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 15479: # Restore title
1.566     albertel 15480: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  15481: # Restore creation date, creator and creation context.
                   15482:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   15483:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   15484:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 15485: # Mark as cloned
1.566     albertel 15486: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      15487: # Need to clone grading mode
                   15488:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   15489:         $cenv{'grading'}=$newenv{'grading'};
                   15490: # Do not clone these environment entries
                   15491:         &Apache::lonnet::del('environment',
                   15492:                   ['default_enrollment_start_date',
                   15493:                    'default_enrollment_end_date',
                   15494:                    'question.email',
                   15495:                    'policy.email',
                   15496:                    'comment.email',
                   15497:                    'pch.users.denied',
1.725     raeburn  15498:                    'plc.users.denied',
                   15499:                    'hidefromcat',
1.1075.2.36  raeburn  15500:                    'checkforpriv',
1.1075.2.158  raeburn  15501:                    'categories'],
1.638     www      15502:                    $$crsudom,$$crsunum);
1.1075.2.63  raeburn  15503:         if ($args->{'textbook'}) {
                   15504:             $cenv{'internal.textbook'} = $args->{'textbook'};
                   15505:         }
1.444     albertel 15506:     }
1.566     albertel 15507: 
1.444     albertel 15508: #
                   15509: # Set environment (will override cloned, if existing)
                   15510: #
                   15511:     my @sections = ();
                   15512:     my @xlists = ();
                   15513:     if ($args->{'crstype'}) {
                   15514:         $cenv{'type'}=$args->{'crstype'};
                   15515:     }
                   15516:     if ($args->{'crsid'}) {
                   15517:         $cenv{'courseid'}=$args->{'crsid'};
                   15518:     }
                   15519:     if ($args->{'crscode'}) {
                   15520:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   15521:     }
                   15522:     if ($args->{'crsquota'} ne '') {
                   15523:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   15524:     } else {
                   15525:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   15526:     }
                   15527:     if ($args->{'ccuname'}) {
                   15528:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   15529:                                         ':'.$args->{'ccdomain'};
                   15530:     } else {
                   15531:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   15532:     }
1.1075.2.31  raeburn  15533:     if ($args->{'defaultcredits'}) {
                   15534:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   15535:     }
1.444     albertel 15536:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   15537:     if ($args->{'crssections'}) {
                   15538:         $cenv{'internal.sectionnums'} = '';
                   15539:         if ($args->{'crssections'} =~ m/,/) {
                   15540:             @sections = split/,/,$args->{'crssections'};
                   15541:         } else {
                   15542:             $sections[0] = $args->{'crssections'};
                   15543:         }
                   15544:         if (@sections > 0) {
                   15545:             foreach my $item (@sections) {
                   15546:                 my ($sec,$gp) = split/:/,$item;
                   15547:                 my $class = $args->{'crscode'}.$sec;
                   15548:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   15549:                 $cenv{'internal.sectionnums'} .= $item.',';
                   15550:                 unless ($addcheck eq 'ok') {
1.1075.2.119  raeburn  15551:                     push(@badclasses,$class);
1.444     albertel 15552:                 }
                   15553:             }
                   15554:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   15555:         }
                   15556:     }
                   15557: # do not hide course coordinator from staff listing, 
                   15558: # even if privileged
                   15559:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36  raeburn  15560: # add course coordinator's domain to domains to check for privileged users
                   15561: # if different to course domain
                   15562:     if ($$crsudom ne $args->{'ccdomain'}) {
                   15563:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   15564:     }
1.444     albertel 15565: # add crosslistings
                   15566:     if ($args->{'crsxlist'}) {
                   15567:         $cenv{'internal.crosslistings'}='';
                   15568:         if ($args->{'crsxlist'} =~ m/,/) {
                   15569:             @xlists = split/,/,$args->{'crsxlist'};
                   15570:         } else {
                   15571:             $xlists[0] = $args->{'crsxlist'};
                   15572:         }
                   15573:         if (@xlists > 0) {
                   15574:             foreach my $item (@xlists) {
                   15575:                 my ($xl,$gp) = split/:/,$item;
                   15576:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   15577:                 $cenv{'internal.crosslistings'} .= $item.',';
                   15578:                 unless ($addcheck eq 'ok') {
1.1075.2.119  raeburn  15579:                     push(@badclasses,$xl);
1.444     albertel 15580:                 }
                   15581:             }
                   15582:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   15583:         }
                   15584:     }
                   15585:     if ($args->{'autoadds'}) {
                   15586:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   15587:     }
                   15588:     if ($args->{'autodrops'}) {
                   15589:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   15590:     }
                   15591: # check for notification of enrollment changes
                   15592:     my @notified = ();
                   15593:     if ($args->{'notify_owner'}) {
                   15594:         if ($args->{'ccuname'} ne '') {
                   15595:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   15596:         }
                   15597:     }
                   15598:     if ($args->{'notify_dc'}) {
                   15599:         if ($uname ne '') { 
1.630     raeburn  15600:             push(@notified,$uname.':'.$udom);
1.444     albertel 15601:         }
                   15602:     }
                   15603:     if (@notified > 0) {
                   15604:         my $notifylist;
                   15605:         if (@notified > 1) {
                   15606:             $notifylist = join(',',@notified);
                   15607:         } else {
                   15608:             $notifylist = $notified[0];
                   15609:         }
                   15610:         $cenv{'internal.notifylist'} = $notifylist;
                   15611:     }
                   15612:     if (@badclasses > 0) {
                   15613:         my %lt=&Apache::lonlocal::texthash(
1.1075.2.119  raeburn  15614:                 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
                   15615:                 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
                   15616:                 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444     albertel 15617:         );
1.1075.2.119  raeburn  15618:         my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
                   15619:                            &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  15620:         if ($context eq 'auto') {
                   15621:             $outcome .= $badclass_msg.$linefeed;
1.1075.2.119  raeburn  15622:         } else {
1.566     albertel 15623:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1075.2.119  raeburn  15624:         }
                   15625:         foreach my $item (@badclasses) {
1.541     raeburn  15626:             if ($context eq 'auto') {
1.1075.2.119  raeburn  15627:                 $outcome .= " - $item\n";
1.541     raeburn  15628:             } else {
1.1075.2.119  raeburn  15629:                 $outcome .= "<li>$item</li>\n";
1.541     raeburn  15630:             }
1.1075.2.119  raeburn  15631:         }
                   15632:         if ($context eq 'auto') {
                   15633:             $outcome .= $linefeed;
                   15634:         } else {
                   15635:             $outcome .= "</ul><br /><br /></div>\n";
                   15636:         }
1.444     albertel 15637:     }
                   15638:     if ($args->{'no_end_date'}) {
                   15639:         $args->{'endaccess'} = 0;
                   15640:     }
                   15641:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   15642:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   15643:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   15644:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   15645:     if ($args->{'showphotos'}) {
                   15646:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   15647:     }
                   15648:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   15649:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   15650:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   15651:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  15652:             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'); 
                   15653:             if ($context eq 'auto') {
                   15654:                 $outcome .= $krb_msg;
                   15655:             } else {
1.566     albertel 15656:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  15657:             }
                   15658:             $outcome .= $linefeed;
1.444     albertel 15659:         }
                   15660:     }
                   15661:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   15662:        if ($args->{'setpolicy'}) {
                   15663:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   15664:        }
                   15665:        if ($args->{'setcontent'}) {
                   15666:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   15667:        }
1.1075.2.110  raeburn  15668:        if ($args->{'setcomment'}) {
                   15669:            $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   15670:        }
1.444     albertel 15671:     }
                   15672:     if ($args->{'reshome'}) {
                   15673: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   15674: 	$cenv{'reshome'}=~s/\/+$/\//;
                   15675:     }
                   15676: #
                   15677: # course has keyed access
                   15678: #
                   15679:     if ($args->{'setkeys'}) {
                   15680:        $cenv{'keyaccess'}='yes';
                   15681:     }
                   15682: # if specified, key authority is not course, but user
                   15683: # only active if keyaccess is yes
                   15684:     if ($args->{'keyauth'}) {
1.487     albertel 15685: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   15686: 	$user = &LONCAPA::clean_username($user);
                   15687: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     15688: 	if ($user ne '' && $domain ne '') {
1.487     albertel 15689: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 15690: 	}
                   15691:     }
                   15692: 
1.1075.2.59  raeburn  15693: #
                   15694: #  generate and store uniquecode (available to course requester), if course should have one.
                   15695: #
                   15696:     if ($args->{'uniquecode'}) {
                   15697:         my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
                   15698:         if ($code) {
                   15699:             $cenv{'internal.uniquecode'} = $code;
                   15700:             my %crsinfo =
                   15701:                 &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
                   15702:             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   15703:                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   15704:                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
                   15705:             }
                   15706:             if (ref($coderef)) {
                   15707:                 $$coderef = $code;
                   15708:             }
                   15709:         }
                   15710:     }
                   15711: 
1.444     albertel 15712:     if ($args->{'disresdis'}) {
                   15713:         $cenv{'pch.roles.denied'}='st';
                   15714:     }
                   15715:     if ($args->{'disablechat'}) {
                   15716:         $cenv{'plc.roles.denied'}='st';
                   15717:     }
                   15718: 
                   15719:     # Record we've not yet viewed the Course Initialization Helper for this 
                   15720:     # course
                   15721:     $cenv{'course.helper.not.run'} = 1;
                   15722:     #
                   15723:     # Use new Randomseed
                   15724:     #
                   15725:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   15726:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   15727:     #
                   15728:     # The encryption code and receipt prefix for this course
                   15729:     #
                   15730:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   15731:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   15732:     #
                   15733:     # By default, use standard grading
                   15734:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   15735: 
1.541     raeburn  15736:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   15737:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 15738: #
                   15739: # Open all assignments
                   15740: #
                   15741:     if ($args->{'openall'}) {
1.1075.2.146  raeburn  15742:        my $opendate = time;
                   15743:        if ($args->{'openallfrom'} =~ /^\d+$/) {
                   15744:            $opendate = $args->{'openallfrom'};
                   15745:        }
1.444     albertel 15746:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
1.1075.2.146  raeburn  15747:        my %storecontent = ($storeunder         => $opendate,
1.444     albertel 15748:                            $storeunder.'.type' => 'date_start');
1.1075.2.146  raeburn  15749:        $outcome .= &mt('All assignments open starting [_1]',
                   15750:                        &Apache::lonlocal::locallocaltime($opendate)).': '.
                   15751:                    &Apache::lonnet::cput
                   15752:                        ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 15753:    }
                   15754: #
                   15755: # Set first page
                   15756: #
                   15757:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   15758: 	    || ($cloneid)) {
1.445     albertel 15759: 	use LONCAPA::map;
1.444     albertel 15760: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 15761: 
                   15762: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   15763:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   15764: 
1.444     albertel 15765:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   15766:         my $title; my $url;
                   15767:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   15768: 	    $title=&mt('Syllabus');
1.444     albertel 15769:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   15770:         } else {
1.963     raeburn  15771:             $title=&mt('Table of Contents');
1.444     albertel 15772:             $url='/adm/navmaps';
                   15773:         }
1.445     albertel 15774: 
                   15775:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   15776: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   15777: 
                   15778: 	if ($errtext) { $fatal=2; }
1.541     raeburn  15779:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 15780:     }
1.566     albertel 15781: 
                   15782:     return (1,$outcome);
1.444     albertel 15783: }
                   15784: 
1.1075.2.59  raeburn  15785: sub make_unique_code {
                   15786:     my ($cdom,$cnum) = @_;
                   15787:     # get lock on uniquecodes db
                   15788:     my $lockhash = {
                   15789:                       $cnum."\0".'uniquecodes' => $env{'user.name'}.
                   15790:                                                   ':'.$env{'user.domain'},
                   15791:                    };
                   15792:     my $tries = 0;
                   15793:     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   15794:     my ($code,$error);
                   15795: 
                   15796:     while (($gotlock ne 'ok') && ($tries<3)) {
                   15797:         $tries ++;
                   15798:         sleep 1;
                   15799:         $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   15800:     }
                   15801:     if ($gotlock eq 'ok') {
                   15802:         my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
                   15803:         my $gotcode;
                   15804:         my $attempts = 0;
                   15805:         while ((!$gotcode) && ($attempts < 100)) {
                   15806:             $code = &generate_code();
                   15807:             if (!exists($currcodes{$code})) {
                   15808:                 $gotcode = 1;
                   15809:                 unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                   15810:                     $error = 'nostore';
                   15811:                 }
                   15812:             }
                   15813:             $attempts ++;
                   15814:         }
                   15815:         my @del_lock = ($cnum."\0".'uniquecodes');
                   15816:         my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
                   15817:     } else {
                   15818:         $error = 'nolock';
                   15819:     }
                   15820:     return ($code,$error);
                   15821: }
                   15822: 
                   15823: sub generate_code {
                   15824:     my $code;
                   15825:     my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
                   15826:     for (my $i=0; $i<6; $i++) {
                   15827:         my $lettnum = int (rand 2);
                   15828:         my $item = '';
                   15829:         if ($lettnum) {
                   15830:             $item = $letts[int( rand(18) )];
                   15831:         } else {
                   15832:             $item = 1+int( rand(8) );
                   15833:         }
                   15834:         $code .= $item;
                   15835:     }
                   15836:     return $code;
                   15837: }
                   15838: 
1.444     albertel 15839: ############################################################
                   15840: ############################################################
                   15841: 
1.953     droeschl 15842: #SD
                   15843: # only Community and Course, or anything else?
1.378     raeburn  15844: sub course_type {
                   15845:     my ($cid) = @_;
                   15846:     if (!defined($cid)) {
                   15847:         $cid = $env{'request.course.id'};
                   15848:     }
1.404     albertel 15849:     if (defined($env{'course.'.$cid.'.type'})) {
                   15850:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  15851:     } else {
                   15852:         return 'Course';
1.377     raeburn  15853:     }
                   15854: }
1.156     albertel 15855: 
1.406     raeburn  15856: sub group_term {
                   15857:     my $crstype = &course_type();
                   15858:     my %names = (
                   15859:                   'Course' => 'group',
1.865     raeburn  15860:                   'Community' => 'group',
1.406     raeburn  15861:                 );
                   15862:     return $names{$crstype};
                   15863: }
                   15864: 
1.902     raeburn  15865: sub course_types {
1.1075.2.59  raeburn  15866:     my @types = ('official','unofficial','community','textbook');
1.902     raeburn  15867:     my %typename = (
                   15868:                          official   => 'Official course',
                   15869:                          unofficial => 'Unofficial course',
                   15870:                          community  => 'Community',
1.1075.2.59  raeburn  15871:                          textbook   => 'Textbook course',
1.902     raeburn  15872:                    );
                   15873:     return (\@types,\%typename);
                   15874: }
                   15875: 
1.156     albertel 15876: sub icon {
                   15877:     my ($file)=@_;
1.505     albertel 15878:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 15879:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 15880:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 15881:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   15882: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   15883: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   15884: 	            $curfext.".gif") {
                   15885: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   15886: 		$curfext.".gif";
                   15887: 	}
                   15888:     }
1.249     albertel 15889:     return &lonhttpdurl($iconname);
1.154     albertel 15890: } 
1.84      albertel 15891: 
1.575     albertel 15892: sub lonhttpdurl {
1.692     www      15893: #
                   15894: # Had been used for "small fry" static images on separate port 8080.
                   15895: # Modify here if lightweight http functionality desired again.
                   15896: # Currently eliminated due to increasing firewall issues.
                   15897: #
1.575     albertel 15898:     my ($url)=@_;
1.692     www      15899:     return $url;
1.215     albertel 15900: }
                   15901: 
1.213     albertel 15902: sub connection_aborted {
                   15903:     my ($r)=@_;
                   15904:     $r->print(" ");$r->rflush();
                   15905:     my $c = $r->connection;
                   15906:     return $c->aborted();
                   15907: }
                   15908: 
1.221     foxr     15909: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     15910: #    strings as 'strings'.
                   15911: sub escape_single {
1.221     foxr     15912:     my ($input) = @_;
1.223     albertel 15913:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     15914:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   15915:     return $input;
                   15916: }
1.223     albertel 15917: 
1.222     foxr     15918: #  Same as escape_single, but escape's "'s  This 
                   15919: #  can be used for  "strings"
                   15920: sub escape_double {
                   15921:     my ($input) = @_;
                   15922:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   15923:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   15924:     return $input;
                   15925: }
1.223     albertel 15926:  
1.222     foxr     15927: #   Escapes the last element of a full URL.
                   15928: sub escape_url {
                   15929:     my ($url)   = @_;
1.238     raeburn  15930:     my @urlslices = split(/\//, $url,-1);
1.369     www      15931:     my $lastitem = &escape(pop(@urlslices));
1.1075.2.83  raeburn  15932:     return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222     foxr     15933: }
1.462     albertel 15934: 
1.820     raeburn  15935: sub compare_arrays {
                   15936:     my ($arrayref1,$arrayref2) = @_;
                   15937:     my (@difference,%count);
                   15938:     @difference = ();
                   15939:     %count = ();
                   15940:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   15941:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   15942:         foreach my $element (keys(%count)) {
                   15943:             if ($count{$element} == 1) {
                   15944:                 push(@difference,$element);
                   15945:             }
                   15946:         }
                   15947:     }
                   15948:     return @difference;
                   15949: }
                   15950: 
1.1075.2.152  raeburn  15951: sub lon_status_items {
                   15952:     my %defaults = (
                   15953:                      E         => 100,
                   15954:                      W         => 4,
                   15955:                      N         => 1,
                   15956:                      U         => 5,
                   15957:                      threshold => 200,
                   15958:                      sysmail   => 2500,
                   15959:                    );
                   15960:     my %names = (
                   15961:                    E => 'Errors',
                   15962:                    W => 'Warnings',
                   15963:                    N => 'Notices',
                   15964:                    U => 'Unsent',
                   15965:                 );
                   15966:     return (\%defaults,\%names);
                   15967: }
                   15968: 
1.817     bisitz   15969: # -------------------------------------------------------- Initialize user login
1.462     albertel 15970: sub init_user_environment {
1.463     albertel 15971:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 15972:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   15973: 
                   15974:     my $public=($username eq 'public' && $domain eq 'public');
                   15975: 
                   15976: # See if old ID present, if so, remove
                   15977: 
1.1062    raeburn  15978:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 15979:     my $now=time;
                   15980: 
                   15981:     if ($public) {
                   15982: 	my $max_public=100;
                   15983: 	my $oldest;
                   15984: 	my $oldest_time=0;
                   15985: 	for(my $next=1;$next<=$max_public;$next++) {
                   15986: 	    if (-e $lonids."/publicuser_$next.id") {
                   15987: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   15988: 		if ($mtime<$oldest_time || !$oldest_time) {
                   15989: 		    $oldest_time=$mtime;
                   15990: 		    $oldest=$next;
                   15991: 		}
                   15992: 	    } else {
                   15993: 		$cookie="publicuser_$next";
                   15994: 		last;
                   15995: 	    }
                   15996: 	}
                   15997: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   15998:     } else {
1.463     albertel 15999: 	# if this isn't a robot, kill any existing non-robot sessions
                   16000: 	if (!$args->{'robot'}) {
                   16001: 	    opendir(DIR,$lonids);
                   16002: 	    while ($filename=readdir(DIR)) {
                   16003: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1075.2.136  raeburn  16004:                     if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
                   16005:                             &GDBM_READER(),0640)) {
                   16006:                         my $linkedfile;
                   16007:                         if (exists($oldenv{'user.linkedenv'})) {
                   16008:                             $linkedfile = $oldenv{'user.linkedenv'};
                   16009:                         }
                   16010:                         untie(%oldenv);
                   16011:                         if (unlink("$lonids/$filename")) {
                   16012:                             if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
                   16013:                                 if (-l "$lonids/$linkedfile.id") {
                   16014:                                     unlink("$lonids/$linkedfile.id");
                   16015:                                 }
                   16016:                             }
                   16017:                         }
                   16018:                     } else {
                   16019:                         unlink($lonids.'/'.$filename);
                   16020:                     }
1.463     albertel 16021: 		}
1.462     albertel 16022: 	    }
1.463     albertel 16023: 	    closedir(DIR);
1.1075.2.84  raeburn  16024: # If there is a undeleted lockfile for the user's paste buffer remove it.
                   16025:             my $namespace = 'nohist_courseeditor';
                   16026:             my $lockingkey = 'paste'."\0".'locked_num';
                   16027:             my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
                   16028:                                                 $domain,$username);
                   16029:             if (exists($lockhash{$lockingkey})) {
                   16030:                 my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
                   16031:                 unless ($delresult eq 'ok') {
                   16032:                     &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
                   16033:                 }
                   16034:             }
1.462     albertel 16035: 	}
                   16036: # Give them a new cookie
1.463     albertel 16037: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      16038: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 16039: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 16040:     
                   16041: # Initialize roles
                   16042: 
1.1062    raeburn  16043: 	($userroles,$firstaccenv,$timerintenv) = 
                   16044:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 16045:     }
                   16046: # ------------------------------------ Check browser type and MathML capability
                   16047: 
1.1075.2.77  raeburn  16048:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
                   16049:         $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462     albertel 16050: 
                   16051: # ------------------------------------------------------------- Get environment
                   16052: 
                   16053:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   16054:     my ($tmp) = keys(%userenv);
                   16055:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   16056:     } else {
                   16057: 	undef(%userenv);
                   16058:     }
                   16059:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   16060: 	$form->{'interface'}=$userenv{'interface'};
                   16061:     }
                   16062:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   16063: 
                   16064: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   16065:     foreach my $option ('interface','localpath','localres') {
                   16066:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 16067:     }
                   16068: # --------------------------------------------------------- Write first profile
                   16069: 
                   16070:     {
1.1075.2.150  raeburn  16071:         my $ip = &Apache::lonnet::get_requestor_ip();
1.462     albertel 16072: 	my %initial_env = 
                   16073: 	    ("user.name"          => $username,
                   16074: 	     "user.domain"        => $domain,
                   16075: 	     "user.home"          => $authhost,
                   16076: 	     "browser.type"       => $clientbrowser,
                   16077: 	     "browser.version"    => $clientversion,
                   16078: 	     "browser.mathml"     => $clientmathml,
                   16079: 	     "browser.unicode"    => $clientunicode,
                   16080: 	     "browser.os"         => $clientos,
1.1075.2.42  raeburn  16081:              "browser.mobile"     => $clientmobile,
                   16082:              "browser.info"       => $clientinfo,
1.1075.2.77  raeburn  16083:              "browser.osversion"  => $clientosversion,
1.462     albertel 16084: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   16085: 	     "request.course.fn"  => '',
                   16086: 	     "request.course.uri" => '',
                   16087: 	     "request.course.sec" => '',
                   16088: 	     "request.role"       => 'cm',
                   16089: 	     "request.role.adv"   => $env{'user.adv'},
1.1075.2.150  raeburn  16090: 	     "request.host"       => $ip,);
1.462     albertel 16091: 
                   16092:         if ($form->{'localpath'}) {
                   16093: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   16094: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   16095:         }
                   16096: 	
                   16097: 	if ($form->{'interface'}) {
                   16098: 	    $form->{'interface'}=~s/\W//gs;
                   16099: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   16100: 	    $env{'browser.interface'}=$form->{'interface'};
                   16101: 	}
                   16102: 
1.1075.2.54  raeburn  16103:         if ($form->{'iptoken'}) {
                   16104:             my $lonhost = $r->dir_config('lonHostID');
                   16105:             $initial_env{"user.noloadbalance"} = $lonhost;
                   16106:             $env{'user.noloadbalance'} = $lonhost;
                   16107:         }
                   16108: 
1.1075.2.120  raeburn  16109:         if ($form->{'noloadbalance'}) {
                   16110:             my @hosts = &Apache::lonnet::current_machine_ids();
                   16111:             my $hosthere = $form->{'noloadbalance'};
                   16112:             if (grep(/^\Q$hosthere\E$/,@hosts)) {
                   16113:                 $initial_env{"user.noloadbalance"} = $hosthere;
                   16114:                 $env{'user.noloadbalance'} = $hosthere;
                   16115:             }
                   16116:         }
                   16117: 
1.1016    raeburn  16118:         unless ($domain eq 'public') {
1.1075.2.125  raeburn  16119:             my %is_adv = ( is_adv => $env{'user.adv'} );
                   16120:             my %domdef = &Apache::lonnet::get_domain_defaults($domain);
1.980     raeburn  16121: 
1.1075.2.125  raeburn  16122:             foreach my $tool ('aboutme','blog','webdav','portfolio') {
                   16123:                 $userenv{'availabletools.'.$tool} = 
                   16124:                     &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   16125:                                                       undef,\%userenv,\%domdef,\%is_adv);
                   16126:             }
1.724     raeburn  16127: 
1.1075.2.125  raeburn  16128:             foreach my $crstype ('official','unofficial','community','textbook') {
                   16129:                 $userenv{'canrequest.'.$crstype} =
                   16130:                     &Apache::lonnet::usertools_access($username,$domain,$crstype,
                   16131:                                                       'reload','requestcourses',
                   16132:                                                       \%userenv,\%domdef,\%is_adv);
                   16133:             }
1.765     raeburn  16134: 
1.1075.2.125  raeburn  16135:             $userenv{'canrequest.author'} =
                   16136:                 &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   16137:                                                   'reload','requestauthor',
                   16138:                                                   \%userenv,\%domdef,\%is_adv);
                   16139:             my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   16140:                                                  $domain,$username);
                   16141:             my $reqstatus = $reqauthor{'author_status'};
                   16142:             if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
                   16143:                 if (ref($reqauthor{'author'}) eq 'HASH') {
                   16144:                     $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   16145:                                                       $reqauthor{'author'}{'timestamp'};
                   16146:                 }
1.1075.2.14  raeburn  16147:             }
                   16148:         }
                   16149: 
1.462     albertel 16150: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  16151: 
1.462     albertel 16152: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   16153: 		 &GDBM_WRCREAT(),0640)) {
                   16154: 	    &_add_to_env(\%disk_env,\%initial_env);
                   16155: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   16156: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  16157:             if (ref($firstaccenv) eq 'HASH') {
                   16158:                 &_add_to_env(\%disk_env,$firstaccenv);
                   16159:             }
                   16160:             if (ref($timerintenv) eq 'HASH') {
                   16161:                 &_add_to_env(\%disk_env,$timerintenv);
                   16162:             }
1.463     albertel 16163: 	    if (ref($args->{'extra_env'})) {
                   16164: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   16165: 	    }
1.462     albertel 16166: 	    untie(%disk_env);
                   16167: 	} else {
1.705     tempelho 16168: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   16169: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 16170: 	    return 'error: '.$!;
                   16171: 	}
                   16172:     }
                   16173:     $env{'request.role'}='cm';
                   16174:     $env{'request.role.adv'}=$env{'user.adv'};
                   16175:     $env{'browser.type'}=$clientbrowser;
                   16176: 
                   16177:     return $cookie;
                   16178: 
                   16179: }
                   16180: 
                   16181: sub _add_to_env {
                   16182:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  16183:     if (ref($env_data) eq 'HASH') {
                   16184:         while (my ($key,$value) = each(%$env_data)) {
                   16185: 	    $idf->{$prefix.$key} = $value;
                   16186: 	    $env{$prefix.$key}   = $value;
                   16187:         }
1.462     albertel 16188:     }
                   16189: }
                   16190: 
1.685     tempelho 16191: # --- Get the symbolic name of a problem and the url
                   16192: sub get_symb {
                   16193:     my ($request,$silent) = @_;
1.726     raeburn  16194:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 16195:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   16196:     if ($symb eq '') {
                   16197:         if (!$silent) {
1.1071    raeburn  16198:             if (ref($request)) { 
                   16199:                 $request->print("Unable to handle ambiguous references:$url:.");
                   16200:             }
1.685     tempelho 16201:             return ();
                   16202:         }
                   16203:     }
                   16204:     &Apache::lonenc::check_decrypt(\$symb);
                   16205:     return ($symb);
                   16206: }
                   16207: 
                   16208: # --------------------------------------------------------------Get annotation
                   16209: 
                   16210: sub get_annotation {
                   16211:     my ($symb,$enc) = @_;
                   16212: 
                   16213:     my $key = $symb;
                   16214:     if (!$enc) {
                   16215:         $key =
                   16216:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   16217:     }
                   16218:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   16219:     return $annotation{$key};
                   16220: }
                   16221: 
                   16222: sub clean_symb {
1.731     raeburn  16223:     my ($symb,$delete_enc) = @_;
1.685     tempelho 16224: 
                   16225:     &Apache::lonenc::check_decrypt(\$symb);
                   16226:     my $enc = $env{'request.enc'};
1.731     raeburn  16227:     if ($delete_enc) {
1.730     raeburn  16228:         delete($env{'request.enc'});
                   16229:     }
1.685     tempelho 16230: 
                   16231:     return ($symb,$enc);
                   16232: }
1.462     albertel 16233: 
1.1075.2.69  raeburn  16234: ############################################################
                   16235: ############################################################
                   16236: 
                   16237: =pod
                   16238: 
                   16239: =head1 Routines for building display used to search for courses
                   16240: 
                   16241: 
                   16242: =over 4
                   16243: 
                   16244: =item * &build_filters()
                   16245: 
                   16246: Create markup for a table used to set filters to use when selecting
                   16247: courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
                   16248: and quotacheck.pl
                   16249: 
                   16250: 
                   16251: Inputs:
                   16252: 
                   16253: filterlist - anonymous array of fields to include as potential filters
                   16254: 
                   16255: crstype - course type
                   16256: 
                   16257: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                   16258:               to pop-open a course selector (will contain "extra element").
                   16259: 
                   16260: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
                   16261: 
                   16262: filter - anonymous hash of criteria and their values
                   16263: 
                   16264: action - form action
                   16265: 
                   16266: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
                   16267: 
                   16268: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
                   16269: 
                   16270: cloneruname - username of owner of new course who wants to clone
                   16271: 
                   16272: clonerudom - domain of owner of new course who wants to clone
                   16273: 
                   16274: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
                   16275: 
                   16276: codetitlesref - reference to array of titles of components in institutional codes (official courses)
                   16277: 
                   16278: codedom - domain
                   16279: 
                   16280: formname - value of form element named "form".
                   16281: 
                   16282: fixeddom - domain, if fixed.
                   16283: 
                   16284: prevphase - value to assign to form element named "phase" when going back to the previous screen
                   16285: 
                   16286: cnameelement - name of form element in form on opener page which will receive title of selected course
                   16287: 
                   16288: cnumelement - name of form element in form on opener page which will receive courseID  of selected course
                   16289: 
                   16290: cdomelement - name of form element in form on opener page which will receive domain of selected course
                   16291: 
                   16292: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
                   16293: 
                   16294: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
                   16295: 
                   16296: clonewarning - warning message about missing information for intended course owner when DC creates a course
                   16297: 
                   16298: 
                   16299: Returns: $output - HTML for display of search criteria, and hidden form elements.
                   16300: 
                   16301: 
                   16302: Side Effects: None
                   16303: 
                   16304: =cut
                   16305: 
                   16306: # ---------------------------------------------- search for courses based on last activity etc.
                   16307: 
                   16308: sub build_filters {
                   16309:     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
                   16310:         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
                   16311:         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
                   16312:         $cnameelement,$cnumelement,$cdomelement,$setroles,
                   16313:         $clonetext,$clonewarning) = @_;
                   16314:     my ($list,$jscript);
                   16315:     my $onchange = 'javascript:updateFilters(this)';
                   16316:     my ($domainselectform,$sincefilterform,$createdfilterform,
                   16317:         $ownerdomselectform,$persondomselectform,$instcodeform,
                   16318:         $typeselectform,$instcodetitle);
                   16319:     if ($formname eq '') {
                   16320:         $formname = $caller;
                   16321:     }
                   16322:     foreach my $item (@{$filterlist}) {
                   16323:         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   16324:                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
                   16325:             if ($item eq 'domainfilter') {
                   16326:                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
                   16327:             } elsif ($item eq 'coursefilter') {
                   16328:                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
                   16329:             } elsif ($item eq 'ownerfilter') {
                   16330:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   16331:             } elsif ($item eq 'ownerdomfilter') {
                   16332:                 $filter->{'ownerdomfilter'} =
                   16333:                     &LONCAPA::clean_domain($filter->{$item});
                   16334:                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                   16335:                                                        'ownerdomfilter',1);
                   16336:             } elsif ($item eq 'personfilter') {
                   16337:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   16338:             } elsif ($item eq 'persondomfilter') {
                   16339:                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                   16340:                                                         'persondomfilter',1);
                   16341:             } else {
                   16342:                 $filter->{$item} =~ s/\W//g;
                   16343:             }
                   16344:             if (!$filter->{$item}) {
                   16345:                 $filter->{$item} = '';
                   16346:             }
                   16347:         }
                   16348:         if ($item eq 'domainfilter') {
                   16349:             my $allow_blank = 1;
                   16350:             if ($formname eq 'portform') {
                   16351:                 $allow_blank=0;
                   16352:             } elsif ($formname eq 'studentform') {
                   16353:                 $allow_blank=0;
                   16354:             }
                   16355:             if ($fixeddom) {
                   16356:                 $domainselectform = '<input type="hidden" name="domainfilter"'.
                   16357:                                     ' value="'.$codedom.'" />'.
                   16358:                                     &Apache::lonnet::domain($codedom,'description');
                   16359:             } else {
                   16360:                 $domainselectform = &select_dom_form($filter->{$item},
                   16361:                                                      'domainfilter',
                   16362:                                                       $allow_blank,'',$onchange);
                   16363:             }
                   16364:         } else {
                   16365:             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
                   16366:         }
                   16367:     }
                   16368: 
                   16369:     # last course activity filter and selection
                   16370:     $sincefilterform = &timebased_select_form('sincefilter',$filter);
                   16371: 
                   16372:     # course created filter and selection
                   16373:     if (exists($filter->{'createdfilter'})) {
                   16374:         $createdfilterform = &timebased_select_form('createdfilter',$filter);
                   16375:     }
                   16376: 
                   16377:     my %lt = &Apache::lonlocal::texthash(
                   16378:                 'cac' => "$crstype Activity",
                   16379:                 'ccr' => "$crstype Created",
                   16380:                 'cde' => "$crstype Title",
                   16381:                 'cdo' => "$crstype Domain",
                   16382:                 'ins' => 'Institutional Code',
                   16383:                 'inc' => 'Institutional Categorization',
                   16384:                 'cow' => "$crstype Owner/Co-owner",
                   16385:                 'cop' => "$crstype Personnel Includes",
                   16386:                 'cog' => 'Type',
                   16387:              );
                   16388: 
                   16389:     if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   16390:         my $typeval = 'Course';
                   16391:         if ($crstype eq 'Community') {
                   16392:             $typeval = 'Community';
                   16393:         }
                   16394:         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
                   16395:     } else {
                   16396:         $typeselectform =  '<select name="type" size="1"';
                   16397:         if ($onchange) {
                   16398:             $typeselectform .= ' onchange="'.$onchange.'"';
                   16399:         }
                   16400:         $typeselectform .= '>'."\n";
                   16401:         foreach my $posstype ('Course','Community') {
                   16402:             $typeselectform.='<option value="'.$posstype.'"'.
                   16403:                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
                   16404:         }
                   16405:         $typeselectform.="</select>";
                   16406:     }
                   16407: 
                   16408:     my ($cloneableonlyform,$cloneabletitle);
                   16409:     if (exists($filter->{'cloneableonly'})) {
                   16410:         my $cloneableon = '';
                   16411:         my $cloneableoff = ' checked="checked"';
                   16412:         if ($filter->{'cloneableonly'}) {
                   16413:             $cloneableon = $cloneableoff;
                   16414:             $cloneableoff = '';
                   16415:         }
                   16416:         $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>';
                   16417:         if ($formname eq 'ccrs') {
1.1075.2.71  raeburn  16418:             $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1075.2.69  raeburn  16419:         } else {
                   16420:             $cloneabletitle = &mt('Cloneable by you');
                   16421:         }
                   16422:     }
                   16423:     my $officialjs;
                   16424:     if ($crstype eq 'Course') {
                   16425:         if (exists($filter->{'instcodefilter'})) {
                   16426: #            if (($fixeddom) || ($formname eq 'requestcrs') ||
                   16427: #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
                   16428:             if ($codedom) {
                   16429:                 $officialjs = 1;
                   16430:                 ($instcodeform,$jscript,$$numtitlesref) =
                   16431:                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                   16432:                                                                   $officialjs,$codetitlesref);
                   16433:                 if ($jscript) {
                   16434:                     $jscript = '<script type="text/javascript">'."\n".
                   16435:                                '// <![CDATA['."\n".
                   16436:                                $jscript."\n".
                   16437:                                '// ]]>'."\n".
                   16438:                                '</script>'."\n";
                   16439:                 }
                   16440:             }
                   16441:             if ($instcodeform eq '') {
                   16442:                 $instcodeform =
                   16443:                     '<input type="text" name="instcodefilter" size="10" value="'.
                   16444:                     $list->{'instcodefilter'}.'" />';
                   16445:                 $instcodetitle = $lt{'ins'};
                   16446:             } else {
                   16447:                 $instcodetitle = $lt{'inc'};
                   16448:             }
                   16449:             if ($fixeddom) {
                   16450:                 $instcodetitle .= '<br />('.$codedom.')';
                   16451:             }
                   16452:         }
                   16453:     }
                   16454:     my $output = qq|
                   16455: <form method="post" name="filterpicker" action="$action">
                   16456: <input type="hidden" name="form" value="$formname" />
                   16457: |;
                   16458:     if ($formname eq 'modifycourse') {
                   16459:         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                   16460:                    '<input type="hidden" name="prevphase" value="'.
                   16461:                    $prevphase.'" />'."\n";
1.1075.2.82  raeburn  16462:     } elsif ($formname eq 'quotacheck') {
                   16463:         $output .= qq|
                   16464: <input type="hidden" name="sortby" value="" />
                   16465: <input type="hidden" name="sortorder" value="" />
                   16466: |;
                   16467:     } else {
1.1075.2.69  raeburn  16468:         my $name_input;
                   16469:         if ($cnameelement ne '') {
                   16470:             $name_input = '<input type="hidden" name="cnameelement" value="'.
                   16471:                           $cnameelement.'" />';
                   16472:         }
                   16473:         $output .= qq|
                   16474: <input type="hidden" name="cnumelement" value="$cnumelement" />
                   16475: <input type="hidden" name="cdomelement" value="$cdomelement" />
                   16476: $name_input
                   16477: $roleelement
                   16478: $multelement
                   16479: $typeelement
                   16480: |;
                   16481:         if ($formname eq 'portform') {
                   16482:             $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
                   16483:         }
                   16484:     }
                   16485:     if ($fixeddom) {
                   16486:         $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
                   16487:     }
                   16488:     $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
                   16489:     if ($sincefilterform) {
                   16490:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                   16491:                   .$sincefilterform
                   16492:                   .&Apache::lonhtmlcommon::row_closure();
                   16493:     }
                   16494:     if ($createdfilterform) {
                   16495:         $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                   16496:                   .$createdfilterform
                   16497:                   .&Apache::lonhtmlcommon::row_closure();
                   16498:     }
                   16499:     if ($domainselectform) {
                   16500:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                   16501:                   .$domainselectform
                   16502:                   .&Apache::lonhtmlcommon::row_closure();
                   16503:     }
                   16504:     if ($typeselectform) {
                   16505:         if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   16506:             $output .= $typeselectform;
                   16507:         } else {
                   16508:             $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                   16509:                       .$typeselectform
                   16510:                       .&Apache::lonhtmlcommon::row_closure();
                   16511:         }
                   16512:     }
                   16513:     if ($instcodeform) {
                   16514:         $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                   16515:                   .$instcodeform
                   16516:                   .&Apache::lonhtmlcommon::row_closure();
                   16517:     }
                   16518:     if (exists($filter->{'ownerfilter'})) {
                   16519:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                   16520:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   16521:                    '<input type="text" name="ownerfilter" size="20" value="'.
                   16522:                    $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   16523:                    $ownerdomselectform.'</td></tr></table>'.
                   16524:                    &Apache::lonhtmlcommon::row_closure();
                   16525:     }
                   16526:     if (exists($filter->{'personfilter'})) {
                   16527:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                   16528:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   16529:                    '<input type="text" name="personfilter" size="20" value="'.
                   16530:                    $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   16531:                    $persondomselectform.'</td></tr></table>'.
                   16532:                    &Apache::lonhtmlcommon::row_closure();
                   16533:     }
                   16534:     if (exists($filter->{'coursefilter'})) {
                   16535:         $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                   16536:                   .'<input type="text" name="coursefilter" size="25" value="'
                   16537:                   .$list->{'coursefilter'}.'" />'
                   16538:                   .&Apache::lonhtmlcommon::row_closure();
                   16539:     }
                   16540:     if ($cloneableonlyform) {
                   16541:         $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                   16542:                    $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
                   16543:     }
                   16544:     if (exists($filter->{'descriptfilter'})) {
                   16545:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                   16546:                   .'<input type="text" name="descriptfilter" size="40" value="'
                   16547:                   .$list->{'descriptfilter'}.'" />'
                   16548:                   .&Apache::lonhtmlcommon::row_closure(1);
                   16549:     }
                   16550:     $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                   16551:                '<input type="hidden" name="updater" value="" />'."\n".
                   16552:                '<input type="submit" name="gosearch" value="'.
                   16553:                &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
                   16554:     return $jscript.$clonewarning.$output;
                   16555: }
                   16556: 
                   16557: =pod
                   16558: 
                   16559: =item * &timebased_select_form()
                   16560: 
                   16561: Create markup for a dropdown list used to select a time-based
                   16562: filter e.g., Course Activity, Course Created, when searching for courses
                   16563: or communities
                   16564: 
                   16565: Inputs:
                   16566: 
                   16567: item - name of form element (sincefilter or createdfilter)
                   16568: 
                   16569: filter - anonymous hash of criteria and their values
                   16570: 
                   16571: Returns: HTML for a select box contained a blank, then six time selections,
                   16572:          with value set in incoming form variables currently selected.
                   16573: 
                   16574: Side Effects: None
                   16575: 
                   16576: =cut
                   16577: 
                   16578: sub timebased_select_form {
                   16579:     my ($item,$filter) = @_;
                   16580:     if (ref($filter) eq 'HASH') {
                   16581:         $filter->{$item} =~ s/[^\d-]//g;
                   16582:         if (!$filter->{$item}) { $filter->{$item}=-1; }
                   16583:         return &select_form(
                   16584:                             $filter->{$item},
                   16585:                             $item,
                   16586:                             {      '-1' => '',
                   16587:                                 '86400' => &mt('today'),
                   16588:                                '604800' => &mt('last week'),
                   16589:                               '2592000' => &mt('last month'),
                   16590:                               '7776000' => &mt('last three months'),
                   16591:                              '15552000' => &mt('last six months'),
                   16592:                              '31104000' => &mt('last year'),
                   16593:                     'select_form_order' =>
                   16594:                            ['-1','86400','604800','2592000','7776000',
                   16595:                             '15552000','31104000']});
                   16596:     }
                   16597: }
                   16598: 
                   16599: =pod
                   16600: 
                   16601: =item * &js_changer()
                   16602: 
                   16603: Create script tag containing Javascript used to submit course search form
                   16604: when course type or domain is changed, and also to hide 'Searching ...' on
                   16605: page load completion for page showing search result.
                   16606: 
                   16607: Inputs: None
                   16608: 
                   16609: Returns: markup containing updateFilters() and hideSearching() javascript functions.
                   16610: 
                   16611: Side Effects: None
                   16612: 
                   16613: =cut
                   16614: 
                   16615: sub js_changer {
                   16616:     return <<ENDJS;
                   16617: <script type="text/javascript">
                   16618: // <![CDATA[
                   16619: function updateFilters(caller) {
                   16620:     if (typeof(caller) != "undefined") {
                   16621:         document.filterpicker.updater.value = caller.name;
                   16622:     }
                   16623:     document.filterpicker.submit();
                   16624: }
                   16625: 
                   16626: function hideSearching() {
                   16627:     if (document.getElementById('searching')) {
                   16628:         document.getElementById('searching').style.display = 'none';
                   16629:     }
                   16630:     return;
                   16631: }
                   16632: 
                   16633: // ]]>
                   16634: </script>
                   16635: 
                   16636: ENDJS
                   16637: }
                   16638: 
                   16639: =pod
                   16640: 
                   16641: =item * &search_courses()
                   16642: 
                   16643: Process selected filters form course search form and pass to lonnet::courseiddump
                   16644: to retrieve a hash for which keys are courseIDs which match the selected filters.
                   16645: 
                   16646: Inputs:
                   16647: 
                   16648: dom - domain being searched
                   16649: 
                   16650: type - course type ('Course' or 'Community' or '.' if any).
                   16651: 
                   16652: filter - anonymous hash of criteria and their values
                   16653: 
                   16654: numtitles - for institutional codes - number of categories
                   16655: 
                   16656: cloneruname - optional username of new course owner
                   16657: 
                   16658: clonerudom - optional domain of new course owner
                   16659: 
1.1075.2.95  raeburn  16660: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1075.2.69  raeburn  16661:             (used when DC is using course creation form)
                   16662: 
                   16663: codetitles - reference to array of titles of components in institutional codes (official courses).
                   16664: 
1.1075.2.95  raeburn  16665: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
                   16666:            (and so can clone automatically)
                   16667: 
                   16668: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
                   16669: 
                   16670: reqinstcode - institutional code of new course, where search_courses is used to identify potential
                   16671:               courses to clone
1.1075.2.69  raeburn  16672: 
                   16673: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
                   16674: 
                   16675: 
                   16676: Side Effects: None
                   16677: 
                   16678: =cut
                   16679: 
                   16680: 
                   16681: sub search_courses {
1.1075.2.95  raeburn  16682:     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
                   16683:         $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1075.2.69  raeburn  16684:     my (%courses,%showcourses,$cloner);
                   16685:     if (($filter->{'ownerfilter'} ne '') ||
                   16686:         ($filter->{'ownerdomfilter'} ne '')) {
                   16687:         $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                   16688:                                        $filter->{'ownerdomfilter'};
                   16689:     }
                   16690:     foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
                   16691:         if (!$filter->{$item}) {
                   16692:             $filter->{$item}='.';
                   16693:         }
                   16694:     }
                   16695:     my $now = time;
                   16696:     my $timefilter =
                   16697:        ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
                   16698:     my ($createdbefore,$createdafter);
                   16699:     if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
                   16700:         $createdbefore = $now;
                   16701:         $createdafter = $now-$filter->{'createdfilter'};
                   16702:     }
                   16703:     my ($instcodefilter,$regexpok);
                   16704:     if ($numtitles) {
                   16705:         if ($env{'form.official'} eq 'on') {
                   16706:             $instcodefilter =
                   16707:                 &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   16708:             $regexpok = 1;
                   16709:         } elsif ($env{'form.official'} eq 'off') {
                   16710:             $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   16711:             unless ($instcodefilter eq '') {
                   16712:                 $regexpok = -1;
                   16713:             }
                   16714:         }
                   16715:     } else {
                   16716:         $instcodefilter = $filter->{'instcodefilter'};
                   16717:     }
                   16718:     if ($instcodefilter eq '') { $instcodefilter = '.'; }
                   16719:     if ($type eq '') { $type = '.'; }
                   16720: 
                   16721:     if (($clonerudom ne '') && ($cloneruname ne '')) {
                   16722:         $cloner = $cloneruname.':'.$clonerudom;
                   16723:     }
                   16724:     %courses = &Apache::lonnet::courseiddump($dom,
                   16725:                                              $filter->{'descriptfilter'},
                   16726:                                              $timefilter,
                   16727:                                              $instcodefilter,
                   16728:                                              $filter->{'combownerfilter'},
                   16729:                                              $filter->{'coursefilter'},
                   16730:                                              undef,undef,$type,$regexpok,undef,undef,
1.1075.2.95  raeburn  16731:                                              undef,undef,$cloner,$cc_clone,
1.1075.2.69  raeburn  16732:                                              $filter->{'cloneableonly'},
                   16733:                                              $createdbefore,$createdafter,undef,
1.1075.2.95  raeburn  16734:                                              $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1075.2.69  raeburn  16735:     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
                   16736:         my $ccrole;
                   16737:         if ($type eq 'Community') {
                   16738:             $ccrole = 'co';
                   16739:         } else {
                   16740:             $ccrole = 'cc';
                   16741:         }
                   16742:         my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                   16743:                                                      $filter->{'persondomfilter'},
                   16744:                                                      'userroles',undef,
                   16745:                                                      [$ccrole,'in','ad','ep','ta','cr'],
                   16746:                                                      $dom);
                   16747:         foreach my $role (keys(%rolehash)) {
                   16748:             my ($cnum,$cdom,$courserole) = split(':',$role);
                   16749:             my $cid = $cdom.'_'.$cnum;
                   16750:             if (exists($courses{$cid})) {
                   16751:                 if (ref($courses{$cid}) eq 'HASH') {
                   16752:                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                   16753:                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1075.2.119  raeburn  16754:                             push(@{$courses{$cid}{roles}},$courserole);
1.1075.2.69  raeburn  16755:                         }
                   16756:                     } else {
                   16757:                         $courses{$cid}{roles} = [$courserole];
                   16758:                     }
                   16759:                     $showcourses{$cid} = $courses{$cid};
                   16760:                 }
                   16761:             }
                   16762:         }
                   16763:         %courses = %showcourses;
                   16764:     }
                   16765:     return %courses;
                   16766: }
                   16767: 
                   16768: =pod
                   16769: 
                   16770: =back
                   16771: 
1.1075.2.88  raeburn  16772: =head1 Routines for version requirements for current course.
                   16773: 
                   16774: =over 4
                   16775: 
                   16776: =item * &check_release_required()
                   16777: 
                   16778: Compares required LON-CAPA version with version on server, and
                   16779: if required version is newer looks for a server with the required version.
                   16780: 
                   16781: Looks first at servers in user's owen domain; if none suitable, looks at
                   16782: servers in course's domain are permitted to host sessions for user's domain.
                   16783: 
                   16784: Inputs:
                   16785: 
                   16786: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   16787: 
                   16788: $courseid - Course ID of current course
                   16789: 
                   16790: $rolecode - User's current role in course (for switchserver query string).
                   16791: 
                   16792: $required - LON-CAPA version needed by course (format: Major.Minor).
                   16793: 
                   16794: 
                   16795: Returns:
                   16796: 
                   16797: $switchserver - query string tp append to /adm/switchserver call (if
                   16798:                 current server's LON-CAPA version is too old.
                   16799: 
                   16800: $warning - Message is displayed if no suitable server could be found.
                   16801: 
                   16802: =cut
                   16803: 
                   16804: sub check_release_required {
                   16805:     my ($loncaparev,$courseid,$rolecode,$required) = @_;
                   16806:     my ($switchserver,$warning);
                   16807:     if ($required ne '') {
                   16808:         my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
                   16809:         my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   16810:         if ($reqdmajor ne '' && $reqdminor ne '') {
                   16811:             my $otherserver;
                   16812:             if (($major eq '' && $minor eq '') ||
                   16813:                 (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
                   16814:                 my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
                   16815:                 my $switchlcrev =
                   16816:                     &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
                   16817:                                                            $userdomserver);
                   16818:                 my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   16819:                 if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
                   16820:                     (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
                   16821:                     my $cdom = $env{'course.'.$courseid.'.domain'};
                   16822:                     if ($cdom ne $env{'user.domain'}) {
                   16823:                         my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
                   16824:                         my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
                   16825:                         my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   16826:                         my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
                   16827:                         my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
                   16828:                         my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
                   16829:                         my $canhost =
                   16830:                             &Apache::lonnet::can_host_session($env{'user.domain'},
                   16831:                                                               $coursedomserver,
                   16832:                                                               $remoterev,
                   16833:                                                               $udomdefaults{'remotesessions'},
                   16834:                                                               $defdomdefaults{'hostedsessions'});
                   16835: 
                   16836:                         if ($canhost) {
                   16837:                             $otherserver = $coursedomserver;
                   16838:                         } else {
                   16839:                             $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.");
                   16840:                         }
                   16841:                     } else {
                   16842:                         $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).");
                   16843:                     }
                   16844:                 } else {
                   16845:                     $otherserver = $userdomserver;
                   16846:                 }
                   16847:             }
                   16848:             if ($otherserver ne '') {
                   16849:                 $switchserver = 'otherserver='.$otherserver.'&amp;role='.$rolecode;
                   16850:             }
                   16851:         }
                   16852:     }
                   16853:     return ($switchserver,$warning);
                   16854: }
                   16855: 
                   16856: =pod
                   16857: 
                   16858: =item * &check_release_result()
                   16859: 
                   16860: Inputs:
                   16861: 
                   16862: $switchwarning - Warning message if no suitable server found to host session.
                   16863: 
                   16864: $switchserver - query string to append to /adm/switchserver containing lonHostID
                   16865:                 and current role.
                   16866: 
                   16867: Returns: HTML to display with information about requirement to switch server.
                   16868:          Either displaying warning with link to Roles/Courses screen or
                   16869:          display link to switchserver.
                   16870: 
1.1075.2.69  raeburn  16871: =cut
                   16872: 
1.1075.2.88  raeburn  16873: sub check_release_result {
                   16874:     my ($switchwarning,$switchserver) = @_;
                   16875:     my $output = &start_page('Selected course unavailable on this server').
                   16876:                  '<p class="LC_warning">';
                   16877:     if ($switchwarning) {
                   16878:         $output .= $switchwarning.'<br /><a href="/adm/roles">';
                   16879:         if (&show_course()) {
                   16880:             $output .= &mt('Display courses');
                   16881:         } else {
                   16882:             $output .= &mt('Display roles');
                   16883:         }
                   16884:         $output .= '</a>';
                   16885:     } elsif ($switchserver) {
                   16886:         $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
                   16887:                    '<br />'.
                   16888:                    '<a href="/adm/switchserver?'.$switchserver.'">'.
                   16889:                    &mt('Switch Server').
                   16890:                    '</a>';
                   16891:     }
                   16892:     $output .= '</p>'.&end_page();
                   16893:     return $output;
                   16894: }
                   16895: 
                   16896: =pod
                   16897: 
                   16898: =item * &needs_coursereinit()
                   16899: 
                   16900: Determine if course contents stored for user's session needs to be
                   16901: refreshed, because content has changed since "Big Hash" last tied.
                   16902: 
                   16903: Check for change is made if time last checked is more than 10 minutes ago
                   16904: (by default).
                   16905: 
                   16906: Inputs:
                   16907: 
                   16908: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   16909: 
                   16910: $interval (optional) - Time which may elapse (in s) between last check for content
                   16911:                        change in current course. (default: 600 s).
                   16912: 
                   16913: Returns: an array; first element is:
                   16914: 
                   16915: =over 4
                   16916: 
                   16917: 'switch' - if content updates mean user's session
                   16918:            needs to be switched to a server running a newer LON-CAPA version
                   16919: 
                   16920: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
                   16921:            on current server hosting user's session
                   16922: 
                   16923: ''       - if no action required.
                   16924: 
                   16925: =back
                   16926: 
                   16927: If first item element is 'switch':
                   16928: 
                   16929: second item is $switchwarning - Warning message if no suitable server found to host session.
                   16930: 
                   16931: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
                   16932:                               and current role.
                   16933: 
                   16934: otherwise: no other elements returned.
                   16935: 
                   16936: =back
                   16937: 
                   16938: =cut
                   16939: 
                   16940: sub needs_coursereinit {
                   16941:     my ($loncaparev,$interval) = @_;
                   16942:     return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
                   16943:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   16944:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   16945:     my $now = time;
                   16946:     if ($interval eq '') {
                   16947:         $interval = 600;
                   16948:     }
                   16949:     if (($now-$env{'request.course.timechecked'})>$interval) {
                   16950:         my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
                   16951:         &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
                   16952:         if ($lastchange > $env{'request.course.tied'}) {
                   16953:             my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   16954:             if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
                   16955:                 my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
                   16956:                 if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
                   16957:                     &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
                   16958:                                              $curr_reqd_hash{'internal.releaserequired'}});
                   16959:                     my ($switchserver,$switchwarning) =
                   16960:                         &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
                   16961:                                                 $curr_reqd_hash{'internal.releaserequired'});
                   16962:                     if ($switchwarning ne '' || $switchserver ne '') {
                   16963:                         return ('switch',$switchwarning,$switchserver);
                   16964:                     }
                   16965:                 }
                   16966:             }
                   16967:             return ('update');
                   16968:         }
                   16969:     }
                   16970:     return ();
                   16971: }
1.1075.2.69  raeburn  16972: 
1.1075.2.11  raeburn  16973: sub update_content_constraints {
                   16974:     my ($cdom,$cnum,$chome,$cid) = @_;
                   16975:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   16976:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   16977:     my %checkresponsetypes;
                   16978:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   16979:         my ($item,$name,$value) = split(/:/,$key);
                   16980:         if ($item eq 'resourcetag') {
                   16981:             if ($name eq 'responsetype') {
                   16982:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   16983:             }
                   16984:         }
                   16985:     }
                   16986:     my $navmap = Apache::lonnavmaps::navmap->new();
                   16987:     if (defined($navmap)) {
                   16988:         my %allresponses;
                   16989:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   16990:             my %responses = $res->responseTypes();
                   16991:             foreach my $key (keys(%responses)) {
                   16992:                 next unless(exists($checkresponsetypes{$key}));
                   16993:                 $allresponses{$key} += $responses{$key};
                   16994:             }
                   16995:         }
                   16996:         foreach my $key (keys(%allresponses)) {
                   16997:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   16998:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   16999:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   17000:             }
                   17001:         }
                   17002:         undef($navmap);
                   17003:     }
                   17004:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   17005:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   17006:     }
                   17007:     return;
                   17008: }
                   17009: 
1.1075.2.27  raeburn  17010: sub allmaps_incourse {
                   17011:     my ($cdom,$cnum,$chome,$cid) = @_;
                   17012:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   17013:         $cid = $env{'request.course.id'};
                   17014:         $cdom = $env{'course.'.$cid.'.domain'};
                   17015:         $cnum = $env{'course.'.$cid.'.num'};
                   17016:         $chome = $env{'course.'.$cid.'.home'};
                   17017:     }
                   17018:     my %allmaps = ();
                   17019:     my $lastchange =
                   17020:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   17021:     if ($lastchange > $env{'request.course.tied'}) {
                   17022:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   17023:         unless ($ferr) {
                   17024:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   17025:         }
                   17026:     }
                   17027:     my $navmap = Apache::lonnavmaps::navmap->new();
                   17028:     if (defined($navmap)) {
                   17029:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   17030:             $allmaps{$res->src()} = 1;
                   17031:         }
                   17032:     }
                   17033:     return \%allmaps;
                   17034: }
                   17035: 
1.1075.2.11  raeburn  17036: sub parse_supplemental_title {
                   17037:     my ($title) = @_;
                   17038: 
                   17039:     my ($foldertitle,$renametitle);
                   17040:     if ($title =~ /&amp;&amp;&amp;/) {
                   17041:         $title = &HTML::Entites::decode($title);
                   17042:     }
                   17043:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   17044:         $renametitle=$4;
                   17045:         my ($time,$uname,$udom) = ($1,$2,$3);
                   17046:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   17047:         my $name =  &plainname($uname,$udom);
                   17048:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   17049:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   17050:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   17051:             $name.': <br />'.$foldertitle;
                   17052:     }
                   17053:     if (wantarray) {
                   17054:         return ($title,$foldertitle,$renametitle);
                   17055:     }
                   17056:     return $title;
                   17057: }
                   17058: 
1.1075.2.43  raeburn  17059: sub recurse_supplemental {
                   17060:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
                   17061:     if ($suppmap) {
                   17062:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   17063:         if ($fatal) {
                   17064:             $errors ++;
                   17065:         } else {
                   17066:             if ($#LONCAPA::map::resources > 0) {
                   17067:                 foreach my $res (@LONCAPA::map::resources) {
                   17068:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                   17069:                     if (($src ne '') && ($status eq 'res')) {
1.1075.2.46  raeburn  17070:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                   17071:                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43  raeburn  17072:                         } else {
                   17073:                             $numfiles ++;
                   17074:                         }
                   17075:                     }
                   17076:                 }
                   17077:             }
                   17078:         }
                   17079:     }
                   17080:     return ($numfiles,$errors);
                   17081: }
                   17082: 
1.1075.2.18  raeburn  17083: sub symb_to_docspath {
1.1075.2.119  raeburn  17084:     my ($symb,$navmapref) = @_;
                   17085:     return unless ($symb && ref($navmapref));
1.1075.2.18  raeburn  17086:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   17087:     if ($resurl=~/\.(sequence|page)$/) {
                   17088:         $mapurl=$resurl;
                   17089:     } elsif ($resurl eq 'adm/navmaps') {
                   17090:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   17091:     }
                   17092:     my $mapresobj;
1.1075.2.119  raeburn  17093:     unless (ref($$navmapref)) {
                   17094:         $$navmapref = Apache::lonnavmaps::navmap->new();
                   17095:     }
                   17096:     if (ref($$navmapref)) {
                   17097:         $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1075.2.18  raeburn  17098:     }
                   17099:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   17100:     my $type=$2;
                   17101:     my $path;
                   17102:     if (ref($mapresobj)) {
                   17103:         my $pcslist = $mapresobj->map_hierarchy();
                   17104:         if ($pcslist ne '') {
                   17105:             foreach my $pc (split(/,/,$pcslist)) {
                   17106:                 next if ($pc <= 1);
1.1075.2.119  raeburn  17107:                 my $res = $$navmapref->getByMapPc($pc);
1.1075.2.18  raeburn  17108:                 if (ref($res)) {
                   17109:                     my $thisurl = $res->src();
                   17110:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   17111:                     my $thistitle = $res->title();
                   17112:                     $path .= '&'.
                   17113:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46  raeburn  17114:                              &escape($thistitle).
1.1075.2.18  raeburn  17115:                              ':'.$res->randompick().
                   17116:                              ':'.$res->randomout().
                   17117:                              ':'.$res->encrypted().
                   17118:                              ':'.$res->randomorder().
                   17119:                              ':'.$res->is_page();
                   17120:                 }
                   17121:             }
                   17122:         }
                   17123:         $path =~ s/^\&//;
                   17124:         my $maptitle = $mapresobj->title();
                   17125:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  17126:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  17127:         }
                   17128:         $path .= (($path ne '')? '&' : '').
                   17129:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  17130:                  &escape($maptitle).
1.1075.2.18  raeburn  17131:                  ':'.$mapresobj->randompick().
                   17132:                  ':'.$mapresobj->randomout().
                   17133:                  ':'.$mapresobj->encrypted().
                   17134:                  ':'.$mapresobj->randomorder().
                   17135:                  ':'.$mapresobj->is_page();
                   17136:     } else {
                   17137:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   17138:         my $ispage = (($type eq 'page')? 1 : '');
                   17139:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  17140:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  17141:         }
                   17142:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  17143:                 &escape($maptitle).':::::'.$ispage;
1.1075.2.18  raeburn  17144:     }
                   17145:     unless ($mapurl eq 'default') {
                   17146:         $path = 'default&'.
1.1075.2.46  raeburn  17147:                 &escape('Main Content').
1.1075.2.18  raeburn  17148:                 ':::::&'.$path;
                   17149:     }
                   17150:     return $path;
                   17151: }
                   17152: 
1.1075.2.14  raeburn  17153: sub captcha_display {
1.1075.2.137  raeburn  17154:     my ($context,$lonhost,$defdom) = @_;
1.1075.2.14  raeburn  17155:     my ($output,$error);
1.1075.2.107  raeburn  17156:     my ($captcha,$pubkey,$privkey,$version) =
1.1075.2.137  raeburn  17157:         &get_captcha_config($context,$lonhost,$defdom);
1.1075.2.14  raeburn  17158:     if ($captcha eq 'original') {
                   17159:         $output = &create_captcha();
                   17160:         unless ($output) {
                   17161:             $error = 'captcha';
                   17162:         }
                   17163:     } elsif ($captcha eq 'recaptcha') {
1.1075.2.107  raeburn  17164:         $output = &create_recaptcha($pubkey,$version);
1.1075.2.14  raeburn  17165:         unless ($output) {
                   17166:             $error = 'recaptcha';
                   17167:         }
                   17168:     }
1.1075.2.107  raeburn  17169:     return ($output,$error,$captcha,$version);
1.1075.2.14  raeburn  17170: }
                   17171: 
                   17172: sub captcha_response {
1.1075.2.137  raeburn  17173:     my ($context,$lonhost,$defdom) = @_;
1.1075.2.14  raeburn  17174:     my ($captcha_chk,$captcha_error);
1.1075.2.137  raeburn  17175:     my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
1.1075.2.14  raeburn  17176:     if ($captcha eq 'original') {
                   17177:         ($captcha_chk,$captcha_error) = &check_captcha();
                   17178:     } elsif ($captcha eq 'recaptcha') {
1.1075.2.107  raeburn  17179:         $captcha_chk = &check_recaptcha($privkey,$version);
1.1075.2.14  raeburn  17180:     } else {
                   17181:         $captcha_chk = 1;
                   17182:     }
                   17183:     return ($captcha_chk,$captcha_error);
                   17184: }
                   17185: 
                   17186: sub get_captcha_config {
1.1075.2.137  raeburn  17187:     my ($context,$lonhost,$dom_in_effect) = @_;
1.1075.2.107  raeburn  17188:     my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1075.2.14  raeburn  17189:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   17190:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   17191:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   17192:     if ($context eq 'usercreation') {
                   17193:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   17194:         if (ref($domconfig{$context}) eq 'HASH') {
                   17195:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   17196:             if (ref($hashtocheck) eq 'HASH') {
                   17197:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   17198:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   17199:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   17200:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   17201:                     }
                   17202:                     if ($privkey && $pubkey) {
                   17203:                         $captcha = 'recaptcha';
1.1075.2.107  raeburn  17204:                         $version = $hashtocheck->{'recaptchaversion'};
                   17205:                         if ($version ne '2') {
                   17206:                             $version = 1;
                   17207:                         }
1.1075.2.14  raeburn  17208:                     } else {
                   17209:                         $captcha = 'original';
                   17210:                     }
                   17211:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   17212:                     $captcha = 'original';
                   17213:                 }
                   17214:             }
                   17215:         } else {
                   17216:             $captcha = 'captcha';
                   17217:         }
                   17218:     } elsif ($context eq 'login') {
                   17219:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   17220:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   17221:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   17222:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
                   17223:             if ($privkey && $pubkey) {
                   17224:                 $captcha = 'recaptcha';
1.1075.2.107  raeburn  17225:                 $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
                   17226:                 if ($version ne '2') {
                   17227:                     $version = 1;
                   17228:                 }
1.1075.2.14  raeburn  17229:             } else {
                   17230:                 $captcha = 'original';
                   17231:             }
                   17232:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   17233:             $captcha = 'original';
                   17234:         }
1.1075.2.137  raeburn  17235:     } elsif ($context eq 'passwords') {
                   17236:         if ($dom_in_effect) {
                   17237:             my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
                   17238:             if ($passwdconf{'captcha'} eq 'recaptcha') {
                   17239:                 if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
                   17240:                     $pubkey = $passwdconf{'recaptchakeys'}{'public'};
                   17241:                     $privkey = $passwdconf{'recaptchakeys'}{'private'};
                   17242:                 }
                   17243:                 if ($privkey && $pubkey) {
                   17244:                     $captcha = 'recaptcha';
                   17245:                     $version = $passwdconf{'recaptchaversion'};
                   17246:                     if ($version ne '2') {
                   17247:                         $version = 1;
                   17248:                     }
                   17249:                 } else {
                   17250:                     $captcha = 'original';
                   17251:                 }
                   17252:             } elsif ($passwdconf{'captcha'} ne 'notused') {
                   17253:                 $captcha = 'original';
                   17254:             }
                   17255:         }
1.1075.2.14  raeburn  17256:     }
1.1075.2.107  raeburn  17257:     return ($captcha,$pubkey,$privkey,$version);
1.1075.2.14  raeburn  17258: }
                   17259: 
                   17260: sub create_captcha {
                   17261:     my %captcha_params = &captcha_settings();
                   17262:     my ($output,$maxtries,$tries) = ('',10,0);
                   17263:     while ($tries < $maxtries) {
                   17264:         $tries ++;
                   17265:         my $captcha = Authen::Captcha->new (
                   17266:                                            output_folder => $captcha_params{'output_dir'},
                   17267:                                            data_folder   => $captcha_params{'db_dir'},
                   17268:                                           );
                   17269:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   17270: 
                   17271:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   17272:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
1.1075.2.158  raeburn  17273:                       '<span class="LC_nobreak">'.
1.1075.2.14  raeburn  17274:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
1.1075.2.66  raeburn  17275:                       '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
1.1075.2.158  raeburn  17276:                       '</span><br />'.
1.1075.2.66  raeburn  17277:                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14  raeburn  17278:             last;
                   17279:         }
                   17280:     }
1.1075.2.158  raeburn  17281:     if ($output eq '') {
                   17282:         &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
                   17283:     }
1.1075.2.14  raeburn  17284:     return $output;
                   17285: }
                   17286: 
                   17287: sub captcha_settings {
                   17288:     my %captcha_params = (
                   17289:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   17290:                            www_output_dir => "/captchaspool",
                   17291:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   17292:                            numchars       => '5',
                   17293:                          );
                   17294:     return %captcha_params;
                   17295: }
                   17296: 
                   17297: sub check_captcha {
                   17298:     my ($captcha_chk,$captcha_error);
                   17299:     my $code = $env{'form.code'};
                   17300:     my $md5sum = $env{'form.crypt'};
                   17301:     my %captcha_params = &captcha_settings();
                   17302:     my $captcha = Authen::Captcha->new(
                   17303:                       output_folder => $captcha_params{'output_dir'},
                   17304:                       data_folder   => $captcha_params{'db_dir'},
                   17305:                   );
1.1075.2.26  raeburn  17306:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14  raeburn  17307:     my %captcha_hash = (
                   17308:                         0       => 'Code not checked (file error)',
                   17309:                        -1      => 'Failed: code expired',
                   17310:                        -2      => 'Failed: invalid code (not in database)',
                   17311:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   17312:     );
                   17313:     if ($captcha_chk != 1) {
                   17314:         $captcha_error = $captcha_hash{$captcha_chk}
                   17315:     }
                   17316:     return ($captcha_chk,$captcha_error);
                   17317: }
                   17318: 
                   17319: sub create_recaptcha {
1.1075.2.107  raeburn  17320:     my ($pubkey,$version) = @_;
                   17321:     if ($version >= 2) {
1.1075.2.158  raeburn  17322:         return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>'.
                   17323:                '<div style="padding:0;clear:both;margin:0;border:0"></div>';
1.1075.2.107  raeburn  17324:     } else {
                   17325:         my $use_ssl;
                   17326:         if ($ENV{'SERVER_PORT'} == 443) {
                   17327:             $use_ssl = 1;
                   17328:         }
                   17329:         my $captcha = Captcha::reCAPTCHA->new;
                   17330:         return $captcha->get_options_setter({theme => 'white'})."\n".
                   17331:                $captcha->get_html($pubkey,undef,$use_ssl).
                   17332:                &mt('If the text is hard to read, [_1] will replace them.',
                   17333:                    '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
                   17334:                '<br /><br />';
                   17335:      }
1.1075.2.14  raeburn  17336: }
                   17337: 
                   17338: sub check_recaptcha {
1.1075.2.107  raeburn  17339:     my ($privkey,$version) = @_;
1.1075.2.14  raeburn  17340:     my $captcha_chk;
1.1075.2.150  raeburn  17341:     my $ip = &Apache::lonnet::get_requestor_ip(); 
1.1075.2.107  raeburn  17342:     if ($version >= 2) {
                   17343:         my $ua = LWP::UserAgent->new;
                   17344:         $ua->timeout(10);
                   17345:         my %info = (
                   17346:                      secret   => $privkey,
                   17347:                      response => $env{'form.g-recaptcha-response'},
1.1075.2.150  raeburn  17348:                      remoteip => $ip,
1.1075.2.107  raeburn  17349:                    );
                   17350:         my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
                   17351:         if ($response->is_success)  {
                   17352:             my $data = JSON::DWIW->from_json($response->decoded_content);
                   17353:             if (ref($data) eq 'HASH') {
                   17354:                 if ($data->{'success'}) {
                   17355:                     $captcha_chk = 1;
                   17356:                 }
                   17357:             }
                   17358:         }
                   17359:     } else {
                   17360:         my $captcha = Captcha::reCAPTCHA->new;
                   17361:         my $captcha_result =
                   17362:             $captcha->check_answer(
                   17363:                                     $privkey,
1.1075.2.150  raeburn  17364:                                     $ip,
1.1075.2.107  raeburn  17365:                                     $env{'form.recaptcha_challenge_field'},
                   17366:                                     $env{'form.recaptcha_response_field'},
                   17367:                                   );
                   17368:         if ($captcha_result->{is_valid}) {
                   17369:             $captcha_chk = 1;
                   17370:         }
1.1075.2.14  raeburn  17371:     }
                   17372:     return $captcha_chk;
                   17373: }
                   17374: 
1.1075.2.64  raeburn  17375: sub emailusername_info {
1.1075.2.103  raeburn  17376:     my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1075.2.64  raeburn  17377:     my %titles = &Apache::lonlocal::texthash (
                   17378:                      lastname      => 'Last Name',
                   17379:                      firstname     => 'First Name',
                   17380:                      institution   => 'School/college/university',
                   17381:                      location      => "School's city, state/province, country",
                   17382:                      web           => "School's web address",
                   17383:                      officialemail => 'E-mail address at institution (if different)',
1.1075.2.103  raeburn  17384:                      id            => 'Student/Employee ID',
1.1075.2.64  raeburn  17385:                  );
                   17386:     return (\@fields,\%titles);
                   17387: }
                   17388: 
1.1075.2.56  raeburn  17389: sub cleanup_html {
                   17390:     my ($incoming) = @_;
                   17391:     my $outgoing;
                   17392:     if ($incoming ne '') {
                   17393:         $outgoing = $incoming;
                   17394:         $outgoing =~ s/;/&#059;/g;
                   17395:         $outgoing =~ s/\#/&#035;/g;
                   17396:         $outgoing =~ s/\&/&#038;/g;
                   17397:         $outgoing =~ s/</&#060;/g;
                   17398:         $outgoing =~ s/>/&#062;/g;
                   17399:         $outgoing =~ s/\(/&#040/g;
                   17400:         $outgoing =~ s/\)/&#041;/g;
                   17401:         $outgoing =~ s/"/&#034;/g;
                   17402:         $outgoing =~ s/'/&#039;/g;
                   17403:         $outgoing =~ s/\$/&#036;/g;
                   17404:         $outgoing =~ s{/}{&#047;}g;
                   17405:         $outgoing =~ s/=/&#061;/g;
                   17406:         $outgoing =~ s/\\/&#092;/g
                   17407:     }
                   17408:     return $outgoing;
                   17409: }
                   17410: 
1.1075.2.74  raeburn  17411: # Checks for critical messages and returns a redirect url if one exists.
                   17412: # $interval indicates how often to check for messages.
                   17413: sub critical_redirect {
                   17414:     my ($interval) = @_;
1.1075.2.158  raeburn  17415:     unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
                   17416:         return ();
                   17417:     }
1.1075.2.74  raeburn  17418:     if ((time-$env{'user.criticalcheck.time'})>$interval) {
                   17419:         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
                   17420:                                         $env{'user.name'});
                   17421:         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
                   17422:         my $redirecturl;
                   17423:         if ($what[0]) {
1.1075.2.158  raeburn  17424:             if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
1.1075.2.74  raeburn  17425:                 $redirecturl='/adm/email?critical=display';
                   17426:                 my $url=&Apache::lonnet::absolute_url().$redirecturl;
                   17427:                 return (1, $url);
                   17428:             }
                   17429:         }
                   17430:     }
                   17431:     return ();
                   17432: }
                   17433: 
1.1075.2.64  raeburn  17434: # Use:
                   17435: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                   17436: #
                   17437: ##################################################
                   17438: #          password associated functions         #
                   17439: ##################################################
                   17440: sub des_keys {
                   17441:     # Make a new key for DES encryption.
                   17442:     # Each key has two parts which are returned separately.
                   17443:     # Please note:  Each key must be passed through the &hex function
                   17444:     # before it is output to the web browser.  The hex versions cannot
                   17445:     # be used to decrypt.
                   17446:     my @hexstr=('0','1','2','3','4','5','6','7',
                   17447:                 '8','9','a','b','c','d','e','f');
                   17448:     my $lkey='';
                   17449:     for (0..7) {
                   17450:         $lkey.=$hexstr[rand(15)];
                   17451:     }
                   17452:     my $ukey='';
                   17453:     for (0..7) {
                   17454:         $ukey.=$hexstr[rand(15)];
                   17455:     }
                   17456:     return ($lkey,$ukey);
                   17457: }
                   17458: 
                   17459: sub des_decrypt {
                   17460:     my ($key,$cyphertext) = @_;
                   17461:     my $keybin=pack("H16",$key);
                   17462:     my $cypher;
                   17463:     if ($Crypt::DES::VERSION>=2.03) {
                   17464:         $cypher=new Crypt::DES $keybin;
                   17465:     } else {
                   17466:         $cypher=new DES $keybin;
                   17467:     }
1.1075.2.106  raeburn  17468:     my $plaintext='';
                   17469:     my $cypherlength = length($cyphertext);
                   17470:     my $numchunks = int($cypherlength/32);
                   17471:     for (my $j=0; $j<$numchunks; $j++) {
                   17472:         my $start = $j*32;
                   17473:         my $cypherblock = substr($cyphertext,$start,32);
                   17474:         my $chunk =
                   17475:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
                   17476:         $chunk .=
                   17477:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
                   17478:         $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
                   17479:         $plaintext .= $chunk;
                   17480:     }
1.1075.2.64  raeburn  17481:     return $plaintext;
                   17482: }
                   17483: 
1.1075.2.135  raeburn  17484: sub is_nonframeable {
                   17485:     my ($url,$absolute,$hostname,$ip,$nocache) = @_;
                   17486:     my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
                   17487:     return if (($remprotocol eq '') || ($remhost eq ''));
                   17488: 
                   17489:     $remprotocol = lc($remprotocol);
                   17490:     $remhost = lc($remhost);
                   17491:     my $remport = 80;
                   17492:     if ($remprotocol eq 'https') {
                   17493:         $remport = 443;
                   17494:     }
                   17495:     my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
                   17496:     if ($cached) {
                   17497:         unless ($nocache) {
                   17498:             if ($result) {
                   17499:                 return 1;
                   17500:             } else {
                   17501:                 return 0;
                   17502:             }
                   17503:         }
                   17504:     }
                   17505:     my $uselink;
                   17506:     my $request = new HTTP::Request('HEAD',$url);
1.1075.2.142  raeburn  17507:     my $ua = LWP::UserAgent->new;
                   17508:     $ua->timeout(5);
                   17509:     my $response=$ua->request($request);
1.1075.2.135  raeburn  17510:     if ($response->is_success()) {
                   17511:         my $secpolicy = lc($response->header('content-security-policy'));
                   17512:         my $xframeop = lc($response->header('x-frame-options'));
                   17513:         $secpolicy =~ s/^\s+|\s+$//g;
                   17514:         $xframeop =~ s/^\s+|\s+$//g;
                   17515:         if (($secpolicy ne '') || ($xframeop ne '')) {
                   17516:             my $remotehost = $remprotocol.'://'.$remhost;
                   17517:             my ($origin,$protocol,$port);
                   17518:             if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
                   17519:                 $port = $ENV{'SERVER_PORT'};
                   17520:             } else {
                   17521:                 $port = 80;
                   17522:             }
                   17523:             if ($absolute eq '') {
                   17524:                 $protocol = 'http:';
                   17525:                 if ($port == 443) {
                   17526:                     $protocol = 'https:';
                   17527:                 }
                   17528:                 $origin = $protocol.'//'.lc($hostname);
                   17529:             } else {
                   17530:                 $origin = lc($absolute);
                   17531:                 ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
                   17532:             }
                   17533:             if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
                   17534:                 my $framepolicy = $1;
                   17535:                 $framepolicy =~ s/^\s+|\s+$//g;
                   17536:                 my @policies = split(/\s+/,$framepolicy);
                   17537:                 if (@policies) {
                   17538:                     if (grep(/^\Q'none'\E$/,@policies)) {
                   17539:                         $uselink = 1;
                   17540:                     } else {
                   17541:                         $uselink = 1;
                   17542:                         if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
                   17543:                                 (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
                   17544:                                 (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
                   17545:                             undef($uselink);
                   17546:                         }
                   17547:                         if ($uselink) {
                   17548:                             if (grep(/^\Q'self'\E$/,@policies)) {
                   17549:                                 if (($origin ne '') && ($remotehost eq $origin)) {
                   17550:                                     undef($uselink);
                   17551:                                 }
                   17552:                             }
                   17553:                         }
                   17554:                         if ($uselink) {
                   17555:                             my @possok;
                   17556:                             if ($ip ne '') {
                   17557:                                 push(@possok,$ip);
                   17558:                             }
                   17559:                             my $hoststr = '';
                   17560:                             foreach my $part (reverse(split(/\./,$hostname))) {
                   17561:                                 if ($hoststr eq '') {
                   17562:                                     $hoststr = $part;
                   17563:                                 } else {
                   17564:                                     $hoststr = "$part.$hoststr";
                   17565:                                 }
                   17566:                                 if ($hoststr eq $hostname) {
                   17567:                                     push(@possok,$hostname);
                   17568:                                 } else {
                   17569:                                     push(@possok,"*.$hoststr");
                   17570:                                 }
                   17571:                             }
                   17572:                             if (@possok) {
                   17573:                                 foreach my $poss (@possok) {
                   17574:                                     last if (!$uselink);
                   17575:                                     foreach my $policy (@policies) {
                   17576:                                         if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
                   17577:                                             undef($uselink);
                   17578:                                             last;
                   17579:                                         }
                   17580:                                     }
                   17581:                                 }
                   17582:                             }
                   17583:                         }
                   17584:                     }
                   17585:                 }
                   17586:             } elsif ($xframeop ne '') {
                   17587:                 $uselink = 1;
                   17588:                 my @policies = split(/\s*,\s*/,$xframeop);
                   17589:                 if (@policies) {
                   17590:                     unless (grep(/^deny$/,@policies)) {
                   17591:                         if ($origin ne '') {
                   17592:                             if (grep(/^sameorigin$/,@policies)) {
                   17593:                                 if ($remotehost eq $origin) {
                   17594:                                     undef($uselink);
                   17595:                                 }
                   17596:                             }
                   17597:                             if ($uselink) {
                   17598:                                 foreach my $policy (@policies) {
                   17599:                                     if ($policy =~ /^allow-from\s*(.+)$/) {
                   17600:                                         my $allowfrom = $1;
                   17601:                                         if (($allowfrom ne '') && ($allowfrom eq $origin)) {
                   17602:                                             undef($uselink);
                   17603:                                             last;
                   17604:                                         }
                   17605:                                     }
                   17606:                                 }
                   17607:                             }
                   17608:                         }
                   17609:                     }
                   17610:                 }
                   17611:             }
                   17612:         }
                   17613:     }
                   17614:     if ($nocache) {
                   17615:         if ($cached) {
                   17616:             my $devalidate;
                   17617:             if ($uselink && !$result) {
                   17618:                 $devalidate = 1;
                   17619:             } elsif (!$uselink && $result) {
                   17620:                 $devalidate = 1;
                   17621:             }
                   17622:             if ($devalidate) {
                   17623:                 &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
                   17624:             }
                   17625:         }
                   17626:     } else {
                   17627:         if ($uselink) {
                   17628:             $result = 1;
                   17629:         } else {
                   17630:             $result = 0;
                   17631:         }
                   17632:         &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
                   17633:     }
                   17634:     return $uselink;
                   17635: }
                   17636: 
1.112     bowersj2 17637: 1;
                   17638: __END__;
1.41      ng       17639: 

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