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

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.47! raeburn     4: # $Id: loncommon.pm,v 1.1075.2.46 2013/08/18 17:32:57 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.479     albertel   72: use LONCAPA qw(:DEFAULT :match);
1.657     raeburn    73: use DateTime::TimeZone;
1.687     raeburn    74: use DateTime::Locale::Catalog;
1.1075.2.14  raeburn    75: use Authen::Captcha;
                     76: use Captcha::reCAPTCHA;
1.117     www        77: 
1.517     raeburn    78: # ---------------------------------------------- Designs
                     79: use vars qw(%defaultdesign);
                     80: 
1.22      www        81: my $readit;
                     82: 
1.517     raeburn    83: 
1.157     matthew    84: ##
                     85: ## Global Variables
                     86: ##
1.46      matthew    87: 
1.643     foxr       88: 
                     89: # ----------------------------------------------- SSI with retries:
                     90: #
                     91: 
                     92: =pod
                     93: 
1.648     raeburn    94: =head1 Server Side include with retries:
1.643     foxr       95: 
                     96: =over 4
                     97: 
1.648     raeburn    98: =item * &ssi_with_retries(resource,retries form)
1.643     foxr       99: 
                    100: Performs an ssi with some number of retries.  Retries continue either
                    101: until the result is ok or until the retry count supplied by the
                    102: caller is exhausted.  
                    103: 
                    104: Inputs:
1.648     raeburn   105: 
                    106: =over 4
                    107: 
1.643     foxr      108: resource   - Identifies the resource to insert.
1.648     raeburn   109: 
1.643     foxr      110: retries    - Count of the number of retries allowed.
1.648     raeburn   111: 
1.643     foxr      112: form       - Hash that identifies the rendering options.
                    113: 
1.648     raeburn   114: =back
                    115: 
                    116: Returns:
                    117: 
                    118: =over 4
                    119: 
1.643     foxr      120: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   121: 
1.643     foxr      122: response   - The response from the last attempt (which may or may not have been successful.
                    123: 
1.648     raeburn   124: =back
                    125: 
                    126: =back
                    127: 
1.643     foxr      128: =cut
                    129: 
                    130: sub ssi_with_retries {
                    131:     my ($resource, $retries, %form) = @_;
                    132: 
                    133: 
                    134:     my $ok = 0;			# True if we got a good response.
                    135:     my $content;
                    136:     my $response;
                    137: 
                    138:     # Try to get the ssi done. within the retries count:
                    139: 
                    140:     do {
                    141: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    142: 	$ok      = $response->is_success;
1.650     www       143:         if (!$ok) {
                    144:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    145:         }
1.643     foxr      146: 	$retries--;
                    147:     } while (!$ok && ($retries > 0));
                    148: 
                    149:     if (!$ok) {
                    150: 	$content = '';		# On error return an empty content.
                    151:     }
                    152:     return ($content, $response);
                    153: 
                    154: }
                    155: 
                    156: 
                    157: 
1.20      www       158: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  159: my %language;
1.124     www       160: my %supported_language;
1.1048    foxr      161: my %latex_language;		# For choosing hyphenation in <transl..>
                    162: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  163: my %cprtag;
1.192     taceyjo1  164: my %scprtag;
1.351     www       165: my %fe; my %fd; my %fm;
1.41      ng        166: my %category_extensions;
1.12      harris41  167: 
1.46      matthew   168: # ---------------------------------------------- Thesaurus variables
1.144     matthew   169: #
                    170: # %Keywords:
                    171: #      A hash used by &keyword to determine if a word is considered a keyword.
                    172: # $thesaurus_db_file 
                    173: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   174: 
                    175: my %Keywords;
                    176: my $thesaurus_db_file;
                    177: 
1.144     matthew   178: #
                    179: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    180: # thesaurus.tab, and filecategories.tab.
                    181: #
1.18      www       182: BEGIN {
1.46      matthew   183:     # Variable initialization
                    184:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    185:     #
1.22      www       186:     unless ($readit) {
1.12      harris41  187: # ------------------------------------------------------------------- languages
                    188:     {
1.158     raeburn   189:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    190:                                    '/language.tab';
                    191:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  192:             while (my $line = <$fh>) {
                    193:                 next if ($line=~/^\#/);
                    194:                 chomp($line);
1.1048    foxr      195:                 my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   196:                 $language{$key}=$val.' - '.$enc;
                    197:                 if ($sup) {
                    198:                     $supported_language{$key}=$sup;
                    199:                 }
1.1048    foxr      200: 		if ($latex) {
                    201: 		    $latex_language_bykey{$key} = $latex;
                    202: 		    $latex_language{$two} = $latex;
                    203: 		}
1.158     raeburn   204:             }
                    205:             close($fh);
                    206:         }
1.12      harris41  207:     }
                    208: # ------------------------------------------------------------------ copyrights
                    209:     {
1.158     raeburn   210:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    211:                                   '/copyright.tab';
                    212:         if ( open (my $fh,"<$copyrightfile") ) {
1.356     albertel  213:             while (my $line = <$fh>) {
                    214:                 next if ($line=~/^\#/);
                    215:                 chomp($line);
                    216:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   217:                 $cprtag{$key}=$val;
                    218:             }
                    219:             close($fh);
                    220:         }
1.12      harris41  221:     }
1.351     www       222: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  223:     {
                    224:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    225:                                   '/source_copyright.tab';
                    226:         if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356     albertel  227:             while (my $line = <$fh>) {
                    228:                 next if ($line =~ /^\#/);
                    229:                 chomp($line);
                    230:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  231:                 $scprtag{$key}=$val;
                    232:             }
                    233:             close($fh);
                    234:         }
                    235:     }
1.63      www       236: 
1.517     raeburn   237: # -------------------------------------------------------------- default domain designs
1.63      www       238:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   239:     my $designfile = $designdir.'/default.tab';
                    240:     if ( open (my $fh,"<$designfile") ) {
                    241:         while (my $line = <$fh>) {
                    242:             next if ($line =~ /^\#/);
                    243:             chomp($line);
                    244:             my ($key,$val)=(split(/\=/,$line));
                    245:             if ($val) { $defaultdesign{$key}=$val; }
                    246:         }
                    247:         close($fh);
1.63      www       248:     }
                    249: 
1.15      harris41  250: # ------------------------------------------------------------- file categories
                    251:     {
1.158     raeburn   252:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    253:                                   '/filecategories.tab';
                    254:         if ( open (my $fh,"<$categoryfile") ) {
1.356     albertel  255: 	    while (my $line = <$fh>) {
                    256: 		next if ($line =~ /^\#/);
                    257: 		chomp($line);
                    258:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.158     raeburn   259:                 push @{$category_extensions{lc($category)}},$extension;
                    260:             }
                    261:             close($fh);
                    262:         }
                    263: 
1.15      harris41  264:     }
1.12      harris41  265: # ------------------------------------------------------------------ file types
                    266:     {
1.158     raeburn   267:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    268:                '/filetypes.tab';
                    269:         if ( open (my $fh,"<$typesfile") ) {
1.356     albertel  270:             while (my $line = <$fh>) {
                    271: 		next if ($line =~ /^\#/);
                    272: 		chomp($line);
                    273:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   274:                 if ($descr ne '') {
                    275:                     $fe{$ending}=lc($emb);
                    276:                     $fd{$ending}=$descr;
1.351     www       277:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   278:                 }
                    279:             }
                    280:             close($fh);
                    281:         }
1.12      harris41  282:     }
1.22      www       283:     &Apache::lonnet::logthis(
1.705     tempelho  284:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       285:     $readit=1;
1.46      matthew   286:     }  # end of unless($readit) 
1.32      matthew   287:     
                    288: }
1.112     bowersj2  289: 
1.42      matthew   290: ###############################################################
                    291: ##           HTML and Javascript Helper Functions            ##
                    292: ###############################################################
                    293: 
                    294: =pod 
                    295: 
1.112     bowersj2  296: =head1 HTML and Javascript Functions
1.42      matthew   297: 
1.112     bowersj2  298: =over 4
                    299: 
1.648     raeburn   300: =item * &browser_and_searcher_javascript()
1.112     bowersj2  301: 
                    302: X<browsing, javascript>X<searching, javascript>Returns a string
                    303: containing javascript with two functions, C<openbrowser> and
                    304: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    305: tags.
1.42      matthew   306: 
1.648     raeburn   307: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   308: 
                    309: inputs: formname, elementname, only, omit
                    310: 
                    311: formname and elementname indicate the name of the html form and name of
                    312: the element that the results of the browsing selection are to be placed in. 
                    313: 
                    314: Specifying 'only' will restrict the browser to displaying only files
1.185     www       315: with the given extension.  Can be a comma separated list.
1.42      matthew   316: 
                    317: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       318: with the given extension.  Can be a comma separated list.
1.42      matthew   319: 
1.648     raeburn   320: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   321: 
                    322: Inputs: formname, elementname
                    323: 
                    324: formname and elementname specify the name of the html form and the name
                    325: of the element the selection from the search results will be placed in.
1.542     raeburn   326: 
1.42      matthew   327: =cut
                    328: 
                    329: sub browser_and_searcher_javascript {
1.199     albertel  330:     my ($mode)=@_;
                    331:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  332:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   333:     return <<END;
1.219     albertel  334: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   335:     var editbrowser = null;
1.135     albertel  336:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       337:         var url = '$resurl/?';
1.42      matthew   338:         if (editbrowser == null) {
                    339:             url += 'launch=1&';
                    340:         }
                    341:         url += 'catalogmode=interactive&';
1.199     albertel  342:         url += 'mode=$mode&';
1.611     albertel  343:         url += 'inhibitmenu=yes&';
1.42      matthew   344:         url += 'form=' + formname + '&';
                    345:         if (only != null) {
                    346:             url += 'only=' + only + '&';
1.217     albertel  347:         } else {
                    348:             url += 'only=&';
                    349: 	}
1.42      matthew   350:         if (omit != null) {
                    351:             url += 'omit=' + omit + '&';
1.217     albertel  352:         } else {
                    353:             url += 'omit=&';
                    354: 	}
1.135     albertel  355:         if (titleelement != null) {
                    356:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  357:         } else {
                    358: 	    url += 'titleelement=&';
                    359: 	}
1.42      matthew   360:         url += 'element=' + elementname + '';
                    361:         var title = 'Browser';
1.435     albertel  362:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   363:         options += ',width=700,height=600';
                    364:         editbrowser = open(url,title,options,'1');
                    365:         editbrowser.focus();
                    366:     }
                    367:     var editsearcher;
1.135     albertel  368:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   369:         var url = '/adm/searchcat?';
                    370:         if (editsearcher == null) {
                    371:             url += 'launch=1&';
                    372:         }
                    373:         url += 'catalogmode=interactive&';
1.199     albertel  374:         url += 'mode=$mode&';
1.42      matthew   375:         url += 'form=' + formname + '&';
1.135     albertel  376:         if (titleelement != null) {
                    377:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  378:         } else {
                    379: 	    url += 'titleelement=&';
                    380: 	}
1.42      matthew   381:         url += 'element=' + elementname + '';
                    382:         var title = 'Search';
1.435     albertel  383:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   384:         options += ',width=700,height=600';
                    385:         editsearcher = open(url,title,options,'1');
                    386:         editsearcher.focus();
                    387:     }
1.219     albertel  388: // END LON-CAPA Internal -->
1.42      matthew   389: END
1.170     www       390: }
                    391: 
                    392: sub lastresurl {
1.258     albertel  393:     if ($env{'environment.lastresurl'}) {
                    394: 	return $env{'environment.lastresurl'}
1.170     www       395:     } else {
                    396: 	return '/res';
                    397:     }
                    398: }
                    399: 
                    400: sub storeresurl {
                    401:     my $resurl=&Apache::lonnet::clutter(shift);
                    402:     unless ($resurl=~/^\/res/) { return 0; }
                    403:     $resurl=~s/\/$//;
                    404:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   405:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       406:     return 1;
1.42      matthew   407: }
                    408: 
1.74      www       409: sub studentbrowser_javascript {
1.111     www       410:    unless (
1.258     albertel  411:             (($env{'request.course.id'}) && 
1.302     albertel  412:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    413: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    414: 					  '/'.$env{'request.course.sec'})
                    415: 	      ))
1.258     albertel  416:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       417:           ) { return ''; }  
1.74      www       418:    return (<<'ENDSTDBRW');
1.776     bisitz    419: <script type="text/javascript" language="Javascript">
1.824     bisitz    420: // <![CDATA[
1.74      www       421:     var stdeditbrowser;
1.999     www       422:     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74      www       423:         var url = '/adm/pickstudent?';
                    424:         var filter;
1.558     albertel  425: 	if (!ignorefilter) {
                    426: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    427: 	}
1.74      www       428:         if (filter != null) {
                    429:            if (filter != '') {
                    430:                url += 'filter='+filter+'&';
                    431: 	   }
                    432:         }
                    433:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       434:                                     '&udomelement='+udom+
                    435:                                     '&clicker='+clicker;
1.111     www       436: 	if (roleflag) { url+="&roles=1"; }
1.793     raeburn   437:         if (courseadvonly) { url+="&courseadvonly=1"; }
1.102     www       438:         var title = 'Student_Browser';
1.74      www       439:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    440:         options += ',width=700,height=600';
                    441:         stdeditbrowser = open(url,title,options,'1');
                    442:         stdeditbrowser.focus();
                    443:     }
1.824     bisitz    444: // ]]>
1.74      www       445: </script>
                    446: ENDSTDBRW
                    447: }
1.42      matthew   448: 
1.1003    www       449: sub resourcebrowser_javascript {
                    450:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       451:    return (<<'ENDRESBRW');
1.1003    www       452: <script type="text/javascript" language="Javascript">
                    453: // <![CDATA[
                    454:     var reseditbrowser;
1.1004    www       455:     function openresbrowser(formname,reslink) {
1.1005    www       456:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       457:         var title = 'Resource_Browser';
                    458:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       459:         options += ',width=700,height=500';
1.1004    www       460:         reseditbrowser = open(url,title,options,'1');
                    461:         reseditbrowser.focus();
1.1003    www       462:     }
                    463: // ]]>
                    464: </script>
1.1004    www       465: ENDRESBRW
1.1003    www       466: }
                    467: 
1.74      www       468: sub selectstudent_link {
1.999     www       469:    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
                    470:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    471:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    472:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  473:    if ($env{'request.course.id'}) {  
1.302     albertel  474:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    475: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    476: 					'/'.$env{'request.course.sec'})) {
1.111     www       477: 	   return '';
                    478:        }
1.999     www       479:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793     raeburn   480:        if ($courseadvonly)  {
                    481:            $callargs .= ",'',1,1";
                    482:        }
                    483:        return '<span class="LC_nobreak">'.
                    484:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    485:               &mt('Select User').'</a></span>';
1.74      www       486:    }
1.258     albertel  487:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       488:        $callargs .= ",'',1"; 
1.793     raeburn   489:        return '<span class="LC_nobreak">'.
                    490:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    491:               &mt('Select User').'</a></span>';
1.111     www       492:    }
                    493:    return '';
1.91      www       494: }
                    495: 
1.1004    www       496: sub selectresource_link {
                    497:    my ($form,$reslink,$arg)=@_;
                    498:    
                    499:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    500:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    501:    unless ($env{'request.course.id'}) { return $arg; }
                    502:    return '<span class="LC_nobreak">'.
                    503:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    504:               $arg.'</a></span>';
                    505: }
                    506: 
                    507: 
                    508: 
1.653     raeburn   509: sub authorbrowser_javascript {
                    510:     return <<"ENDAUTHORBRW";
1.776     bisitz    511: <script type="text/javascript" language="JavaScript">
1.824     bisitz    512: // <![CDATA[
1.653     raeburn   513: var stdeditbrowser;
                    514: 
                    515: function openauthorbrowser(formname,udom) {
                    516:     var url = '/adm/pickauthor?';
                    517:     url += 'form='+formname+'&roledom='+udom;
                    518:     var title = 'Author_Browser';
                    519:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    520:     options += ',width=700,height=600';
                    521:     stdeditbrowser = open(url,title,options,'1');
                    522:     stdeditbrowser.focus();
                    523: }
                    524: 
1.824     bisitz    525: // ]]>
1.653     raeburn   526: </script>
                    527: ENDAUTHORBRW
                    528: }
                    529: 
1.91      www       530: sub coursebrowser_javascript {
1.1075.2.31  raeburn   531:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
                    532:         $credits_element) = @_;
1.932     raeburn   533:     my $wintitle = 'Course_Browser';
1.931     raeburn   534:     if ($crstype eq 'Community') {
1.932     raeburn   535:         $wintitle = 'Community_Browser';
1.909     raeburn   536:     }
1.876     raeburn   537:     my $id_functions = &javascript_index_functions();
                    538:     my $output = '
1.776     bisitz    539: <script type="text/javascript" language="JavaScript">
1.824     bisitz    540: // <![CDATA[
1.468     raeburn   541:     var stdeditbrowser;'."\n";
1.876     raeburn   542: 
                    543:     $output .= <<"ENDSTDBRW";
1.909     raeburn   544:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       545:         var url = '/adm/pickcourse?';
1.895     raeburn   546:         var formid = getFormIdByName(formname);
1.876     raeburn   547:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  548:         if (domainfilter != null) {
                    549:            if (domainfilter != '') {
                    550:                url += 'domainfilter='+domainfilter+'&';
                    551: 	   }
                    552:         }
1.91      www       553:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  554: 	                            '&cdomelement='+udom+
                    555:                                     '&cnameelement='+desc;
1.468     raeburn   556:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   557:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   558:                 url += '&roleelement='+extra_element;
                    559:                 if (domainfilter == null || domainfilter == '') {
                    560:                     url += '&domainfilter='+extra_element;
                    561:                 }
1.234     raeburn   562:             }
1.468     raeburn   563:             else {
                    564:                 if (formname == 'portform') {
                    565:                     url += '&setroles='+extra_element;
1.800     raeburn   566:                 } else {
                    567:                     if (formname == 'rules') {
                    568:                         url += '&fixeddom='+extra_element; 
                    569:                     }
1.468     raeburn   570:                 }
                    571:             }     
1.230     raeburn   572:         }
1.909     raeburn   573:         if (type != null && type != '') {
                    574:             url += '&type='+type;
                    575:         }
                    576:         if (type_elem != null && type_elem != '') {
                    577:             url += '&typeelement='+type_elem;
                    578:         }
1.872     raeburn   579:         if (formname == 'ccrs') {
                    580:             var ownername = document.forms[formid].ccuname.value;
                    581:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
                    582:             url += '&cloner='+ownername+':'+ownerdom;
                    583:         }
1.293     raeburn   584:         if (multflag !=null && multflag != '') {
                    585:             url += '&multiple='+multflag;
                    586:         }
1.909     raeburn   587:         var title = '$wintitle';
1.91      www       588:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    589:         options += ',width=700,height=600';
                    590:         stdeditbrowser = open(url,title,options,'1');
                    591:         stdeditbrowser.focus();
                    592:     }
1.876     raeburn   593: $id_functions
                    594: ENDSTDBRW
1.1075.2.31  raeburn   595:     if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
                    596:         $output .= &setsec_javascript($sec_element,$formname,$role_element,
                    597:                                       $credits_element);
1.876     raeburn   598:     }
                    599:     $output .= '
                    600: // ]]>
                    601: </script>';
                    602:     return $output;
                    603: }
                    604: 
                    605: sub javascript_index_functions {
                    606:     return <<"ENDJS";
                    607: 
                    608: function getFormIdByName(formname) {
                    609:     for (var i=0;i<document.forms.length;i++) {
                    610:         if (document.forms[i].name == formname) {
                    611:             return i;
                    612:         }
                    613:     }
                    614:     return -1;
                    615: }
                    616: 
                    617: function getIndexByName(formid,item) {
                    618:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    619:         if (document.forms[formid].elements[i].name == item) {
                    620:             return i;
                    621:         }
                    622:     }
                    623:     return -1;
                    624: }
1.468     raeburn   625: 
1.876     raeburn   626: function getDomainFromSelectbox(formname,udom) {
                    627:     var userdom;
                    628:     var formid = getFormIdByName(formname);
                    629:     if (formid > -1) {
                    630:         var domid = getIndexByName(formid,udom);
                    631:         if (domid > -1) {
                    632:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    633:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    634:             }
                    635:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    636:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   637:             }
                    638:         }
                    639:     }
1.876     raeburn   640:     return userdom;
                    641: }
                    642: 
                    643: ENDJS
1.468     raeburn   644: 
1.876     raeburn   645: }
                    646: 
1.1017    raeburn   647: sub javascript_array_indexof {
1.1018    raeburn   648:     return <<ENDJS;
1.1017    raeburn   649: <script type="text/javascript" language="JavaScript">
                    650: // <![CDATA[
                    651: 
                    652: if (!Array.prototype.indexOf) {
                    653:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    654:         "use strict";
                    655:         if (this === void 0 || this === null) {
                    656:             throw new TypeError();
                    657:         }
                    658:         var t = Object(this);
                    659:         var len = t.length >>> 0;
                    660:         if (len === 0) {
                    661:             return -1;
                    662:         }
                    663:         var n = 0;
                    664:         if (arguments.length > 0) {
                    665:             n = Number(arguments[1]);
                    666:             if (n !== n) { // shortcut for verifying if it's NaN
                    667:                 n = 0;
                    668:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    669:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    670:             }
                    671:         }
                    672:         if (n >= len) {
                    673:             return -1;
                    674:         }
                    675:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    676:         for (; k < len; k++) {
                    677:             if (k in t && t[k] === searchElement) {
                    678:                 return k;
                    679:             }
                    680:         }
                    681:         return -1;
                    682:     }
                    683: }
                    684: 
                    685: // ]]>
                    686: </script>
                    687: 
                    688: ENDJS
                    689: 
                    690: }
                    691: 
1.876     raeburn   692: sub userbrowser_javascript {
                    693:     my $id_functions = &javascript_index_functions();
                    694:     return <<"ENDUSERBRW";
                    695: 
1.888     raeburn   696: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   697:     var url = '/adm/pickuser?';
                    698:     var userdom = getDomainFromSelectbox(formname,udom);
                    699:     if (userdom != null) {
                    700:        if (userdom != '') {
                    701:            url += 'srchdom='+userdom+'&';
                    702:        }
                    703:     }
                    704:     url += 'form=' + formname + '&unameelement='+uname+
                    705:                                 '&udomelement='+udom+
                    706:                                 '&ulastelement='+ulast+
                    707:                                 '&ufirstelement='+ufirst+
                    708:                                 '&uemailelement='+uemail+
1.881     raeburn   709:                                 '&hideudomelement='+hideudom+
                    710:                                 '&coursedom='+crsdom;
1.888     raeburn   711:     if ((caller != null) && (caller != undefined)) {
                    712:         url += '&caller='+caller;
                    713:     }
1.876     raeburn   714:     var title = 'User_Browser';
                    715:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    716:     options += ',width=700,height=600';
                    717:     var stdeditbrowser = open(url,title,options,'1');
                    718:     stdeditbrowser.focus();
                    719: }
                    720: 
1.888     raeburn   721: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   722:     var formid = getFormIdByName(formname);
                    723:     if (formid > -1) {
1.888     raeburn   724:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   725:         var domid = getIndexByName(formid,udom);
                    726:         var hidedomid = getIndexByName(formid,origdom);
                    727:         if (hidedomid > -1) {
                    728:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   729:             var unameval = document.forms[formid].elements[unameid].value;
                    730:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    731:                 if (domid > -1) {
                    732:                     var slct = document.forms[formid].elements[domid];
                    733:                     if (slct.type == 'select-one') {
                    734:                         var i;
                    735:                         for (i=0;i<slct.length;i++) {
                    736:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    737:                         }
                    738:                     }
                    739:                     if (slct.type == 'hidden') {
                    740:                         slct.value = fixeddom;
1.876     raeburn   741:                     }
                    742:                 }
1.468     raeburn   743:             }
                    744:         }
                    745:     }
1.876     raeburn   746:     return;
                    747: }
                    748: 
                    749: $id_functions
                    750: ENDUSERBRW
1.468     raeburn   751: }
                    752: 
                    753: sub setsec_javascript {
1.1075.2.31  raeburn   754:     my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905     raeburn   755:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    756:         $communityrolestr);
                    757:     if ($role_element ne '') {
                    758:         my @allroles = ('st','ta','ep','in','ad');
                    759:         foreach my $crstype ('Course','Community') {
                    760:             if ($crstype eq 'Community') {
                    761:                 foreach my $role (@allroles) {
                    762:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    763:                 }
                    764:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    765:             } else {
                    766:                 foreach my $role (@allroles) {
                    767:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    768:                 }
                    769:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    770:             }
                    771:         }
                    772:         $rolestr = '"'.join('","',@allroles).'"';
                    773:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    774:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    775:     }
1.468     raeburn   776:     my $setsections = qq|
                    777: function setSect(sectionlist) {
1.629     raeburn   778:     var sectionsArray = new Array();
                    779:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    780:         sectionsArray = sectionlist.split(",");
                    781:     }
1.468     raeburn   782:     var numSections = sectionsArray.length;
                    783:     document.$formname.$sec_element.length = 0;
                    784:     if (numSections == 0) {
                    785:         document.$formname.$sec_element.multiple=false;
                    786:         document.$formname.$sec_element.size=1;
                    787:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    788:     } else {
                    789:         if (numSections == 1) {
                    790:             document.$formname.$sec_element.multiple=false;
                    791:             document.$formname.$sec_element.size=1;
                    792:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    793:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    794:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    795:         } else {
                    796:             for (var i=0; i<numSections; i++) {
                    797:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    798:             }
                    799:             document.$formname.$sec_element.multiple=true
                    800:             if (numSections < 3) {
                    801:                 document.$formname.$sec_element.size=numSections;
                    802:             } else {
                    803:                 document.$formname.$sec_element.size=3;
                    804:             }
                    805:             document.$formname.$sec_element.options[0].selected = false
                    806:         }
                    807:     }
1.91      www       808: }
1.905     raeburn   809: 
                    810: function setRole(crstype) {
1.468     raeburn   811: |;
1.905     raeburn   812:     if ($role_element eq '') {
                    813:         $setsections .= '    return;
                    814: }
                    815: ';
                    816:     } else {
                    817:         $setsections .= qq|
                    818:     var elementLength = document.$formname.$role_element.length;
                    819:     var allroles = Array($rolestr);
                    820:     var courserolenames = Array($courserolestr);
                    821:     var communityrolenames = Array($communityrolestr);
                    822:     if (elementLength != undefined) {
                    823:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    824:             if (crstype == 'Course') {
                    825:                 return;
                    826:             } else {
                    827:                 allroles[5] = 'co';
                    828:                 for (var i=0; i<6; i++) {
                    829:                     document.$formname.$role_element.options[i].value = allroles[i];
                    830:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    831:                 }
                    832:             }
                    833:         } else {
                    834:             if (crstype == 'Community') {
                    835:                 return;
                    836:             } else {
                    837:                 allroles[5] = 'cc';
                    838:                 for (var i=0; i<6; i++) {
                    839:                     document.$formname.$role_element.options[i].value = allroles[i];
                    840:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    841:                 }
                    842:             }
                    843:         }
                    844:     }
                    845:     return;
                    846: }
                    847: |;
                    848:     }
1.1075.2.31  raeburn   849:     if ($credits_element) {
                    850:         $setsections .= qq|
                    851: function setCredits(defaultcredits) {
                    852:     document.$formname.$credits_element.value = defaultcredits;
                    853:     return;
                    854: }
                    855: |;
                    856:     }
1.468     raeburn   857:     return $setsections;
                    858: }
                    859: 
1.91      www       860: sub selectcourse_link {
1.909     raeburn   861:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    862:        $typeelement) = @_;
                    863:    my $type = $selecttype;
1.871     raeburn   864:    my $linktext = &mt('Select Course');
                    865:    if ($selecttype eq 'Community') {
1.909     raeburn   866:        $linktext = &mt('Select Community');
1.906     raeburn   867:    } elsif ($selecttype eq 'Course/Community') {
                    868:        $linktext = &mt('Select Course/Community');
1.909     raeburn   869:        $type = '';
1.1019    raeburn   870:    } elsif ($selecttype eq 'Select') {
                    871:        $linktext = &mt('Select');
                    872:        $type = '';
1.871     raeburn   873:    }
1.787     bisitz    874:    return '<span class="LC_nobreak">'
                    875:          ."<a href='"
                    876:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    877:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   878:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   879:          ."'>".$linktext.'</a>'
1.787     bisitz    880:          .'</span>';
1.74      www       881: }
1.42      matthew   882: 
1.653     raeburn   883: sub selectauthor_link {
                    884:    my ($form,$udom)=@_;
                    885:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    886:           &mt('Select Author').'</a>';
                    887: }
                    888: 
1.876     raeburn   889: sub selectuser_link {
1.881     raeburn   890:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   891:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   892:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   893:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   894:            ');">'.$linktext.'</a>';
1.876     raeburn   895: }
                    896: 
1.273     raeburn   897: sub check_uncheck_jscript {
                    898:     my $jscript = <<"ENDSCRT";
                    899: function checkAll(field) {
                    900:     if (field.length > 0) {
                    901:         for (i = 0; i < field.length; i++) {
1.1075.2.14  raeburn   902:             if (!field[i].disabled) {
                    903:                 field[i].checked = true;
                    904:             }
1.273     raeburn   905:         }
                    906:     } else {
1.1075.2.14  raeburn   907:         if (!field.disabled) {
                    908:             field.checked = true;
                    909:         }
1.273     raeburn   910:     }
                    911: }
                    912:  
                    913: function uncheckAll(field) {
                    914:     if (field.length > 0) {
                    915:         for (i = 0; i < field.length; i++) {
                    916:             field[i].checked = false ;
1.543     albertel  917:         }
                    918:     } else {
1.273     raeburn   919:         field.checked = false ;
                    920:     }
                    921: }
                    922: ENDSCRT
                    923:     return $jscript;
                    924: }
                    925: 
1.656     www       926: sub select_timezone {
1.659     raeburn   927:    my ($name,$selected,$onchange,$includeempty)=@_;
                    928:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    929:    if ($includeempty) {
                    930:        $output .= '<option value=""';
                    931:        if (($selected eq '') || ($selected eq 'local')) {
                    932:            $output .= ' selected="selected" ';
                    933:        }
                    934:        $output .= '> </option>';
                    935:    }
1.657     raeburn   936:    my @timezones = DateTime::TimeZone->all_names;
                    937:    foreach my $tzone (@timezones) {
                    938:        $output.= '<option value="'.$tzone.'"';
                    939:        if ($tzone eq $selected) {
                    940:            $output.=' selected="selected"';
                    941:        }
                    942:        $output.=">$tzone</option>\n";
1.656     www       943:    }
                    944:    $output.="</select>";
                    945:    return $output;
                    946: }
1.273     raeburn   947: 
1.687     raeburn   948: sub select_datelocale {
                    949:     my ($name,$selected,$onchange,$includeempty)=@_;
                    950:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    951:     if ($includeempty) {
                    952:         $output .= '<option value=""';
                    953:         if ($selected eq '') {
                    954:             $output .= ' selected="selected" ';
                    955:         }
                    956:         $output .= '> </option>';
                    957:     }
                    958:     my (@possibles,%locale_names);
                    959:     my @locales = DateTime::Locale::Catalog::Locales;
                    960:     foreach my $locale (@locales) {
                    961:         if (ref($locale) eq 'HASH') {
                    962:             my $id = $locale->{'id'};
                    963:             if ($id ne '') {
                    964:                 my $en_terr = $locale->{'en_territory'};
                    965:                 my $native_terr = $locale->{'native_territory'};
1.695     raeburn   966:                 my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   967:                 if (grep(/^en$/,@languages) || !@languages) {
                    968:                     if ($en_terr ne '') {
                    969:                         $locale_names{$id} = '('.$en_terr.')';
                    970:                     } elsif ($native_terr ne '') {
                    971:                         $locale_names{$id} = $native_terr;
                    972:                     }
                    973:                 } else {
                    974:                     if ($native_terr ne '') {
                    975:                         $locale_names{$id} = $native_terr.' ';
                    976:                     } elsif ($en_terr ne '') {
                    977:                         $locale_names{$id} = '('.$en_terr.')';
                    978:                     }
                    979:                 }
                    980:                 push (@possibles,$id);
                    981:             }
                    982:         }
                    983:     }
                    984:     foreach my $item (sort(@possibles)) {
                    985:         $output.= '<option value="'.$item.'"';
                    986:         if ($item eq $selected) {
                    987:             $output.=' selected="selected"';
                    988:         }
                    989:         $output.=">$item";
                    990:         if ($locale_names{$item} ne '') {
                    991:             $output.="  $locale_names{$item}</option>\n";
                    992:         }
                    993:         $output.="</option>\n";
                    994:     }
                    995:     $output.="</select>";
                    996:     return $output;
                    997: }
                    998: 
1.792     raeburn   999: sub select_language {
                   1000:     my ($name,$selected,$includeempty) = @_;
                   1001:     my %langchoices;
                   1002:     if ($includeempty) {
1.1075.2.32  raeburn  1003:         %langchoices = ('' => 'No language preference');
1.792     raeburn  1004:     }
                   1005:     foreach my $id (&languageids()) {
                   1006:         my $code = &supportedlanguagecode($id);
                   1007:         if ($code) {
                   1008:             $langchoices{$code} = &plainlanguagedescription($id);
                   1009:         }
                   1010:     }
1.1075.2.32  raeburn  1011:     %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970     raeburn  1012:     return &select_form($selected,$name,\%langchoices);
1.792     raeburn  1013: }
                   1014: 
1.42      matthew  1015: =pod
1.36      matthew  1016: 
1.648     raeburn  1017: =item * &linked_select_forms(...)
1.36      matthew  1018: 
                   1019: linked_select_forms returns a string containing a <script></script> block
                   1020: and html for two <select> menus.  The select menus will be linked in that
                   1021: changing the value of the first menu will result in new values being placed
                   1022: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1023: order unless a defined order is provided.
1.36      matthew  1024: 
                   1025: linked_select_forms takes the following ordered inputs:
                   1026: 
                   1027: =over 4
                   1028: 
1.112     bowersj2 1029: =item * $formname, the name of the <form> tag
1.36      matthew  1030: 
1.112     bowersj2 1031: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1032: 
1.112     bowersj2 1033: =item * $firstdefault, the default value for the first menu
1.36      matthew  1034: 
1.112     bowersj2 1035: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1036: 
1.112     bowersj2 1037: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1038: 
1.112     bowersj2 1039: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1040: 
1.609     raeburn  1041: =item * $menuorder, the order of values in the first menu
                   1042: 
1.1075.2.31  raeburn  1043: =item * $onchangefirst, additional javascript call to execute for an onchange
                   1044:         event for the first <select> tag
                   1045: 
                   1046: =item * $onchangesecond, additional javascript call to execute for an onchange
                   1047:         event for the second <select> tag
                   1048: 
1.41      ng       1049: =back 
                   1050: 
1.36      matthew  1051: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1052: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1053: values for the first select menu.  The text that coincides with the 
1.41      ng       1054: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1055: and text for the second menu are given in the hash pointed to by 
                   1056: $menu{$choice1}->{'select2'}.  
                   1057: 
1.112     bowersj2 1058:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1059:                        default => "B3",
                   1060:                        select2 => { 
                   1061:                            B1 => "Choice B1",
                   1062:                            B2 => "Choice B2",
                   1063:                            B3 => "Choice B3",
                   1064:                            B4 => "Choice B4"
1.609     raeburn  1065:                            },
                   1066:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1067:                    },
                   1068:                A2 => { text =>"Choice A2" ,
                   1069:                        default => "C2",
                   1070:                        select2 => { 
                   1071:                            C1 => "Choice C1",
                   1072:                            C2 => "Choice C2",
                   1073:                            C3 => "Choice C3"
1.609     raeburn  1074:                            },
                   1075:                        order => ['C2','C1','C3'],
1.112     bowersj2 1076:                    },
                   1077:                A3 => { text =>"Choice A3" ,
                   1078:                        default => "D6",
                   1079:                        select2 => { 
                   1080:                            D1 => "Choice D1",
                   1081:                            D2 => "Choice D2",
                   1082:                            D3 => "Choice D3",
                   1083:                            D4 => "Choice D4",
                   1084:                            D5 => "Choice D5",
                   1085:                            D6 => "Choice D6",
                   1086:                            D7 => "Choice D7"
1.609     raeburn  1087:                            },
                   1088:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1089:                    }
                   1090:                );
1.36      matthew  1091: 
                   1092: =cut
                   1093: 
                   1094: sub linked_select_forms {
                   1095:     my ($formname,
                   1096:         $middletext,
                   1097:         $firstdefault,
                   1098:         $firstselectname,
                   1099:         $secondselectname, 
1.609     raeburn  1100:         $hashref,
                   1101:         $menuorder,
1.1075.2.31  raeburn  1102:         $onchangefirst,
                   1103:         $onchangesecond
1.36      matthew  1104:         ) = @_;
                   1105:     my $second = "document.$formname.$secondselectname";
                   1106:     my $first = "document.$formname.$firstselectname";
                   1107:     # output the javascript to do the changing
                   1108:     my $result = '';
1.776     bisitz   1109:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1110:     $result.="// <![CDATA[\n";
1.36      matthew  1111:     $result.="var select2data = new Object();\n";
                   1112:     $" = '","';
                   1113:     my $debug = '';
                   1114:     foreach my $s1 (sort(keys(%$hashref))) {
                   1115:         $result.="select2data.d_$s1 = new Object();\n";        
                   1116:         $result.="select2data.d_$s1.def = new String('".
                   1117:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1118:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1119:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1120:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1121:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1122:         }
1.36      matthew  1123:         $result.="\"@s2values\");\n";
                   1124:         $result.="select2data.d_$s1.texts = new Array(";        
                   1125:         my @s2texts;
                   1126:         foreach my $value (@s2values) {
                   1127:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1128:         }
                   1129:         $result.="\"@s2texts\");\n";
                   1130:     }
                   1131:     $"=' ';
                   1132:     $result.= <<"END";
                   1133: 
                   1134: function select1_changed() {
                   1135:     // Determine new choice
                   1136:     var newvalue = "d_" + $first.value;
                   1137:     // update select2
                   1138:     var values     = select2data[newvalue].values;
                   1139:     var texts      = select2data[newvalue].texts;
                   1140:     var select2def = select2data[newvalue].def;
                   1141:     var i;
                   1142:     // out with the old
                   1143:     for (i = 0; i < $second.options.length; i++) {
                   1144:         $second.options[i] = null;
                   1145:     }
                   1146:     // in with the nuclear
                   1147:     for (i=0;i<values.length; i++) {
                   1148:         $second.options[i] = new Option(values[i]);
1.143     matthew  1149:         $second.options[i].value = values[i];
1.36      matthew  1150:         $second.options[i].text = texts[i];
                   1151:         if (values[i] == select2def) {
                   1152:             $second.options[i].selected = true;
                   1153:         }
                   1154:     }
                   1155: }
1.824     bisitz   1156: // ]]>
1.36      matthew  1157: </script>
                   1158: END
                   1159:     # output the initial values for the selection lists
1.1075.2.31  raeburn  1160:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609     raeburn  1161:     my @order = sort(keys(%{$hashref}));
                   1162:     if (ref($menuorder) eq 'ARRAY') {
                   1163:         @order = @{$menuorder};
                   1164:     }
                   1165:     foreach my $value (@order) {
1.36      matthew  1166:         $result.="    <option value=\"$value\" ";
1.253     albertel 1167:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1168:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1169:     }
                   1170:     $result .= "</select>\n";
                   1171:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1172:     $result .= $middletext;
1.1075.2.31  raeburn  1173:     $result .= "<select size=\"1\" name=\"$secondselectname\"";
                   1174:     if ($onchangesecond) {
                   1175:         $result .= ' onchange="'.$onchangesecond.'"';
                   1176:     }
                   1177:     $result .= ">\n";
1.36      matthew  1178:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1179:     
                   1180:     my @secondorder = sort(keys(%select2));
                   1181:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1182:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1183:     }
                   1184:     foreach my $value (@secondorder) {
1.36      matthew  1185:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1186:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1187:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1188:     }
                   1189:     $result .= "</select>\n";
                   1190:     #    return $debug;
                   1191:     return $result;
                   1192: }   #  end of sub linked_select_forms {
                   1193: 
1.45      matthew  1194: =pod
1.44      bowersj2 1195: 
1.973     raeburn  1196: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1197: 
1.112     bowersj2 1198: Returns a string corresponding to an HTML link to the given help
                   1199: $topic, where $topic corresponds to the name of a .tex file in
                   1200: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1201: spaces. 
                   1202: 
                   1203: $text will optionally be linked to the same topic, allowing you to
                   1204: link text in addition to the graphic. If you do not want to link
                   1205: text, but wish to specify one of the later parameters, pass an
                   1206: empty string. 
                   1207: 
                   1208: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1209: the link will not open a new window. If false, the link will open
                   1210: a new window using Javascript. (Default is false.) 
                   1211: 
                   1212: $width and $height are optional numerical parameters that will
                   1213: override the width and height of the popped up window, which may
1.973     raeburn  1214: be useful for certain help topics with big pictures included.
                   1215: 
                   1216: $imgid is the id of the img tag used for the help icon. This may be
                   1217: used in a javascript call to switch the image src.  See 
                   1218: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1219: 
                   1220: =cut
                   1221: 
                   1222: sub help_open_topic {
1.973     raeburn  1223:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1224:     $text = "" if (not defined $text);
1.44      bowersj2 1225:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1226:     $width = 500 if (not defined $width);
1.44      bowersj2 1227:     $height = 400 if (not defined $height);
                   1228:     my $filename = $topic;
                   1229:     $filename =~ s/ /_/g;
                   1230: 
1.48      bowersj2 1231:     my $template = "";
                   1232:     my $link;
1.572     banghart 1233:     
1.159     www      1234:     $topic=~s/\W/\_/g;
1.44      bowersj2 1235: 
1.572     banghart 1236:     if (!$stayOnPage) {
1.1033    www      1237: 	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037    www      1238:     } elsif ($stayOnPage eq 'popup') {
                   1239:         $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 1240:     } else {
1.48      bowersj2 1241: 	$link = "/adm/help/${filename}.hlp";
                   1242:     }
                   1243: 
                   1244:     # Add the text
1.755     neumanie 1245:     if ($text ne "") {	
1.763     bisitz   1246: 	$template.='<span class="LC_help_open_topic">'
                   1247:                   .'<a target="_top" href="'.$link.'">'
                   1248:                   .$text.'</a>';
1.48      bowersj2 1249:     }
                   1250: 
1.763     bisitz   1251:     # (Always) Add the graphic
1.179     matthew  1252:     my $title = &mt('Online Help');
1.667     raeburn  1253:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1254:     if ($imgid ne '') {
                   1255:         $imgid = ' id="'.$imgid.'"';
                   1256:     }
1.763     bisitz   1257:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1258:               .'<img src="'.$helpicon.'" border="0"'
                   1259:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1260:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1261:               .' /></a>';
                   1262:     if ($text ne "") {	
                   1263:         $template.='</span>';
                   1264:     }
1.44      bowersj2 1265:     return $template;
                   1266: 
1.106     bowersj2 1267: }
                   1268: 
                   1269: # This is a quicky function for Latex cheatsheet editing, since it 
                   1270: # appears in at least four places
                   1271: sub helpLatexCheatsheet {
1.1037    www      1272:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1273:     my $out;
1.106     bowersj2 1274:     my $addOther = '';
1.732     raeburn  1275:     if ($topic) {
1.1037    www      1276: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1277:     }
                   1278:     $out = '<span>' # Start cheatsheet
                   1279: 	  .$addOther
                   1280:           .'<span>'
1.1037    www      1281: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1282: 	  .'</span> <span>'
1.1037    www      1283: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1284: 	  .'</span>';
1.732     raeburn  1285:     unless ($not_author) {
1.763     bisitz   1286:         $out .= ' <span>'
1.1037    www      1287: 	       .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.763     bisitz   1288: 	       .'</span>';
1.732     raeburn  1289:     }
1.763     bisitz   1290:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1291:     return $out;
1.172     www      1292: }
                   1293: 
1.430     albertel 1294: sub general_help {
                   1295:     my $helptopic='Student_Intro';
                   1296:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1297: 	$helptopic='Authoring_Intro';
1.907     raeburn  1298:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1299: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1300:     } elsif ($env{'request.role'}=~/^dc/) {
                   1301:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1302:     }
                   1303:     return $helptopic;
                   1304: }
                   1305: 
                   1306: sub update_help_link {
                   1307:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1308:     my $origurl = $ENV{'REQUEST_URI'};
                   1309:     $origurl=~s|^/~|/priv/|;
                   1310:     my $timestamp = time;
                   1311:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1312:         $$datum = &escape($$datum);
                   1313:     }
                   1314: 
                   1315:     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";
                   1316:     my $output .= <<"ENDOUTPUT";
                   1317: <script type="text/javascript">
1.824     bisitz   1318: // <![CDATA[
1.430     albertel 1319: banner_link = '$banner_link';
1.824     bisitz   1320: // ]]>
1.430     albertel 1321: </script>
                   1322: ENDOUTPUT
                   1323:     return $output;
                   1324: }
                   1325: 
                   1326: # now just updates the help link and generates a blue icon
1.193     raeburn  1327: sub help_open_menu {
1.430     albertel 1328:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1329: 	= @_;    
1.949     droeschl 1330:     $stayOnPage = 1;
1.430     albertel 1331:     my $output;
                   1332:     if ($component_help) {
                   1333: 	if (!$text) {
                   1334: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1335: 				       $width,$height);
                   1336: 	} else {
                   1337: 	    my $help_text;
                   1338: 	    $help_text=&unescape($topic);
                   1339: 	    $output='<table><tr><td>'.
                   1340: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1341: 				 $width,$height).'</td></tr></table>';
                   1342: 	}
                   1343:     }
                   1344:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1345:     return $output.$banner_link;
                   1346: }
                   1347: 
                   1348: sub top_nav_help {
                   1349:     my ($text) = @_;
1.436     albertel 1350:     $text = &mt($text);
1.949     droeschl 1351:     my $stay_on_page = 1;
                   1352: 
1.572     banghart 1353:     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436     albertel 1354: 	                     : "javascript:helpMenu('open')";
1.572     banghart 1355:     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436     albertel 1356: 
1.201     raeburn  1357:     my $title = &mt('Get help');
1.436     albertel 1358: 
                   1359:     return <<"END";
                   1360: $banner_link
                   1361:  <a href="$link" title="$title">$text</a>
                   1362: END
                   1363: }
                   1364: 
                   1365: sub help_menu_js {
                   1366:     my ($text) = @_;
1.949     droeschl 1367:     my $stayOnPage = 1;
1.436     albertel 1368:     my $width = 620;
                   1369:     my $height = 600;
1.430     albertel 1370:     my $helptopic=&general_help();
                   1371:     my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1372:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1373:     my $start_page =
                   1374:         &Apache::loncommon::start_page('Help Menu', undef,
                   1375: 				       {'frameset'    => 1,
                   1376: 					'js_ready'    => 1,
                   1377: 					'add_entries' => {
                   1378: 					    'border' => '0',
1.579     raeburn  1379: 					    'rows'   => "110,*",},});
1.331     albertel 1380:     my $end_page =
                   1381:         &Apache::loncommon::end_page({'frameset' => 1,
                   1382: 				      'js_ready' => 1,});
                   1383: 
1.436     albertel 1384:     my $template .= <<"ENDTEMPLATE";
                   1385: <script type="text/javascript">
1.877     bisitz   1386: // <![CDATA[
1.253     albertel 1387: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1388: var banner_link = '';
1.243     raeburn  1389: function helpMenu(target) {
                   1390:     var caller = this;
                   1391:     if (target == 'open') {
                   1392:         var newWindow = null;
                   1393:         try {
1.262     albertel 1394:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1395:         }
                   1396:         catch(error) {
                   1397:             writeHelp(caller);
                   1398:             return;
                   1399:         }
                   1400:         if (newWindow) {
                   1401:             caller = newWindow;
                   1402:         }
1.193     raeburn  1403:     }
1.243     raeburn  1404:     writeHelp(caller);
                   1405:     return;
                   1406: }
                   1407: function writeHelp(caller) {
1.1072    raeburn  1408:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" />\\n<frame name="bodyframe" src="$details_link" />\\n$end_page')
1.243     raeburn  1409:     caller.document.close()
                   1410:     caller.focus()
1.193     raeburn  1411: }
1.877     bisitz   1412: // END LON-CAPA Internal -->
1.253     albertel 1413: // ]]>
1.436     albertel 1414: </script>
1.193     raeburn  1415: ENDTEMPLATE
                   1416:     return $template;
                   1417: }
                   1418: 
1.172     www      1419: sub help_open_bug {
                   1420:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1421:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1422:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1423:     $text = "" if (not defined $text);
                   1424: 	$stayOnPage=1;
1.184     albertel 1425:     $width = 600 if (not defined $width);
                   1426:     $height = 600 if (not defined $height);
1.172     www      1427: 
                   1428:     $topic=~s/\W+/\+/g;
                   1429:     my $link='';
                   1430:     my $template='';
1.379     albertel 1431:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1432: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1433:     if (!$stayOnPage)
                   1434:     {
                   1435: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1436:     }
                   1437:     else
                   1438:     {
                   1439: 	$link = $url;
                   1440:     }
                   1441:     # Add the text
                   1442:     if ($text ne "")
                   1443:     {
                   1444: 	$template .= 
                   1445:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1446:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1447:     }
                   1448: 
                   1449:     # Add the graphic
1.179     matthew  1450:     my $title = &mt('Report a Bug');
1.215     albertel 1451:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1452:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1453:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1454: ENDTEMPLATE
                   1455:     if ($text ne '') { $template.='</td></tr></table>' };
                   1456:     return $template;
                   1457: 
                   1458: }
                   1459: 
                   1460: sub help_open_faq {
                   1461:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1462:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1463:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1464:     $text = "" if (not defined $text);
                   1465: 	$stayOnPage=1;
                   1466:     $width = 350 if (not defined $width);
                   1467:     $height = 400 if (not defined $height);
                   1468: 
                   1469:     $topic=~s/\W+/\+/g;
                   1470:     my $link='';
                   1471:     my $template='';
                   1472:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1473:     if (!$stayOnPage)
                   1474:     {
                   1475: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1476:     }
                   1477:     else
                   1478:     {
                   1479: 	$link = $url;
                   1480:     }
                   1481: 
                   1482:     # Add the text
                   1483:     if ($text ne "")
                   1484:     {
                   1485: 	$template .= 
1.173     www      1486:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1487:   "<td bgcolor='#448844'><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('View the FAQ');
1.215     albertel 1492:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1493:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1494:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1495: ENDTEMPLATE
                   1496:     if ($text ne '') { $template.='</td></tr></table>' };
                   1497:     return $template;
                   1498: 
1.44      bowersj2 1499: }
1.37      matthew  1500: 
1.180     matthew  1501: ###############################################################
                   1502: ###############################################################
                   1503: 
1.45      matthew  1504: =pod
                   1505: 
1.648     raeburn  1506: =item * &change_content_javascript():
1.256     matthew  1507: 
                   1508: This and the next function allow you to create small sections of an
                   1509: otherwise static HTML page that you can update on the fly with
                   1510: Javascript, even in Netscape 4.
                   1511: 
                   1512: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1513: must be written to the HTML page once. It will prove the Javascript
                   1514: function "change(name, content)". Calling the change function with the
                   1515: name of the section 
                   1516: you want to update, matching the name passed to C<changable_area>, and
                   1517: the new content you want to put in there, will put the content into
                   1518: that area.
                   1519: 
                   1520: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1521: to contain room for the original contents. You need to "make space"
                   1522: for whatever changes you wish to make, and be B<sure> to check your
                   1523: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1524: it's adequate for updating a one-line status display, but little more.
                   1525: This script will set the space to 100% width, so you only need to
                   1526: worry about height in Netscape 4.
                   1527: 
                   1528: Modern browsers are much less limiting, and if you can commit to the
                   1529: user not using Netscape 4, this feature may be used freely with
                   1530: pretty much any HTML.
                   1531: 
                   1532: =cut
                   1533: 
                   1534: sub change_content_javascript {
                   1535:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1536:     if ($env{'browser.type'} eq 'netscape' &&
                   1537: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1538: 	return (<<NETSCAPE4);
                   1539: 	function change(name, content) {
                   1540: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1541: 	    doc.open();
                   1542: 	    doc.write(content);
                   1543: 	    doc.close();
                   1544: 	}
                   1545: NETSCAPE4
                   1546:     } else {
                   1547: 	# Otherwise, we need to use semi-standards-compliant code
                   1548: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1549: 	# is really scary, and every useful browser supports it
                   1550: 	return (<<DOMBASED);
                   1551: 	function change(name, content) {
                   1552: 	    element = document.getElementById(name);
                   1553: 	    element.innerHTML = content;
                   1554: 	}
                   1555: DOMBASED
                   1556:     }
                   1557: }
                   1558: 
                   1559: =pod
                   1560: 
1.648     raeburn  1561: =item * &changable_area($name,$origContent):
1.256     matthew  1562: 
                   1563: This provides a "changable area" that can be modified on the fly via
                   1564: the Javascript code provided in C<change_content_javascript>. $name is
                   1565: the name you will use to reference the area later; do not repeat the
                   1566: same name on a given HTML page more then once. $origContent is what
                   1567: the area will originally contain, which can be left blank.
                   1568: 
                   1569: =cut
                   1570: 
                   1571: sub changable_area {
                   1572:     my ($name, $origContent) = @_;
                   1573: 
1.258     albertel 1574:     if ($env{'browser.type'} eq 'netscape' &&
                   1575: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1576: 	# If this is netscape 4, we need to use the Layer tag
                   1577: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1578:     } else {
                   1579: 	return "<span id='$name'>$origContent</span>";
                   1580:     }
                   1581: }
                   1582: 
                   1583: =pod
                   1584: 
1.648     raeburn  1585: =item * &viewport_geometry_js 
1.590     raeburn  1586: 
                   1587: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1588: 
                   1589: =cut
                   1590: 
                   1591: 
                   1592: sub viewport_geometry_js { 
                   1593:     return <<"GEOMETRY";
                   1594: var Geometry = {};
                   1595: function init_geometry() {
                   1596:     if (Geometry.init) { return };
                   1597:     Geometry.init=1;
                   1598:     if (window.innerHeight) {
                   1599:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1600:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1601:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1602:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1603:     }
                   1604:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1605:         Geometry.getViewportHeight =
                   1606:             function() { return document.documentElement.clientHeight; };
                   1607:         Geometry.getViewportWidth =
                   1608:             function() { return document.documentElement.clientWidth; };
                   1609: 
                   1610:         Geometry.getHorizontalScroll =
                   1611:             function() { return document.documentElement.scrollLeft; };
                   1612:         Geometry.getVerticalScroll =
                   1613:             function() { return document.documentElement.scrollTop; };
                   1614:     }
                   1615:     else if (document.body.clientHeight) {
                   1616:         Geometry.getViewportHeight =
                   1617:             function() { return document.body.clientHeight; };
                   1618:         Geometry.getViewportWidth =
                   1619:             function() { return document.body.clientWidth; };
                   1620:         Geometry.getHorizontalScroll =
                   1621:             function() { return document.body.scrollLeft; };
                   1622:         Geometry.getVerticalScroll =
                   1623:             function() { return document.body.scrollTop; };
                   1624:     }
                   1625: }
                   1626: 
                   1627: GEOMETRY
                   1628: }
                   1629: 
                   1630: =pod
                   1631: 
1.648     raeburn  1632: =item * &viewport_size_js()
1.590     raeburn  1633: 
                   1634: 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. 
                   1635: 
                   1636: =cut
                   1637: 
                   1638: sub viewport_size_js {
                   1639:     my $geometry = &viewport_geometry_js();
                   1640:     return <<"DIMS";
                   1641: 
                   1642: $geometry
                   1643: 
                   1644: function getViewportDims(width,height) {
                   1645:     init_geometry();
                   1646:     width.value = Geometry.getViewportWidth();
                   1647:     height.value = Geometry.getViewportHeight();
                   1648:     return;
                   1649: }
                   1650: 
                   1651: DIMS
                   1652: }
                   1653: 
                   1654: =pod
                   1655: 
1.648     raeburn  1656: =item * &resize_textarea_js()
1.565     albertel 1657: 
                   1658: emits the needed javascript to resize a textarea to be as big as possible
                   1659: 
                   1660: creates a function resize_textrea that takes two IDs first should be
                   1661: the id of the element to resize, second should be the id of a div that
                   1662: surrounds everything that comes after the textarea, this routine needs
                   1663: to be attached to the <body> for the onload and onresize events.
                   1664: 
1.648     raeburn  1665: =back
1.565     albertel 1666: 
                   1667: =cut
                   1668: 
                   1669: sub resize_textarea_js {
1.590     raeburn  1670:     my $geometry = &viewport_geometry_js();
1.565     albertel 1671:     return <<"RESIZE";
                   1672:     <script type="text/javascript">
1.824     bisitz   1673: // <![CDATA[
1.590     raeburn  1674: $geometry
1.565     albertel 1675: 
1.588     albertel 1676: function getX(element) {
                   1677:     var x = 0;
                   1678:     while (element) {
                   1679: 	x += element.offsetLeft;
                   1680: 	element = element.offsetParent;
                   1681:     }
                   1682:     return x;
                   1683: }
                   1684: function getY(element) {
                   1685:     var y = 0;
                   1686:     while (element) {
                   1687: 	y += element.offsetTop;
                   1688: 	element = element.offsetParent;
                   1689:     }
                   1690:     return y;
                   1691: }
                   1692: 
                   1693: 
1.565     albertel 1694: function resize_textarea(textarea_id,bottom_id) {
                   1695:     init_geometry();
                   1696:     var textarea        = document.getElementById(textarea_id);
                   1697:     //alert(textarea);
                   1698: 
1.588     albertel 1699:     var textarea_top    = getY(textarea);
1.565     albertel 1700:     var textarea_height = textarea.offsetHeight;
                   1701:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1702:     var bottom_top      = getY(bottom);
1.565     albertel 1703:     var bottom_height   = bottom.offsetHeight;
                   1704:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1705:     var fudge           = 23;
1.565     albertel 1706:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1707:     if (new_height < 300) {
                   1708: 	new_height = 300;
                   1709:     }
                   1710:     textarea.style.height=new_height+'px';
                   1711: }
1.824     bisitz   1712: // ]]>
1.565     albertel 1713: </script>
                   1714: RESIZE
                   1715: 
                   1716: }
                   1717: 
                   1718: =pod
                   1719: 
1.256     matthew  1720: =head1 Excel and CSV file utility routines
                   1721: 
                   1722: =over 4
                   1723: 
                   1724: =cut
                   1725: 
                   1726: ###############################################################
                   1727: ###############################################################
                   1728: 
                   1729: =pod
                   1730: 
1.648     raeburn  1731: =item * &csv_translate($text) 
1.37      matthew  1732: 
1.185     www      1733: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1734: format.
                   1735: 
                   1736: =cut
                   1737: 
1.180     matthew  1738: ###############################################################
                   1739: ###############################################################
1.37      matthew  1740: sub csv_translate {
                   1741:     my $text = shift;
                   1742:     $text =~ s/\"/\"\"/g;
1.209     albertel 1743:     $text =~ s/\n/ /g;
1.37      matthew  1744:     return $text;
                   1745: }
1.180     matthew  1746: 
                   1747: ###############################################################
                   1748: ###############################################################
                   1749: 
                   1750: =pod
                   1751: 
1.648     raeburn  1752: =item * &define_excel_formats()
1.180     matthew  1753: 
                   1754: Define some commonly used Excel cell formats.
                   1755: 
                   1756: Currently supported formats:
                   1757: 
                   1758: =over 4
                   1759: 
                   1760: =item header
                   1761: 
                   1762: =item bold
                   1763: 
                   1764: =item h1
                   1765: 
                   1766: =item h2
                   1767: 
                   1768: =item h3
                   1769: 
1.256     matthew  1770: =item h4
                   1771: 
                   1772: =item i
                   1773: 
1.180     matthew  1774: =item date
                   1775: 
                   1776: =back
                   1777: 
                   1778: Inputs: $workbook
                   1779: 
                   1780: Returns: $format, a hash reference.
                   1781: 
1.1057    foxr     1782: 
1.180     matthew  1783: =cut
                   1784: 
                   1785: ###############################################################
                   1786: ###############################################################
                   1787: sub define_excel_formats {
                   1788:     my ($workbook) = @_;
                   1789:     my $format;
                   1790:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1791:                                                 bottom    => 1,
                   1792:                                                 align     => 'center');
                   1793:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1794:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1795:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1796:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1797:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1798:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1799:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1800:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1801:     return $format;
                   1802: }
                   1803: 
                   1804: ###############################################################
                   1805: ###############################################################
1.113     bowersj2 1806: 
                   1807: =pod
                   1808: 
1.648     raeburn  1809: =item * &create_workbook()
1.255     matthew  1810: 
                   1811: Create an Excel worksheet.  If it fails, output message on the
                   1812: request object and return undefs.
                   1813: 
                   1814: Inputs: Apache request object
                   1815: 
                   1816: Returns (undef) on failure, 
                   1817:     Excel worksheet object, scalar with filename, and formats 
                   1818:     from &Apache::loncommon::define_excel_formats on success
                   1819: 
                   1820: =cut
                   1821: 
                   1822: ###############################################################
                   1823: ###############################################################
                   1824: sub create_workbook {
                   1825:     my ($r) = @_;
                   1826:         #
                   1827:     # Create the excel spreadsheet
                   1828:     my $filename = '/prtspool/'.
1.258     albertel 1829:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1830:         time.'_'.rand(1000000000).'.xls';
                   1831:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1832:     if (! defined($workbook)) {
                   1833:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1834:         $r->print(
                   1835:             '<p class="LC_error">'
                   1836:            .&mt('Problems occurred in creating the new Excel file.')
                   1837:            .' '.&mt('This error has been logged.')
                   1838:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1839:            .'</p>'
                   1840:         );
1.255     matthew  1841:         return (undef);
                   1842:     }
                   1843:     #
1.1014    foxr     1844:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  1845:     #
                   1846:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1847:     return ($workbook,$filename,$format);
                   1848: }
                   1849: 
                   1850: ###############################################################
                   1851: ###############################################################
                   1852: 
                   1853: =pod
                   1854: 
1.648     raeburn  1855: =item * &create_text_file()
1.113     bowersj2 1856: 
1.542     raeburn  1857: Create a file to write to and eventually make available to the user.
1.256     matthew  1858: If file creation fails, outputs an error message on the request object and 
                   1859: return undefs.
1.113     bowersj2 1860: 
1.256     matthew  1861: Inputs: Apache request object, and file suffix
1.113     bowersj2 1862: 
1.256     matthew  1863: Returns (undef) on failure, 
                   1864:     Filehandle and filename on success.
1.113     bowersj2 1865: 
                   1866: =cut
                   1867: 
1.256     matthew  1868: ###############################################################
                   1869: ###############################################################
                   1870: sub create_text_file {
                   1871:     my ($r,$suffix) = @_;
                   1872:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1873:     my $fh;
                   1874:     my $filename = '/prtspool/'.
1.258     albertel 1875:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1876:         time.'_'.rand(1000000000).'.'.$suffix;
                   1877:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1878:     if (! defined($fh)) {
                   1879:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1880:         $r->print(
                   1881:             '<p class="LC_error">'
                   1882:            .&mt('Problems occurred in creating the output file.')
                   1883:            .' '.&mt('This error has been logged.')
                   1884:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1885:            .'</p>'
                   1886:         );
1.113     bowersj2 1887:     }
1.256     matthew  1888:     return ($fh,$filename)
1.113     bowersj2 1889: }
                   1890: 
                   1891: 
1.256     matthew  1892: =pod 
1.113     bowersj2 1893: 
                   1894: =back
                   1895: 
                   1896: =cut
1.37      matthew  1897: 
                   1898: ###############################################################
1.33      matthew  1899: ##        Home server <option> list generating code          ##
                   1900: ###############################################################
1.35      matthew  1901: 
1.169     www      1902: # ------------------------------------------
                   1903: 
                   1904: sub domain_select {
                   1905:     my ($name,$value,$multiple)=@_;
                   1906:     my %domains=map { 
1.514     albertel 1907: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1908:     } &Apache::lonnet::all_domains();
1.169     www      1909:     if ($multiple) {
                   1910: 	$domains{''}=&mt('Any domain');
1.550     albertel 1911: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1912: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1913:     } else {
1.550     albertel 1914: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1915: 	return &select_form($name,$value,\%domains);
1.169     www      1916:     }
                   1917: }
                   1918: 
1.282     albertel 1919: #-------------------------------------------
                   1920: 
                   1921: =pod
                   1922: 
1.519     raeburn  1923: =head1 Routines for form select boxes
                   1924: 
                   1925: =over 4
                   1926: 
1.648     raeburn  1927: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1928: 
                   1929: Returns a string containing a <select> element int multiple mode
                   1930: 
                   1931: 
                   1932: Args:
                   1933:   $name - name of the <select> element
1.506     raeburn  1934:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1935:   $size - number of rows long the select element is
1.283     albertel 1936:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1937:           (shown text should already have been &mt())
1.506     raeburn  1938:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1939: 
1.282     albertel 1940: =cut
                   1941: 
                   1942: #-------------------------------------------
1.169     www      1943: sub multiple_select_form {
1.284     albertel 1944:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1945:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1946:     my $output='';
1.191     matthew  1947:     if (! defined($size)) {
                   1948:         $size = 4;
1.283     albertel 1949:         if (scalar(keys(%$hash))<4) {
                   1950:             $size = scalar(keys(%$hash));
1.191     matthew  1951:         }
                   1952:     }
1.734     bisitz   1953:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1954:     my @order;
1.506     raeburn  1955:     if (ref($order) eq 'ARRAY')  {
                   1956:         @order = @{$order};
                   1957:     } else {
                   1958:         @order = sort(keys(%$hash));
1.501     banghart 1959:     }
                   1960:     if (exists($$hash{'select_form_order'})) {
                   1961:         @order = @{$$hash{'select_form_order'}};
                   1962:     }
                   1963:         
1.284     albertel 1964:     foreach my $key (@order) {
1.356     albertel 1965:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1966:         $output.='selected="selected" ' if ($selected{$key});
                   1967:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1968:     }
                   1969:     $output.="</select>\n";
                   1970:     return $output;
                   1971: }
                   1972: 
1.88      www      1973: #-------------------------------------------
                   1974: 
                   1975: =pod
                   1976: 
1.970     raeburn  1977: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      1978: 
                   1979: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  1980: allow a user to select options from a ref to a hash containing:
                   1981: option_name => displayed text. An optional $onchange can include
                   1982: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   1983: 
1.88      www      1984: See lonrights.pm for an example invocation and use.
                   1985: 
                   1986: =cut
                   1987: 
                   1988: #-------------------------------------------
                   1989: sub select_form {
1.970     raeburn  1990:     my ($def,$name,$hashref,$onchange) = @_;
                   1991:     return unless (ref($hashref) eq 'HASH');
                   1992:     if ($onchange) {
                   1993:         $onchange = ' onchange="'.$onchange.'"';
                   1994:     }
                   1995:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 1996:     my @keys;
1.970     raeburn  1997:     if (exists($hashref->{'select_form_order'})) {
                   1998: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 1999:     } else {
1.970     raeburn  2000: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2001:     }
1.356     albertel 2002:     foreach my $key (@keys) {
                   2003:         $selectform.=
                   2004: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2005:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2006:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2007:     }
                   2008:     $selectform.="</select>";
                   2009:     return $selectform;
                   2010: }
                   2011: 
1.475     www      2012: # For display filters
                   2013: 
                   2014: sub display_filter {
1.1074    raeburn  2015:     my ($context) = @_;
1.475     www      2016:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2017:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2018:     my $phraseinput = 'hidden';
                   2019:     my $includeinput = 'hidden';
                   2020:     my ($checked,$includetypestext);
                   2021:     if ($env{'form.displayfilter'} eq 'containing') {
                   2022:         $phraseinput = 'text'; 
                   2023:         if ($context eq 'parmslog') {
                   2024:             $includeinput = 'checkbox';
                   2025:             if ($env{'form.includetypes'}) {
                   2026:                 $checked = ' checked="checked"';
                   2027:             }
                   2028:             $includetypestext = &mt('Include parameter types');
                   2029:         }
                   2030:     } else {
                   2031:         $includetypestext = '&nbsp;';
                   2032:     }
                   2033:     my ($additional,$secondid,$thirdid);
                   2034:     if ($context eq 'parmslog') {
                   2035:         $additional = 
                   2036:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2037:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2038:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2039:             '</label>';
                   2040:         $secondid = 'includetypes';
                   2041:         $thirdid = 'includetypestext';
                   2042:     }
                   2043:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2044:                                                     '$secondid','$thirdid')";
                   2045:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2046: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2047: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2048: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2049:            &mt('Filter: [_1]',
1.477     www      2050: 	   &select_form($env{'form.displayfilter'},
                   2051: 			'displayfilter',
1.970     raeburn  2052: 			{'currentfolder' => 'Current folder/page',
1.477     www      2053: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2054: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2055: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2056:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2057:                          '" />'.$additional;
                   2058: }
                   2059: 
                   2060: sub display_filter_js {
                   2061:     my $includetext = &mt('Include parameter types');
                   2062:     return <<"ENDJS";
                   2063:   
                   2064: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2065:     var firstType = 'hidden';
                   2066:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2067:         firstType = 'text';
                   2068:     }
                   2069:     firstObject = document.getElementById(firstid);
                   2070:     if (typeof(firstObject) == 'object') {
                   2071:         if (firstObject.type != firstType) {
                   2072:             changeInputType(firstObject,firstType);
                   2073:         }
                   2074:     }
                   2075:     if (context == 'parmslog') {
                   2076:         var secondType = 'hidden';
                   2077:         if (firstType == 'text') {
                   2078:             secondType = 'checkbox';
                   2079:         }
                   2080:         secondObject = document.getElementById(secondid);  
                   2081:         if (typeof(secondObject) == 'object') {
                   2082:             if (secondObject.type != secondType) {
                   2083:                 changeInputType(secondObject,secondType);
                   2084:             }
                   2085:         }
                   2086:         var textItem = document.getElementById(thirdid);
                   2087:         var currtext = textItem.innerHTML;
                   2088:         var newtext;
                   2089:         if (firstType == 'text') {
                   2090:             newtext = '$includetext';
                   2091:         } else {
                   2092:             newtext = '&nbsp;';
                   2093:         }
                   2094:         if (currtext != newtext) {
                   2095:             textItem.innerHTML = newtext;
                   2096:         }
                   2097:     }
                   2098:     return;
                   2099: }
                   2100: 
                   2101: function changeInputType(oldObject,newType) {
                   2102:     var newObject = document.createElement('input');
                   2103:     newObject.type = newType;
                   2104:     if (oldObject.size) {
                   2105:         newObject.size = oldObject.size;
                   2106:     }
                   2107:     if (oldObject.value) {
                   2108:         newObject.value = oldObject.value;
                   2109:     }
                   2110:     if (oldObject.name) {
                   2111:         newObject.name = oldObject.name;
                   2112:     }
                   2113:     if (oldObject.id) {
                   2114:         newObject.id = oldObject.id;
                   2115:     }
                   2116:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2117:     return;
                   2118: }
                   2119: 
                   2120: ENDJS
1.475     www      2121: }
                   2122: 
1.167     www      2123: sub gradeleveldescription {
                   2124:     my $gradelevel=shift;
                   2125:     my %gradelevels=(0 => 'Not specified',
                   2126: 		     1 => 'Grade 1',
                   2127: 		     2 => 'Grade 2',
                   2128: 		     3 => 'Grade 3',
                   2129: 		     4 => 'Grade 4',
                   2130: 		     5 => 'Grade 5',
                   2131: 		     6 => 'Grade 6',
                   2132: 		     7 => 'Grade 7',
                   2133: 		     8 => 'Grade 8',
                   2134: 		     9 => 'Grade 9',
                   2135: 		     10 => 'Grade 10',
                   2136: 		     11 => 'Grade 11',
                   2137: 		     12 => 'Grade 12',
                   2138: 		     13 => 'Grade 13',
                   2139: 		     14 => '100 Level',
                   2140: 		     15 => '200 Level',
                   2141: 		     16 => '300 Level',
                   2142: 		     17 => '400 Level',
                   2143: 		     18 => 'Graduate Level');
                   2144:     return &mt($gradelevels{$gradelevel});
                   2145: }
                   2146: 
1.163     www      2147: sub select_level_form {
                   2148:     my ($deflevel,$name)=@_;
                   2149:     unless ($deflevel) { $deflevel=0; }
1.167     www      2150:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2151:     for (my $i=0; $i<=18; $i++) {
                   2152:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2153:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2154:                 ">".&gradeleveldescription($i)."</option>\n";
                   2155:     }
                   2156:     $selectform.="</select>";
                   2157:     return $selectform;
1.163     www      2158: }
1.167     www      2159: 
1.35      matthew  2160: #-------------------------------------------
                   2161: 
1.45      matthew  2162: =pod
                   2163: 
1.1075.2.42  raeburn  2164: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35      matthew  2165: 
                   2166: Returns a string containing a <select name='$name' size='1'> form to 
                   2167: allow a user to select the domain to preform an operation in.  
                   2168: See loncreateuser.pm for an example invocation and use.
                   2169: 
1.90      www      2170: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2171: selected");
                   2172: 
1.743     raeburn  2173: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2174: 
1.910     raeburn  2175: 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.
                   2176: 
1.1075.2.36  raeburn  2177: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2178: 
                   2179: The optional $excdoms is a reference to an array of domains which will be excluded from the available options. 
1.563     raeburn  2180: 
1.35      matthew  2181: =cut
                   2182: 
                   2183: #-------------------------------------------
1.34      matthew  2184: sub select_dom_form {
1.1075.2.36  raeburn  2185:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872     raeburn  2186:     if ($onchange) {
1.874     raeburn  2187:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2188:     }
1.1075.2.36  raeburn  2189:     my (@domains,%exclude);
1.910     raeburn  2190:     if (ref($incdoms) eq 'ARRAY') {
                   2191:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2192:     } else {
                   2193:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2194:     }
1.90      www      2195:     if ($includeempty) { @domains=('',@domains); }
1.1075.2.36  raeburn  2196:     if (ref($excdoms) eq 'ARRAY') {
                   2197:         map { $exclude{$_} = 1; } @{$excdoms};
                   2198:     }
1.743     raeburn  2199:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2200:     foreach my $dom (@domains) {
1.1075.2.36  raeburn  2201:         next if ($exclude{$dom});
1.356     albertel 2202:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2203:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2204:         if ($showdomdesc) {
                   2205:             if ($dom ne '') {
                   2206:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2207:                 if ($domdesc ne '') {
                   2208:                     $selectdomain .= ' ('.$domdesc.')';
                   2209:                 }
                   2210:             } 
                   2211:         }
                   2212:         $selectdomain .= "</option>\n";
1.34      matthew  2213:     }
                   2214:     $selectdomain.="</select>";
                   2215:     return $selectdomain;
                   2216: }
                   2217: 
1.35      matthew  2218: #-------------------------------------------
                   2219: 
1.45      matthew  2220: =pod
                   2221: 
1.648     raeburn  2222: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2223: 
1.586     raeburn  2224: input: 4 arguments (two required, two optional) - 
                   2225:     $domain - domain of new user
                   2226:     $name - name of form element
                   2227:     $default - Value of 'default' causes a default item to be first 
                   2228:                             option, and selected by default. 
                   2229:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2230:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2231: output: returns 2 items: 
1.586     raeburn  2232: (a) form element which contains either:
                   2233:    (i) <select name="$name">
                   2234:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2235:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2236:        </select>
                   2237:        form item if there are multiple library servers in $domain, or
                   2238:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2239:        if there is only one library server in $domain.
                   2240: 
                   2241: (b) number of library servers found.
                   2242: 
                   2243: See loncreateuser.pm for example of use.
1.35      matthew  2244: 
                   2245: =cut
                   2246: 
                   2247: #-------------------------------------------
1.586     raeburn  2248: sub home_server_form_item {
                   2249:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2250:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2251:     my $result;
                   2252:     my $numlib = keys(%servers);
                   2253:     if ($numlib > 1) {
                   2254:         $result .= '<select name="'.$name.'" />'."\n";
                   2255:         if ($default) {
1.804     bisitz   2256:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2257:                        '</option>'."\n";
                   2258:         }
                   2259:         foreach my $hostid (sort(keys(%servers))) {
                   2260:             $result.= '<option value="'.$hostid.'">'.
                   2261: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2262:         }
                   2263:         $result .= '</select>'."\n";
                   2264:     } elsif ($numlib == 1) {
                   2265:         my $hostid;
                   2266:         foreach my $item (keys(%servers)) {
                   2267:             $hostid = $item;
                   2268:         }
                   2269:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2270:                    $hostid.'" />';
                   2271:                    if (!$hide) {
                   2272:                        $result .= $hostid.' '.$servers{$hostid};
                   2273:                    }
                   2274:                    $result .= "\n";
                   2275:     } elsif ($default) {
                   2276:         $result .= '<input type="hidden" name="'.$name.
                   2277:                    '" value="default" />';
                   2278:                    if (!$hide) {
                   2279:                        $result .= &mt('default');
                   2280:                    }
                   2281:                    $result .= "\n";
1.33      matthew  2282:     }
1.586     raeburn  2283:     return ($result,$numlib);
1.33      matthew  2284: }
1.112     bowersj2 2285: 
                   2286: =pod
                   2287: 
1.534     albertel 2288: =back 
                   2289: 
1.112     bowersj2 2290: =cut
1.87      matthew  2291: 
                   2292: ###############################################################
1.112     bowersj2 2293: ##                  Decoding User Agent                      ##
1.87      matthew  2294: ###############################################################
                   2295: 
                   2296: =pod
                   2297: 
1.112     bowersj2 2298: =head1 Decoding the User Agent
                   2299: 
                   2300: =over 4
                   2301: 
                   2302: =item * &decode_user_agent()
1.87      matthew  2303: 
                   2304: Inputs: $r
                   2305: 
                   2306: Outputs:
                   2307: 
                   2308: =over 4
                   2309: 
1.112     bowersj2 2310: =item * $httpbrowser
1.87      matthew  2311: 
1.112     bowersj2 2312: =item * $clientbrowser
1.87      matthew  2313: 
1.112     bowersj2 2314: =item * $clientversion
1.87      matthew  2315: 
1.112     bowersj2 2316: =item * $clientmathml
1.87      matthew  2317: 
1.112     bowersj2 2318: =item * $clientunicode
1.87      matthew  2319: 
1.112     bowersj2 2320: =item * $clientos
1.87      matthew  2321: 
1.1075.2.42  raeburn  2322: =item * $clientmobile
                   2323: 
                   2324: =item * $clientinfo
                   2325: 
1.87      matthew  2326: =back
                   2327: 
1.157     matthew  2328: =back 
                   2329: 
1.87      matthew  2330: =cut
                   2331: 
                   2332: ###############################################################
                   2333: ###############################################################
                   2334: sub decode_user_agent {
1.247     albertel 2335:     my ($r)=@_;
1.87      matthew  2336:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2337:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2338:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2339:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2340:     my $clientbrowser='unknown';
                   2341:     my $clientversion='0';
                   2342:     my $clientmathml='';
                   2343:     my $clientunicode='0';
1.1075.2.42  raeburn  2344:     my $clientmobile=0;
1.87      matthew  2345:     for (my $i=0;$i<=$#browsertype;$i++) {
                   2346:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   2347: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2348: 	    $clientbrowser=$bname;
                   2349:             $httpbrowser=~/$vreg/i;
                   2350: 	    $clientversion=$1;
                   2351:             $clientmathml=($clientversion>=$minv);
                   2352:             $clientunicode=($clientversion>=$univ);
                   2353: 	}
                   2354:     }
                   2355:     my $clientos='unknown';
1.1075.2.42  raeburn  2356:     my $clientinfo;
1.87      matthew  2357:     if (($httpbrowser=~/linux/i) ||
                   2358:         ($httpbrowser=~/unix/i) ||
                   2359:         ($httpbrowser=~/ux/i) ||
                   2360:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2361:     if (($httpbrowser=~/vax/i) ||
                   2362:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2363:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2364:     if (($httpbrowser=~/mac/i) ||
                   2365:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   2366:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   2367:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42  raeburn  2368:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2369:         $clientmobile=lc($1);
                   2370:     }
                   2371:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2372:         $clientinfo = 'firefox-'.$1;
                   2373:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2374:         $clientinfo = 'chromeframe-'.$1;
                   2375:     }
1.87      matthew  2376:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.42  raeburn  2377:             $clientunicode,$clientos,$clientmobile,$clientinfo);
1.87      matthew  2378: }
                   2379: 
1.32      matthew  2380: ###############################################################
                   2381: ##    Authentication changing form generation subroutines    ##
                   2382: ###############################################################
                   2383: ##
                   2384: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2385: ## hash, and have reasonable default values.
                   2386: ##
                   2387: ##    formname = the name given in the <form> tag.
1.35      matthew  2388: #-------------------------------------------
                   2389: 
1.45      matthew  2390: =pod
                   2391: 
1.112     bowersj2 2392: =head1 Authentication Routines
                   2393: 
                   2394: =over 4
                   2395: 
1.648     raeburn  2396: =item * &authform_xxxxxx()
1.35      matthew  2397: 
                   2398: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2399: handle some of the conveniences required for authentication forms.  
                   2400: This is not an optimal method, but it works.  
                   2401: 
                   2402: =over 4
                   2403: 
1.112     bowersj2 2404: =item * authform_header
1.35      matthew  2405: 
1.112     bowersj2 2406: =item * authform_authorwarning
1.35      matthew  2407: 
1.112     bowersj2 2408: =item * authform_nochange
1.35      matthew  2409: 
1.112     bowersj2 2410: =item * authform_kerberos
1.35      matthew  2411: 
1.112     bowersj2 2412: =item * authform_internal
1.35      matthew  2413: 
1.112     bowersj2 2414: =item * authform_filesystem
1.35      matthew  2415: 
                   2416: =back
                   2417: 
1.648     raeburn  2418: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2419: 
1.35      matthew  2420: =cut
                   2421: 
                   2422: #-------------------------------------------
1.32      matthew  2423: sub authform_header{  
                   2424:     my %in = (
                   2425:         formname => 'cu',
1.80      albertel 2426:         kerb_def_dom => '',
1.32      matthew  2427:         @_,
                   2428:     );
                   2429:     $in{'formname'} = 'document.' . $in{'formname'};
                   2430:     my $result='';
1.80      albertel 2431: 
                   2432: #---------------------------------------------- Code for upper case translation
                   2433:     my $Javascript_toUpperCase;
                   2434:     unless ($in{kerb_def_dom}) {
                   2435:         $Javascript_toUpperCase =<<"END";
                   2436:         switch (choice) {
                   2437:            case 'krb': currentform.elements[choicearg].value =
                   2438:                currentform.elements[choicearg].value.toUpperCase();
                   2439:                break;
                   2440:            default:
                   2441:         }
                   2442: END
                   2443:     } else {
                   2444:         $Javascript_toUpperCase = "";
                   2445:     }
                   2446: 
1.165     raeburn  2447:     my $radioval = "'nochange'";
1.591     raeburn  2448:     if (defined($in{'curr_authtype'})) {
                   2449:         if ($in{'curr_authtype'} ne '') {
                   2450:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2451:         }
1.174     matthew  2452:     }
1.165     raeburn  2453:     my $argfield = 'null';
1.591     raeburn  2454:     if (defined($in{'mode'})) {
1.165     raeburn  2455:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2456:             if (defined($in{'curr_autharg'})) {
                   2457:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2458:                     $argfield = "'$in{'curr_autharg'}'";
                   2459:                 }
                   2460:             }
                   2461:         }
                   2462:     }
                   2463: 
1.32      matthew  2464:     $result.=<<"END";
                   2465: var current = new Object();
1.165     raeburn  2466: current.radiovalue = $radioval;
                   2467: current.argfield = $argfield;
1.32      matthew  2468: 
                   2469: function changed_radio(choice,currentform) {
                   2470:     var choicearg = choice + 'arg';
                   2471:     // If a radio button in changed, we need to change the argfield
                   2472:     if (current.radiovalue != choice) {
                   2473:         current.radiovalue = choice;
                   2474:         if (current.argfield != null) {
                   2475:             currentform.elements[current.argfield].value = '';
                   2476:         }
                   2477:         if (choice == 'nochange') {
                   2478:             current.argfield = null;
                   2479:         } else {
                   2480:             current.argfield = choicearg;
                   2481:             switch(choice) {
                   2482:                 case 'krb': 
                   2483:                     currentform.elements[current.argfield].value = 
                   2484:                         "$in{'kerb_def_dom'}";
                   2485:                 break;
                   2486:               default:
                   2487:                 break;
                   2488:             }
                   2489:         }
                   2490:     }
                   2491:     return;
                   2492: }
1.22      www      2493: 
1.32      matthew  2494: function changed_text(choice,currentform) {
                   2495:     var choicearg = choice + 'arg';
                   2496:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2497:         $Javascript_toUpperCase
1.32      matthew  2498:         // clear old field
                   2499:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2500:             currentform.elements[current.argfield].value = '';
                   2501:         }
                   2502:         current.argfield = choicearg;
                   2503:     }
                   2504:     set_auth_radio_buttons(choice,currentform);
                   2505:     return;
1.20      www      2506: }
1.32      matthew  2507: 
                   2508: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2509:     var numauthchoices = currentform.login.length;
                   2510:     if (typeof numauthchoices  == "undefined") {
                   2511:         return;
                   2512:     } 
1.32      matthew  2513:     var i=0;
1.986     raeburn  2514:     while (i < numauthchoices) {
1.32      matthew  2515:         if (currentform.login[i].value == newvalue) { break; }
                   2516:         i++;
                   2517:     }
1.986     raeburn  2518:     if (i == numauthchoices) {
1.32      matthew  2519:         return;
                   2520:     }
                   2521:     current.radiovalue = newvalue;
                   2522:     currentform.login[i].checked = true;
                   2523:     return;
                   2524: }
                   2525: END
                   2526:     return $result;
                   2527: }
                   2528: 
1.1075.2.20  raeburn  2529: sub authform_authorwarning {
1.32      matthew  2530:     my $result='';
1.144     matthew  2531:     $result='<i>'.
                   2532:         &mt('As a general rule, only authors or co-authors should be '.
                   2533:             'filesystem authenticated '.
                   2534:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2535:     return $result;
                   2536: }
                   2537: 
1.1075.2.20  raeburn  2538: sub authform_nochange {
1.32      matthew  2539:     my %in = (
                   2540:               formname => 'document.cu',
                   2541:               kerb_def_dom => 'MSU.EDU',
                   2542:               @_,
                   2543:           );
1.1075.2.20  raeburn  2544:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); 
1.586     raeburn  2545:     my $result;
1.1075.2.20  raeburn  2546:     if (!$authnum) {
                   2547:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2548:     } else {
                   2549:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2550:                   '<input type="radio" name="login" value="nochange" '.
                   2551:                   'checked="checked" onclick="'.
1.281     albertel 2552:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2553: 	    '</label>';
1.586     raeburn  2554:     }
1.32      matthew  2555:     return $result;
                   2556: }
                   2557: 
1.591     raeburn  2558: sub authform_kerberos {
1.32      matthew  2559:     my %in = (
                   2560:               formname => 'document.cu',
                   2561:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2562:               kerb_def_auth => 'krb4',
1.32      matthew  2563:               @_,
                   2564:               );
1.586     raeburn  2565:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2566:         $autharg,$jscall);
1.1075.2.20  raeburn  2567:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2568:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2569:        $check5 = ' checked="checked"';
1.80      albertel 2570:     } else {
1.772     bisitz   2571:        $check4 = ' checked="checked"';
1.80      albertel 2572:     }
1.165     raeburn  2573:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2574:     if (defined($in{'curr_authtype'})) {
                   2575:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2576:             $krbcheck = ' checked="checked"';
1.623     raeburn  2577:             if (defined($in{'mode'})) {
                   2578:                 if ($in{'mode'} eq 'modifyuser') {
                   2579:                     $krbcheck = '';
                   2580:                 }
                   2581:             }
1.591     raeburn  2582:             if (defined($in{'curr_kerb_ver'})) {
                   2583:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2584:                     $check5 = ' checked="checked"';
1.591     raeburn  2585:                     $check4 = '';
                   2586:                 } else {
1.772     bisitz   2587:                     $check4 = ' checked="checked"';
1.591     raeburn  2588:                     $check5 = '';
                   2589:                 }
1.586     raeburn  2590:             }
1.591     raeburn  2591:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2592:                 $krbarg = $in{'curr_autharg'};
                   2593:             }
1.586     raeburn  2594:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2595:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2596:                     $result = 
                   2597:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2598:         $in{'curr_autharg'},$krbver);
                   2599:                 } else {
                   2600:                     $result =
                   2601:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2602:                 }
                   2603:                 return $result; 
                   2604:             }
                   2605:         }
                   2606:     } else {
                   2607:         if ($authnum == 1) {
1.784     bisitz   2608:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2609:         }
                   2610:     }
1.586     raeburn  2611:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2612:         return;
1.587     raeburn  2613:     } elsif ($authtype eq '') {
1.591     raeburn  2614:         if (defined($in{'mode'})) {
1.587     raeburn  2615:             if ($in{'mode'} eq 'modifycourse') {
                   2616:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2617:                     $authtype = '<input type="radio" name="login" value="krb" />';
1.587     raeburn  2618:                 }
                   2619:             }
                   2620:         }
1.586     raeburn  2621:     }
                   2622:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2623:     if ($authtype eq '') {
                   2624:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2625:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2626:                     $krbcheck.' />';
                   2627:     }
                   2628:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20  raeburn  2629:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2630:          $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20  raeburn  2631:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2632:          $in{'curr_authtype'} eq 'krb4')) {
                   2633:         $result .= &mt
1.144     matthew  2634:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2635:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2636:          '<label>'.$authtype,
1.281     albertel 2637:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2638:              'value="'.$krbarg.'" '.
1.144     matthew  2639:              'onchange="'.$jscall.'" />',
1.281     albertel 2640:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2641:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2642: 	 '</label>');
1.586     raeburn  2643:     } elsif ($can_assign{'krb4'}) {
                   2644:         $result .= &mt
                   2645:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2646:          '[_3] Version 4 [_4]',
                   2647:          '<label>'.$authtype,
                   2648:          '</label><input type="text" size="10" name="krbarg" '.
                   2649:              'value="'.$krbarg.'" '.
                   2650:              'onchange="'.$jscall.'" />',
                   2651:          '<label><input type="hidden" name="krbver" value="4" />',
                   2652:          '</label>');
                   2653:     } elsif ($can_assign{'krb5'}) {
                   2654:         $result .= &mt
                   2655:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2656:          '[_3] Version 5 [_4]',
                   2657:          '<label>'.$authtype,
                   2658:          '</label><input type="text" size="10" name="krbarg" '.
                   2659:              'value="'.$krbarg.'" '.
                   2660:              'onchange="'.$jscall.'" />',
                   2661:          '<label><input type="hidden" name="krbver" value="5" />',
                   2662:          '</label>');
                   2663:     }
1.32      matthew  2664:     return $result;
                   2665: }
                   2666: 
1.1075.2.20  raeburn  2667: sub authform_internal {
1.586     raeburn  2668:     my %in = (
1.32      matthew  2669:                 formname => 'document.cu',
                   2670:                 kerb_def_dom => 'MSU.EDU',
                   2671:                 @_,
                   2672:                 );
1.586     raeburn  2673:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2674:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2675:     if (defined($in{'curr_authtype'})) {
                   2676:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2677:             if ($can_assign{'int'}) {
1.772     bisitz   2678:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2679:                 if (defined($in{'mode'})) {
                   2680:                     if ($in{'mode'} eq 'modifyuser') {
                   2681:                         $intcheck = '';
                   2682:                     }
                   2683:                 }
1.591     raeburn  2684:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2685:                     $intarg = $in{'curr_autharg'};
                   2686:                 }
                   2687:             } else {
                   2688:                 $result = &mt('Currently internally authenticated.');
                   2689:                 return $result;
1.165     raeburn  2690:             }
                   2691:         }
1.586     raeburn  2692:     } else {
                   2693:         if ($authnum == 1) {
1.784     bisitz   2694:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2695:         }
                   2696:     }
                   2697:     if (!$can_assign{'int'}) {
                   2698:         return;
1.587     raeburn  2699:     } elsif ($authtype eq '') {
1.591     raeburn  2700:         if (defined($in{'mode'})) {
1.587     raeburn  2701:             if ($in{'mode'} eq 'modifycourse') {
                   2702:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2703:                     $authtype = '<input type="radio" name="login" value="int" />';
1.587     raeburn  2704:                 }
                   2705:             }
                   2706:         }
1.165     raeburn  2707:     }
1.586     raeburn  2708:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2709:     if ($authtype eq '') {
                   2710:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2711:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2712:     }
1.605     bisitz   2713:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2714:                $intarg.'" onchange="'.$jscall.'" />';
                   2715:     $result = &mt
1.144     matthew  2716:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2717:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2718:     $result.="<label><input type=\"checkbox\" name=\"visible\" onclick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';
1.32      matthew  2719:     return $result;
                   2720: }
                   2721: 
1.1075.2.20  raeburn  2722: sub authform_local {
1.32      matthew  2723:     my %in = (
                   2724:               formname => 'document.cu',
                   2725:               kerb_def_dom => 'MSU.EDU',
                   2726:               @_,
                   2727:               );
1.586     raeburn  2728:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2729:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2730:     if (defined($in{'curr_authtype'})) {
                   2731:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2732:             if ($can_assign{'loc'}) {
1.772     bisitz   2733:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2734:                 if (defined($in{'mode'})) {
                   2735:                     if ($in{'mode'} eq 'modifyuser') {
                   2736:                         $loccheck = '';
                   2737:                     }
                   2738:                 }
1.591     raeburn  2739:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2740:                     $locarg = $in{'curr_autharg'};
                   2741:                 }
                   2742:             } else {
                   2743:                 $result = &mt('Currently using local (institutional) authentication.');
                   2744:                 return $result;
1.165     raeburn  2745:             }
                   2746:         }
1.586     raeburn  2747:     } else {
                   2748:         if ($authnum == 1) {
1.784     bisitz   2749:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2750:         }
                   2751:     }
                   2752:     if (!$can_assign{'loc'}) {
                   2753:         return;
1.587     raeburn  2754:     } elsif ($authtype eq '') {
1.591     raeburn  2755:         if (defined($in{'mode'})) {
1.587     raeburn  2756:             if ($in{'mode'} eq 'modifycourse') {
                   2757:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2758:                     $authtype = '<input type="radio" name="login" value="loc" />';
1.587     raeburn  2759:                 }
                   2760:             }
                   2761:         }
1.165     raeburn  2762:     }
1.586     raeburn  2763:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2764:     if ($authtype eq '') {
                   2765:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2766:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2767:                     $jscall.'" />';
                   2768:     }
                   2769:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2770:                $locarg.'" onchange="'.$jscall.'" />';
                   2771:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2772:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2773:     return $result;
                   2774: }
                   2775: 
1.1075.2.20  raeburn  2776: sub authform_filesystem {
1.32      matthew  2777:     my %in = (
                   2778:               formname => 'document.cu',
                   2779:               kerb_def_dom => 'MSU.EDU',
                   2780:               @_,
                   2781:               );
1.586     raeburn  2782:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2783:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2784:     if (defined($in{'curr_authtype'})) {
                   2785:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2786:             if ($can_assign{'fsys'}) {
1.772     bisitz   2787:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2788:                 if (defined($in{'mode'})) {
                   2789:                     if ($in{'mode'} eq 'modifyuser') {
                   2790:                         $fsyscheck = '';
                   2791:                     }
                   2792:                 }
1.586     raeburn  2793:             } else {
                   2794:                 $result = &mt('Currently Filesystem Authenticated.');
                   2795:                 return $result;
                   2796:             }           
                   2797:         }
                   2798:     } else {
                   2799:         if ($authnum == 1) {
1.784     bisitz   2800:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2801:         }
                   2802:     }
                   2803:     if (!$can_assign{'fsys'}) {
                   2804:         return;
1.587     raeburn  2805:     } elsif ($authtype eq '') {
1.591     raeburn  2806:         if (defined($in{'mode'})) {
1.587     raeburn  2807:             if ($in{'mode'} eq 'modifycourse') {
                   2808:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2809:                     $authtype = '<input type="radio" name="login" value="fsys" />';
1.587     raeburn  2810:                 }
                   2811:             }
                   2812:         }
1.586     raeburn  2813:     }
                   2814:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2815:     if ($authtype eq '') {
                   2816:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2817:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2818:                     $jscall.'" />';
                   2819:     }
                   2820:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2821:                ' onchange="'.$jscall.'" />';
                   2822:     $result = &mt
1.144     matthew  2823:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2824:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2825:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2826:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2827:                   'onchange="'.$jscall.'" />');
1.32      matthew  2828:     return $result;
                   2829: }
                   2830: 
1.586     raeburn  2831: sub get_assignable_auth {
                   2832:     my ($dom) = @_;
                   2833:     if ($dom eq '') {
                   2834:         $dom = $env{'request.role.domain'};
                   2835:     }
                   2836:     my %can_assign = (
                   2837:                           krb4 => 1,
                   2838:                           krb5 => 1,
                   2839:                           int  => 1,
                   2840:                           loc  => 1,
                   2841:                      );
                   2842:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2843:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2844:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2845:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2846:             my $context;
                   2847:             if ($env{'request.role'} =~ /^au/) {
                   2848:                 $context = 'author';
                   2849:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2850:                 $context = 'domain';
                   2851:             } elsif ($env{'request.course.id'}) {
                   2852:                 $context = 'course';
                   2853:             }
                   2854:             if ($context) {
                   2855:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2856:                    %can_assign = %{$authhash->{$context}}; 
                   2857:                 }
                   2858:             }
                   2859:         }
                   2860:     }
                   2861:     my $authnum = 0;
                   2862:     foreach my $key (keys(%can_assign)) {
                   2863:         if ($can_assign{$key}) {
                   2864:             $authnum ++;
                   2865:         }
                   2866:     }
                   2867:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2868:         $authnum --;
                   2869:     }
                   2870:     return ($authnum,%can_assign);
                   2871: }
                   2872: 
1.80      albertel 2873: ###############################################################
                   2874: ##    Get Kerberos Defaults for Domain                 ##
                   2875: ###############################################################
                   2876: ##
                   2877: ## Returns default kerberos version and an associated argument
                   2878: ## as listed in file domain.tab. If not listed, provides
                   2879: ## appropriate default domain and kerberos version.
                   2880: ##
                   2881: #-------------------------------------------
                   2882: 
                   2883: =pod
                   2884: 
1.648     raeburn  2885: =item * &get_kerberos_defaults()
1.80      albertel 2886: 
                   2887: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2888: version and domain. If not found, it defaults to version 4 and the 
                   2889: domain of the server.
1.80      albertel 2890: 
1.648     raeburn  2891: =over 4
                   2892: 
1.80      albertel 2893: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2894: 
1.648     raeburn  2895: =back
                   2896: 
                   2897: =back
                   2898: 
1.80      albertel 2899: =cut
                   2900: 
                   2901: #-------------------------------------------
                   2902: sub get_kerberos_defaults {
                   2903:     my $domain=shift;
1.641     raeburn  2904:     my ($krbdef,$krbdefdom);
                   2905:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2906:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2907:         $krbdef = $domdefaults{'auth_def'};
                   2908:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2909:     } else {
1.80      albertel 2910:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2911:         my $krbdefdom=$1;
                   2912:         $krbdefdom=~tr/a-z/A-Z/;
                   2913:         $krbdef = "krb4";
                   2914:     }
                   2915:     return ($krbdef,$krbdefdom);
                   2916: }
1.112     bowersj2 2917: 
1.32      matthew  2918: 
1.46      matthew  2919: ###############################################################
                   2920: ##                Thesaurus Functions                        ##
                   2921: ###############################################################
1.20      www      2922: 
1.46      matthew  2923: =pod
1.20      www      2924: 
1.112     bowersj2 2925: =head1 Thesaurus Functions
                   2926: 
                   2927: =over 4
                   2928: 
1.648     raeburn  2929: =item * &initialize_keywords()
1.46      matthew  2930: 
                   2931: Initializes the package variable %Keywords if it is empty.  Uses the
                   2932: package variable $thesaurus_db_file.
                   2933: 
                   2934: =cut
                   2935: 
                   2936: ###################################################
                   2937: 
                   2938: sub initialize_keywords {
                   2939:     return 1 if (scalar keys(%Keywords));
                   2940:     # If we are here, %Keywords is empty, so fill it up
                   2941:     #   Make sure the file we need exists...
                   2942:     if (! -e $thesaurus_db_file) {
                   2943:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2944:                                  " failed because it does not exist");
                   2945:         return 0;
                   2946:     }
                   2947:     #   Set up the hash as a database
                   2948:     my %thesaurus_db;
                   2949:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2950:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2951:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2952:                                  $thesaurus_db_file);
                   2953:         return 0;
                   2954:     } 
                   2955:     #  Get the average number of appearances of a word.
                   2956:     my $avecount = $thesaurus_db{'average.count'};
                   2957:     #  Put keywords (those that appear > average) into %Keywords
                   2958:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2959:         my ($count,undef) = split /:/,$data;
                   2960:         $Keywords{$word}++ if ($count > $avecount);
                   2961:     }
                   2962:     untie %thesaurus_db;
                   2963:     # Remove special values from %Keywords.
1.356     albertel 2964:     foreach my $value ('total.count','average.count') {
                   2965:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2966:   }
1.46      matthew  2967:     return 1;
                   2968: }
                   2969: 
                   2970: ###################################################
                   2971: 
                   2972: =pod
                   2973: 
1.648     raeburn  2974: =item * &keyword($word)
1.46      matthew  2975: 
                   2976: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   2977: than the average number of times in the thesaurus database.  Calls 
                   2978: &initialize_keywords
                   2979: 
                   2980: =cut
                   2981: 
                   2982: ###################################################
1.20      www      2983: 
                   2984: sub keyword {
1.46      matthew  2985:     return if (!&initialize_keywords());
                   2986:     my $word=lc(shift());
                   2987:     $word=~s/\W//g;
                   2988:     return exists($Keywords{$word});
1.20      www      2989: }
1.46      matthew  2990: 
                   2991: ###############################################################
                   2992: 
                   2993: =pod 
1.20      www      2994: 
1.648     raeburn  2995: =item * &get_related_words()
1.46      matthew  2996: 
1.160     matthew  2997: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  2998: an array of words.  If the keyword is not in the thesaurus, an empty array
                   2999: will be returned.  The order of the words returned is determined by the
                   3000: database which holds them.
                   3001: 
                   3002: Uses global $thesaurus_db_file.
                   3003: 
1.1057    foxr     3004: 
1.46      matthew  3005: =cut
                   3006: 
                   3007: ###############################################################
                   3008: sub get_related_words {
                   3009:     my $keyword = shift;
                   3010:     my %thesaurus_db;
                   3011:     if (! -e $thesaurus_db_file) {
                   3012:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3013:                                  "failed because the file does not exist");
                   3014:         return ();
                   3015:     }
                   3016:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3017:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3018:         return ();
                   3019:     } 
                   3020:     my @Words=();
1.429     www      3021:     my $count=0;
1.46      matthew  3022:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3023: 	# The first element is the number of times
                   3024: 	# the word appears.  We do not need it now.
1.429     www      3025: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3026: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3027: 	my $threshold=$mostfrequentcount/10;
                   3028:         foreach my $possibleword (@RelatedWords) {
                   3029:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3030:             if ($wordcount>$threshold) {
                   3031: 		push(@Words,$word);
                   3032:                 $count++;
                   3033:                 if ($count>10) { last; }
                   3034: 	    }
1.20      www      3035:         }
                   3036:     }
1.46      matthew  3037:     untie %thesaurus_db;
                   3038:     return @Words;
1.14      harris41 3039: }
1.46      matthew  3040: 
1.112     bowersj2 3041: =pod
                   3042: 
                   3043: =back
                   3044: 
                   3045: =cut
1.61      www      3046: 
                   3047: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3048: =pod
                   3049: 
1.112     bowersj2 3050: =head1 User Name Functions
                   3051: 
                   3052: =over 4
                   3053: 
1.648     raeburn  3054: =item * &plainname($uname,$udom,$first)
1.81      albertel 3055: 
1.112     bowersj2 3056: Takes a users logon name and returns it as a string in
1.226     albertel 3057: "first middle last generation" form 
                   3058: if $first is set to 'lastname' then it returns it as
                   3059: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3060: 
                   3061: =cut
1.61      www      3062: 
1.295     www      3063: 
1.81      albertel 3064: ###############################################################
1.61      www      3065: sub plainname {
1.226     albertel 3066:     my ($uname,$udom,$first)=@_;
1.537     albertel 3067:     return if (!defined($uname) || !defined($udom));
1.295     www      3068:     my %names=&getnames($uname,$udom);
1.226     albertel 3069:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3070: 					  $names{'middlename'},
                   3071: 					  $names{'lastname'},
                   3072: 					  $names{'generation'},$first);
                   3073:     $name=~s/^\s+//;
1.62      www      3074:     $name=~s/\s+$//;
                   3075:     $name=~s/\s+/ /g;
1.353     albertel 3076:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3077:     return $name;
1.61      www      3078: }
1.66      www      3079: 
                   3080: # -------------------------------------------------------------------- Nickname
1.81      albertel 3081: =pod
                   3082: 
1.648     raeburn  3083: =item * &nickname($uname,$udom)
1.81      albertel 3084: 
                   3085: Gets a users name and returns it as a string as
                   3086: 
                   3087: "&quot;nickname&quot;"
1.66      www      3088: 
1.81      albertel 3089: if the user has a nickname or
                   3090: 
                   3091: "first middle last generation"
                   3092: 
                   3093: if the user does not
                   3094: 
                   3095: =cut
1.66      www      3096: 
                   3097: sub nickname {
                   3098:     my ($uname,$udom)=@_;
1.537     albertel 3099:     return if (!defined($uname) || !defined($udom));
1.295     www      3100:     my %names=&getnames($uname,$udom);
1.68      albertel 3101:     my $name=$names{'nickname'};
1.66      www      3102:     if ($name) {
                   3103:        $name='&quot;'.$name.'&quot;'; 
                   3104:     } else {
                   3105:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3106: 	     $names{'lastname'}.' '.$names{'generation'};
                   3107:        $name=~s/\s+$//;
                   3108:        $name=~s/\s+/ /g;
                   3109:     }
                   3110:     return $name;
                   3111: }
                   3112: 
1.295     www      3113: sub getnames {
                   3114:     my ($uname,$udom)=@_;
1.537     albertel 3115:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3116:     if ($udom eq 'public' && $uname eq 'public') {
                   3117: 	return ('lastname' => &mt('Public'));
                   3118:     }
1.295     www      3119:     my $id=$uname.':'.$udom;
                   3120:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3121:     if ($cached) {
                   3122: 	return %{$names};
                   3123:     } else {
                   3124: 	my %loadnames=&Apache::lonnet::get('environment',
                   3125:                     ['firstname','middlename','lastname','generation','nickname'],
                   3126: 					 $udom,$uname);
                   3127: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3128: 	return %loadnames;
                   3129:     }
                   3130: }
1.61      www      3131: 
1.542     raeburn  3132: # -------------------------------------------------------------------- getemails
1.648     raeburn  3133: 
1.542     raeburn  3134: =pod
                   3135: 
1.648     raeburn  3136: =item * &getemails($uname,$udom)
1.542     raeburn  3137: 
                   3138: Gets a user's email information and returns it as a hash with keys:
                   3139: notification, critnotification, permanentemail
                   3140: 
                   3141: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3142: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3143:  
1.648     raeburn  3144: 
1.542     raeburn  3145: =cut
                   3146: 
1.648     raeburn  3147: 
1.466     albertel 3148: sub getemails {
                   3149:     my ($uname,$udom)=@_;
                   3150:     if ($udom eq 'public' && $uname eq 'public') {
                   3151: 	return;
                   3152:     }
1.467     www      3153:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3154:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3155:     my $id=$uname.':'.$udom;
                   3156:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3157:     if ($cached) {
                   3158: 	return %{$names};
                   3159:     } else {
                   3160: 	my %loadnames=&Apache::lonnet::get('environment',
                   3161:                     			   ['notification','critnotification',
                   3162: 					    'permanentemail'],
                   3163: 					   $udom,$uname);
                   3164: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3165: 	return %loadnames;
                   3166:     }
                   3167: }
                   3168: 
1.551     albertel 3169: sub flush_email_cache {
                   3170:     my ($uname,$udom)=@_;
                   3171:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3172:     if (!$uname) { $uname=$env{'user.name'};   }
                   3173:     return if ($udom eq 'public' && $uname eq 'public');
                   3174:     my $id=$uname.':'.$udom;
                   3175:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3176: }
                   3177: 
1.728     raeburn  3178: # -------------------------------------------------------------------- getlangs
                   3179: 
                   3180: =pod
                   3181: 
                   3182: =item * &getlangs($uname,$udom)
                   3183: 
                   3184: Gets a user's language preference and returns it as a hash with key:
                   3185: language.
                   3186: 
                   3187: =cut
                   3188: 
                   3189: 
                   3190: sub getlangs {
                   3191:     my ($uname,$udom) = @_;
                   3192:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3193:     if (!$uname) { $uname=$env{'user.name'};   }
                   3194:     my $id=$uname.':'.$udom;
                   3195:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3196:     if ($cached) {
                   3197:         return %{$langs};
                   3198:     } else {
                   3199:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3200:                                            $udom,$uname);
                   3201:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3202:         return %loadlangs;
                   3203:     }
                   3204: }
                   3205: 
                   3206: sub flush_langs_cache {
                   3207:     my ($uname,$udom)=@_;
                   3208:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3209:     if (!$uname) { $uname=$env{'user.name'};   }
                   3210:     return if ($udom eq 'public' && $uname eq 'public');
                   3211:     my $id=$uname.':'.$udom;
                   3212:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3213: }
                   3214: 
1.61      www      3215: # ------------------------------------------------------------------ Screenname
1.81      albertel 3216: 
                   3217: =pod
                   3218: 
1.648     raeburn  3219: =item * &screenname($uname,$udom)
1.81      albertel 3220: 
                   3221: Gets a users screenname and returns it as a string
                   3222: 
                   3223: =cut
1.61      www      3224: 
                   3225: sub screenname {
                   3226:     my ($uname,$udom)=@_;
1.258     albertel 3227:     if ($uname eq $env{'user.name'} &&
                   3228: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3229:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3230:     return $names{'screenname'};
1.62      www      3231: }
                   3232: 
1.212     albertel 3233: 
1.802     bisitz   3234: # ------------------------------------------------------------- Confirm Wrapper
                   3235: =pod
                   3236: 
1.1075.2.42  raeburn  3237: =item * &confirmwrapper($message)
1.802     bisitz   3238: 
                   3239: Wrap messages about completion of operation in box
                   3240: 
                   3241: =cut
                   3242: 
                   3243: sub confirmwrapper {
                   3244:     my ($message)=@_;
                   3245:     if ($message) {
                   3246:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3247:                .$message."\n"
                   3248:                .'</div>'."\n";
                   3249:     } else {
                   3250:         return $message;
                   3251:     }
                   3252: }
                   3253: 
1.62      www      3254: # ------------------------------------------------------------- Message Wrapper
                   3255: 
                   3256: sub messagewrapper {
1.369     www      3257:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3258:     return 
1.441     albertel 3259:         '<a href="/adm/email?compose=individual&amp;'.
                   3260:         'recname='.$username.'&amp;recdom='.$domain.
                   3261: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3262:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3263: }
1.802     bisitz   3264: 
1.74      www      3265: # --------------------------------------------------------------- Notes Wrapper
                   3266: 
                   3267: sub noteswrapper {
                   3268:     my ($link,$un,$do)=@_;
                   3269:     return 
1.896     amueller 3270: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3271: }
1.802     bisitz   3272: 
1.62      www      3273: # ------------------------------------------------------------- Aboutme Wrapper
                   3274: 
                   3275: sub aboutmewrapper {
1.1070    raeburn  3276:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3277:     if (!defined($username)  && !defined($domain)) {
                   3278:         return;
                   3279:     }
1.1075.2.15  raeburn  3280:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3281: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3282: }
                   3283: 
                   3284: # ------------------------------------------------------------ Syllabus Wrapper
                   3285: 
                   3286: sub syllabuswrapper {
1.707     bisitz   3287:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3288:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3289: }
1.14      harris41 3290: 
1.802     bisitz   3291: # -----------------------------------------------------------------------------
                   3292: 
1.208     matthew  3293: sub track_student_link {
1.887     raeburn  3294:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3295:     my $link ="/adm/trackstudent?";
1.208     matthew  3296:     my $title = 'View recent activity';
                   3297:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3298:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3299:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3300:         $title .= ' of this student';
1.268     albertel 3301:     } 
1.208     matthew  3302:     if (defined($target) && $target !~ /^\s*$/) {
                   3303:         $target = qq{target="$target"};
                   3304:     } else {
                   3305:         $target = '';
                   3306:     }
1.268     albertel 3307:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3308:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3309:     $title = &mt($title);
                   3310:     $linktext = &mt($linktext);
1.448     albertel 3311:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3312: 	&help_open_topic('View_recent_activity');
1.208     matthew  3313: }
                   3314: 
1.781     raeburn  3315: sub slot_reservations_link {
                   3316:     my ($linktext,$sname,$sdom,$target) = @_;
                   3317:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3318:     my $title = 'View slot reservation history';
                   3319:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3320:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3321:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3322:         $title .= ' of this student';
                   3323:     }
                   3324:     if (defined($target) && $target !~ /^\s*$/) {
                   3325:         $target = qq{target="$target"};
                   3326:     } else {
                   3327:         $target = '';
                   3328:     }
                   3329:     $title = &mt($title);
                   3330:     $linktext = &mt($linktext);
                   3331:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3332: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3333: 
                   3334: }
                   3335: 
1.508     www      3336: # ===================================================== Display a student photo
                   3337: 
                   3338: 
1.509     albertel 3339: sub student_image_tag {
1.508     www      3340:     my ($domain,$user)=@_;
                   3341:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3342:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3343: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3344:     } else {
                   3345: 	return '';
                   3346:     }
                   3347: }
                   3348: 
1.112     bowersj2 3349: =pod
                   3350: 
                   3351: =back
                   3352: 
                   3353: =head1 Access .tab File Data
                   3354: 
                   3355: =over 4
                   3356: 
1.648     raeburn  3357: =item * &languageids() 
1.112     bowersj2 3358: 
                   3359: returns list of all language ids
                   3360: 
                   3361: =cut
                   3362: 
1.14      harris41 3363: sub languageids {
1.16      harris41 3364:     return sort(keys(%language));
1.14      harris41 3365: }
                   3366: 
1.112     bowersj2 3367: =pod
                   3368: 
1.648     raeburn  3369: =item * &languagedescription() 
1.112     bowersj2 3370: 
                   3371: returns description of a specified language id
                   3372: 
                   3373: =cut
                   3374: 
1.14      harris41 3375: sub languagedescription {
1.125     www      3376:     my $code=shift;
                   3377:     return  ($supported_language{$code}?'* ':'').
                   3378:             $language{$code}.
1.126     www      3379: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3380: }
                   3381: 
1.1048    foxr     3382: =pod
                   3383: 
                   3384: =item * &plainlanguagedescription
                   3385: 
                   3386: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3387: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3388: 
                   3389: =cut
                   3390: 
1.145     www      3391: sub plainlanguagedescription {
                   3392:     my $code=shift;
                   3393:     return $language{$code};
                   3394: }
                   3395: 
1.1048    foxr     3396: =pod
                   3397: 
                   3398: =item * &supportedlanguagecode
                   3399: 
                   3400: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3401: code.
                   3402: 
                   3403: =cut
                   3404: 
1.145     www      3405: sub supportedlanguagecode {
                   3406:     my $code=shift;
                   3407:     return $supported_language{$code};
1.97      www      3408: }
                   3409: 
1.112     bowersj2 3410: =pod
                   3411: 
1.1048    foxr     3412: =item * &latexlanguage()
                   3413: 
                   3414: Given a language key code returns the correspondnig language to use
                   3415: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3416: is no supported hyphenation for the language code.
                   3417: 
                   3418: =cut
                   3419: 
                   3420: sub latexlanguage {
                   3421:     my $code = shift;
                   3422:     return $latex_language{$code};
                   3423: }
                   3424: 
                   3425: =pod
                   3426: 
                   3427: =item * &latexhyphenation()
                   3428: 
                   3429: Same as above but what's supplied is the language as it might be stored
                   3430: in the metadata.
                   3431: 
                   3432: =cut
                   3433: 
                   3434: sub latexhyphenation {
                   3435:     my $key = shift;
                   3436:     return $latex_language_bykey{$key};
                   3437: }
                   3438: 
                   3439: =pod
                   3440: 
1.648     raeburn  3441: =item * &copyrightids() 
1.112     bowersj2 3442: 
                   3443: returns list of all copyrights
                   3444: 
                   3445: =cut
                   3446: 
                   3447: sub copyrightids {
                   3448:     return sort(keys(%cprtag));
                   3449: }
                   3450: 
                   3451: =pod
                   3452: 
1.648     raeburn  3453: =item * &copyrightdescription() 
1.112     bowersj2 3454: 
                   3455: returns description of a specified copyright id
                   3456: 
                   3457: =cut
                   3458: 
                   3459: sub copyrightdescription {
1.166     www      3460:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3461: }
1.197     matthew  3462: 
                   3463: =pod
                   3464: 
1.648     raeburn  3465: =item * &source_copyrightids() 
1.192     taceyjo1 3466: 
                   3467: returns list of all source copyrights
                   3468: 
                   3469: =cut
                   3470: 
                   3471: sub source_copyrightids {
                   3472:     return sort(keys(%scprtag));
                   3473: }
                   3474: 
                   3475: =pod
                   3476: 
1.648     raeburn  3477: =item * &source_copyrightdescription() 
1.192     taceyjo1 3478: 
                   3479: returns description of a specified source copyright id
                   3480: 
                   3481: =cut
                   3482: 
                   3483: sub source_copyrightdescription {
                   3484:     return &mt($scprtag{shift(@_)});
                   3485: }
1.112     bowersj2 3486: 
                   3487: =pod
                   3488: 
1.648     raeburn  3489: =item * &filecategories() 
1.112     bowersj2 3490: 
                   3491: returns list of all file categories
                   3492: 
                   3493: =cut
                   3494: 
                   3495: sub filecategories {
                   3496:     return sort(keys(%category_extensions));
                   3497: }
                   3498: 
                   3499: =pod
                   3500: 
1.648     raeburn  3501: =item * &filecategorytypes() 
1.112     bowersj2 3502: 
                   3503: returns list of file types belonging to a given file
                   3504: category
                   3505: 
                   3506: =cut
                   3507: 
                   3508: sub filecategorytypes {
1.356     albertel 3509:     my ($cat) = @_;
                   3510:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3511: }
                   3512: 
                   3513: =pod
                   3514: 
1.648     raeburn  3515: =item * &fileembstyle() 
1.112     bowersj2 3516: 
                   3517: returns embedding style for a specified file type
                   3518: 
                   3519: =cut
                   3520: 
                   3521: sub fileembstyle {
                   3522:     return $fe{lc(shift(@_))};
1.169     www      3523: }
                   3524: 
1.351     www      3525: sub filemimetype {
                   3526:     return $fm{lc(shift(@_))};
                   3527: }
                   3528: 
1.169     www      3529: 
                   3530: sub filecategoryselect {
                   3531:     my ($name,$value)=@_;
1.189     matthew  3532:     return &select_form($value,$name,
1.970     raeburn  3533:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3534: }
                   3535: 
                   3536: =pod
                   3537: 
1.648     raeburn  3538: =item * &filedescription() 
1.112     bowersj2 3539: 
                   3540: returns description for a specified file type
                   3541: 
                   3542: =cut
                   3543: 
                   3544: sub filedescription {
1.188     matthew  3545:     my $file_description = $fd{lc(shift())};
                   3546:     $file_description =~ s:([\[\]]):~$1:g;
                   3547:     return &mt($file_description);
1.112     bowersj2 3548: }
                   3549: 
                   3550: =pod
                   3551: 
1.648     raeburn  3552: =item * &filedescriptionex() 
1.112     bowersj2 3553: 
                   3554: returns description for a specified file type with
                   3555: extra formatting
                   3556: 
                   3557: =cut
                   3558: 
                   3559: sub filedescriptionex {
                   3560:     my $ex=shift;
1.188     matthew  3561:     my $file_description = $fd{lc($ex)};
                   3562:     $file_description =~ s:([\[\]]):~$1:g;
                   3563:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3564: }
                   3565: 
                   3566: # End of .tab access
                   3567: =pod
                   3568: 
                   3569: =back
                   3570: 
                   3571: =cut
                   3572: 
                   3573: # ------------------------------------------------------------------ File Types
                   3574: sub fileextensions {
                   3575:     return sort(keys(%fe));
                   3576: }
                   3577: 
1.97      www      3578: # ----------------------------------------------------------- Display Languages
                   3579: # returns a hash with all desired display languages
                   3580: #
                   3581: 
                   3582: sub display_languages {
                   3583:     my %languages=();
1.695     raeburn  3584:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3585: 	$languages{$lang}=1;
1.97      www      3586:     }
                   3587:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3588:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3589: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3590: 	    $languages{$lang}=1;
1.97      www      3591:         }
                   3592:     }
                   3593:     return %languages;
1.14      harris41 3594: }
                   3595: 
1.582     albertel 3596: sub languages {
                   3597:     my ($possible_langs) = @_;
1.695     raeburn  3598:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3599:     if (!ref($possible_langs)) {
                   3600: 	if( wantarray ) {
                   3601: 	    return @preferred_langs;
                   3602: 	} else {
                   3603: 	    return $preferred_langs[0];
                   3604: 	}
                   3605:     }
                   3606:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3607:     my @preferred_possibilities;
                   3608:     foreach my $preferred_lang (@preferred_langs) {
                   3609: 	if (exists($possibilities{$preferred_lang})) {
                   3610: 	    push(@preferred_possibilities, $preferred_lang);
                   3611: 	}
                   3612:     }
                   3613:     if( wantarray ) {
                   3614: 	return @preferred_possibilities;
                   3615:     }
                   3616:     return $preferred_possibilities[0];
                   3617: }
                   3618: 
1.742     raeburn  3619: sub user_lang {
                   3620:     my ($touname,$toudom,$fromcid) = @_;
                   3621:     my @userlangs;
                   3622:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3623:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3624:                     $env{'course.'.$fromcid.'.languages'}));
                   3625:     } else {
                   3626:         my %langhash = &getlangs($touname,$toudom);
                   3627:         if ($langhash{'languages'} ne '') {
                   3628:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3629:         } else {
                   3630:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3631:             if ($domdefs{'lang_def'} ne '') {
                   3632:                 @userlangs = ($domdefs{'lang_def'});
                   3633:             }
                   3634:         }
                   3635:     }
                   3636:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3637:     my $user_lh = Apache::localize->get_handle(@languages);
                   3638:     return $user_lh;
                   3639: }
                   3640: 
                   3641: 
1.112     bowersj2 3642: ###############################################################
                   3643: ##               Student Answer Attempts                     ##
                   3644: ###############################################################
                   3645: 
                   3646: =pod
                   3647: 
                   3648: =head1 Alternate Problem Views
                   3649: 
                   3650: =over 4
                   3651: 
1.648     raeburn  3652: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3653:     $getattempt, $regexp, $gradesub)
                   3654: 
                   3655: Return string with previous attempt on problem. Arguments:
                   3656: 
                   3657: =over 4
                   3658: 
                   3659: =item * $symb: Problem, including path
                   3660: 
                   3661: =item * $username: username of the desired student
                   3662: 
                   3663: =item * $domain: domain of the desired student
1.14      harris41 3664: 
1.112     bowersj2 3665: =item * $course: Course ID
1.14      harris41 3666: 
1.112     bowersj2 3667: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3668:     something
1.14      harris41 3669: 
1.112     bowersj2 3670: =item * $regexp: if string matches this regexp, the string will be
                   3671:     sent to $gradesub
1.14      harris41 3672: 
1.112     bowersj2 3673: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3674: 
1.112     bowersj2 3675: =back
1.14      harris41 3676: 
1.112     bowersj2 3677: The output string is a table containing all desired attempts, if any.
1.16      harris41 3678: 
1.112     bowersj2 3679: =cut
1.1       albertel 3680: 
                   3681: sub get_previous_attempt {
1.43      ng       3682:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3683:   my $prevattempts='';
1.43      ng       3684:   no strict 'refs';
1.1       albertel 3685:   if ($symb) {
1.3       albertel 3686:     my (%returnhash)=
                   3687:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3688:     if ($returnhash{'version'}) {
                   3689:       my %lasthash=();
                   3690:       my $version;
                   3691:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3692:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3693: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3694:         }
1.1       albertel 3695:       }
1.596     albertel 3696:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3697:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3698:       my (%typeparts,%lasthidden);
1.945     raeburn  3699:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3700:       foreach my $key (sort(keys(%lasthash))) {
                   3701: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3702: 	if ($#parts > 0) {
1.31      albertel 3703: 	  my $data=$parts[-1];
1.989     raeburn  3704:           next if ($data eq 'foilorder');
1.31      albertel 3705: 	  pop(@parts);
1.1010    www      3706:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3707:           if ($data eq 'type') {
                   3708:               unless ($showsurv) {
                   3709:                   my $id = join(',',@parts);
                   3710:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3711:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3712:                       $lasthidden{$ign.'.'.$id} = 1;
                   3713:                   }
1.945     raeburn  3714:               }
1.1010    www      3715:           } 
1.31      albertel 3716: 	} else {
1.41      ng       3717: 	  if ($#parts == 0) {
                   3718: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3719: 	  } else {
                   3720: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3721: 	  }
1.31      albertel 3722: 	}
1.16      harris41 3723:       }
1.596     albertel 3724:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3725:       if ($getattempt eq '') {
                   3726: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3727:             my @hidden;
                   3728:             if (%typeparts) {
                   3729:                 foreach my $id (keys(%typeparts)) {
                   3730:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3731:                         push(@hidden,$id);
                   3732:                     }
                   3733:                 }
                   3734:             }
                   3735:             $prevattempts.=&start_data_table_row().
                   3736:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3737:             if (@hidden) {
                   3738:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3739:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3740:                     my $hide;
                   3741:                     foreach my $id (@hidden) {
                   3742:                         if ($key =~ /^\Q$id\E/) {
                   3743:                             $hide = 1;
                   3744:                             last;
                   3745:                         }
                   3746:                     }
                   3747:                     if ($hide) {
                   3748:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3749:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3750:                             my $value = &format_previous_attempt_value($key,
                   3751:                                              $returnhash{$version.':'.$key});
                   3752:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3753:                         } else {
                   3754:                             $prevattempts.='<td>&nbsp;</td>';
                   3755:                         }
                   3756:                     } else {
                   3757:                         if ($key =~ /\./) {
                   3758:                             my $value = &format_previous_attempt_value($key,
                   3759:                                               $returnhash{$version.':'.$key});
                   3760:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3761:                         } else {
                   3762:                             $prevattempts.='<td>&nbsp;</td>';
                   3763:                         }
                   3764:                     }
                   3765:                 }
                   3766:             } else {
                   3767: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3768:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3769: 		    my $value = &format_previous_attempt_value($key,
                   3770: 			            $returnhash{$version.':'.$key});
                   3771: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3772: 	        }
                   3773:             }
                   3774: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3775: 	 }
1.1       albertel 3776:       }
1.945     raeburn  3777:       my @currhidden = keys(%lasthidden);
1.596     albertel 3778:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3779:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3780:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3781:           if (%typeparts) {
                   3782:               my $hidden;
                   3783:               foreach my $id (@currhidden) {
                   3784:                   if ($key =~ /^\Q$id\E/) {
                   3785:                       $hidden = 1;
                   3786:                       last;
                   3787:                   }
                   3788:               }
                   3789:               if ($hidden) {
                   3790:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3791:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3792:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3793:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3794:                           $value = &$gradesub($value);
                   3795:                       }
                   3796:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3797:                   } else {
                   3798:                       $prevattempts.='<td>&nbsp;</td>';
                   3799:                   }
                   3800:               } else {
                   3801:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3802:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3803:                       $value = &$gradesub($value);
                   3804:                   }
                   3805:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3806:               }
                   3807:           } else {
                   3808: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3809: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3810:                   $value = &$gradesub($value);
                   3811:               }
                   3812: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3813:           }
1.16      harris41 3814:       }
1.596     albertel 3815:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3816:     } else {
1.596     albertel 3817:       $prevattempts=
                   3818: 	  &start_data_table().&start_data_table_row().
                   3819: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3820: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3821:     }
                   3822:   } else {
1.596     albertel 3823:     $prevattempts=
                   3824: 	  &start_data_table().&start_data_table_row().
                   3825: 	  '<td>'.&mt('No data.').'</td>'.
                   3826: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3827:   }
1.10      albertel 3828: }
                   3829: 
1.581     albertel 3830: sub format_previous_attempt_value {
                   3831:     my ($key,$value) = @_;
1.1011    www      3832:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 3833: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3834:     } elsif (ref($value) eq 'ARRAY') {
                   3835: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3836:     } elsif ($key =~ /answerstring$/) {
                   3837:         my %answers = &Apache::lonnet::str2hash($value);
                   3838:         my @anskeys = sort(keys(%answers));
                   3839:         if (@anskeys == 1) {
                   3840:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3841:             if ($answer =~ m{\0}) {
                   3842:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3843:             }
                   3844:             my $tag_internal_answer_name = 'INTERNAL';
                   3845:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3846:                 $value = $answer; 
                   3847:             } else {
                   3848:                 $value = $anskeys[0].'='.$answer;
                   3849:             }
                   3850:         } else {
                   3851:             foreach my $ans (@anskeys) {
                   3852:                 my $answer = $answers{$ans};
1.1001    raeburn  3853:                 if ($answer =~ m{\0}) {
                   3854:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3855:                 }
                   3856:                 $value .=  $ans.'='.$answer.'<br />';;
                   3857:             } 
                   3858:         }
1.581     albertel 3859:     } else {
                   3860: 	$value = &unescape($value);
                   3861:     }
                   3862:     return $value;
                   3863: }
                   3864: 
                   3865: 
1.107     albertel 3866: sub relative_to_absolute {
                   3867:     my ($url,$output)=@_;
                   3868:     my $parser=HTML::TokeParser->new(\$output);
                   3869:     my $token;
                   3870:     my $thisdir=$url;
                   3871:     my @rlinks=();
                   3872:     while ($token=$parser->get_token) {
                   3873: 	if ($token->[0] eq 'S') {
                   3874: 	    if ($token->[1] eq 'a') {
                   3875: 		if ($token->[2]->{'href'}) {
                   3876: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3877: 		}
                   3878: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3879: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3880: 	    } elsif ($token->[1] eq 'base') {
                   3881: 		$thisdir=$token->[2]->{'href'};
                   3882: 	    }
                   3883: 	}
                   3884:     }
                   3885:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3886:     foreach my $link (@rlinks) {
1.726     raeburn  3887: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3888: 		($link=~/^\//) ||
                   3889: 		($link=~/^javascript:/i) ||
                   3890: 		($link=~/^mailto:/i) ||
                   3891: 		($link=~/^\#/)) {
                   3892: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3893: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3894: 	}
                   3895:     }
                   3896: # -------------------------------------------------- Deal with Applet codebases
                   3897:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3898:     return $output;
                   3899: }
                   3900: 
1.112     bowersj2 3901: =pod
                   3902: 
1.648     raeburn  3903: =item * &get_student_view()
1.112     bowersj2 3904: 
                   3905: show a snapshot of what student was looking at
                   3906: 
                   3907: =cut
                   3908: 
1.10      albertel 3909: sub get_student_view {
1.186     albertel 3910:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3911:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3912:   my (%form);
1.10      albertel 3913:   my @elements=('symb','courseid','domain','username');
                   3914:   foreach my $element (@elements) {
1.186     albertel 3915:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3916:   }
1.186     albertel 3917:   if (defined($moreenv)) {
                   3918:       %form=(%form,%{$moreenv});
                   3919:   }
1.236     albertel 3920:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 3921:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      3922:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 3923:   $userview=~s/\<body[^\>]*\>//gi;
                   3924:   $userview=~s/\<\/body\>//gi;
                   3925:   $userview=~s/\<html\>//gi;
                   3926:   $userview=~s/\<\/html\>//gi;
                   3927:   $userview=~s/\<head\>//gi;
                   3928:   $userview=~s/\<\/head\>//gi;
                   3929:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 3930:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      3931:   if (wantarray) {
                   3932:      return ($userview,$response);
                   3933:   } else {
                   3934:      return $userview;
                   3935:   }
                   3936: }
                   3937: 
                   3938: sub get_student_view_with_retries {
                   3939:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   3940: 
                   3941:     my $ok = 0;                 # True if we got a good response.
                   3942:     my $content;
                   3943:     my $response;
                   3944: 
                   3945:     # Try to get the student_view done. within the retries count:
                   3946:     
                   3947:     do {
                   3948:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   3949:          $ok      = $response->is_success;
                   3950:          if (!$ok) {
                   3951:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   3952:          }
                   3953:          $retries--;
                   3954:     } while (!$ok && ($retries > 0));
                   3955:     
                   3956:     if (!$ok) {
                   3957:        $content = '';          # On error return an empty content.
                   3958:     }
1.651     www      3959:     if (wantarray) {
                   3960:        return ($content, $response);
                   3961:     } else {
                   3962:        return $content;
                   3963:     }
1.11      albertel 3964: }
                   3965: 
1.112     bowersj2 3966: =pod
                   3967: 
1.648     raeburn  3968: =item * &get_student_answers() 
1.112     bowersj2 3969: 
                   3970: show a snapshot of how student was answering problem
                   3971: 
                   3972: =cut
                   3973: 
1.11      albertel 3974: sub get_student_answers {
1.100     sakharuk 3975:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      3976:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3977:   my (%moreenv);
1.11      albertel 3978:   my @elements=('symb','courseid','domain','username');
                   3979:   foreach my $element (@elements) {
1.186     albertel 3980:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3981:   }
1.186     albertel 3982:   $moreenv{'grade_target'}='answer';
                   3983:   %moreenv=(%form,%moreenv);
1.497     raeburn  3984:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   3985:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 3986:   return $userview;
1.1       albertel 3987: }
1.116     albertel 3988: 
                   3989: =pod
                   3990: 
                   3991: =item * &submlink()
                   3992: 
1.242     albertel 3993: Inputs: $text $uname $udom $symb $target
1.116     albertel 3994: 
                   3995: Returns: A link to grades.pm such as to see the SUBM view of a student
                   3996: 
                   3997: =cut
                   3998: 
                   3999: ###############################################
                   4000: sub submlink {
1.242     albertel 4001:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4002:     if (!($uname && $udom)) {
                   4003: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4004: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4005: 	if (!$symb) { $symb=$cursymb; }
                   4006:     }
1.254     matthew  4007:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4008:     $symb=&escape($symb);
1.960     bisitz   4009:     if ($target) { $target=" target=\"$target\""; }
                   4010:     return
                   4011:         '<a href="/adm/grades?command=submission'.
                   4012:         '&amp;symb='.$symb.
                   4013:         '&amp;student='.$uname.
                   4014:         '&amp;userdom='.$udom.'"'.
                   4015:         $target.'>'.$text.'</a>';
1.242     albertel 4016: }
                   4017: ##############################################
                   4018: 
                   4019: =pod
                   4020: 
                   4021: =item * &pgrdlink()
                   4022: 
                   4023: Inputs: $text $uname $udom $symb $target
                   4024: 
                   4025: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4026: 
                   4027: =cut
                   4028: 
                   4029: ###############################################
                   4030: sub pgrdlink {
                   4031:     my $link=&submlink(@_);
                   4032:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4033:     return $link;
                   4034: }
                   4035: ##############################################
                   4036: 
                   4037: =pod
                   4038: 
                   4039: =item * &pprmlink()
                   4040: 
                   4041: Inputs: $text $uname $udom $symb $target
                   4042: 
                   4043: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4044: student and a specific resource
1.242     albertel 4045: 
                   4046: =cut
                   4047: 
                   4048: ###############################################
                   4049: sub pprmlink {
                   4050:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4051:     if (!($uname && $udom)) {
                   4052: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4053: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4054: 	if (!$symb) { $symb=$cursymb; }
                   4055:     }
1.254     matthew  4056:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4057:     $symb=&escape($symb);
1.242     albertel 4058:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4059:     return '<a href="/adm/parmset?command=set&amp;'.
                   4060: 	'symb='.$symb.'&amp;uname='.$uname.
                   4061: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4062: }
                   4063: ##############################################
1.37      matthew  4064: 
1.112     bowersj2 4065: =pod
                   4066: 
                   4067: =back
                   4068: 
                   4069: =cut
                   4070: 
1.37      matthew  4071: ###############################################
1.51      www      4072: 
                   4073: 
                   4074: sub timehash {
1.687     raeburn  4075:     my ($thistime) = @_;
                   4076:     my $timezone = &Apache::lonlocal::gettimezone();
                   4077:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4078:                      ->set_time_zone($timezone);
                   4079:     my $wday = $dt->day_of_week();
                   4080:     if ($wday == 7) { $wday = 0; }
                   4081:     return ( 'second' => $dt->second(),
                   4082:              'minute' => $dt->minute(),
                   4083:              'hour'   => $dt->hour(),
                   4084:              'day'     => $dt->day_of_month(),
                   4085:              'month'   => $dt->month(),
                   4086:              'year'    => $dt->year(),
                   4087:              'weekday' => $wday,
                   4088:              'dayyear' => $dt->day_of_year(),
                   4089:              'dlsav'   => $dt->is_dst() );
1.51      www      4090: }
                   4091: 
1.370     www      4092: sub utc_string {
                   4093:     my ($date)=@_;
1.371     www      4094:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4095: }
                   4096: 
1.51      www      4097: sub maketime {
                   4098:     my %th=@_;
1.687     raeburn  4099:     my ($epoch_time,$timezone,$dt);
                   4100:     $timezone = &Apache::lonlocal::gettimezone();
                   4101:     eval {
                   4102:         $dt = DateTime->new( year   => $th{'year'},
                   4103:                              month  => $th{'month'},
                   4104:                              day    => $th{'day'},
                   4105:                              hour   => $th{'hour'},
                   4106:                              minute => $th{'minute'},
                   4107:                              second => $th{'second'},
                   4108:                              time_zone => $timezone,
                   4109:                          );
                   4110:     };
                   4111:     if (!$@) {
                   4112:         $epoch_time = $dt->epoch;
                   4113:         if ($epoch_time) {
                   4114:             return $epoch_time;
                   4115:         }
                   4116:     }
1.51      www      4117:     return POSIX::mktime(
                   4118:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4119:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4120: }
                   4121: 
                   4122: #########################################
1.51      www      4123: 
                   4124: sub findallcourses {
1.482     raeburn  4125:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4126:     my %roles;
                   4127:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4128:     my %courses;
1.51      www      4129:     my $now=time;
1.482     raeburn  4130:     if (!defined($uname)) {
                   4131:         $uname = $env{'user.name'};
                   4132:     }
                   4133:     if (!defined($udom)) {
                   4134:         $udom = $env{'user.domain'};
                   4135:     }
                   4136:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4137:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4138:         if (!%roles) {
                   4139:             %roles = (
                   4140:                        cc => 1,
1.907     raeburn  4141:                        co => 1,
1.482     raeburn  4142:                        in => 1,
                   4143:                        ep => 1,
                   4144:                        ta => 1,
                   4145:                        cr => 1,
                   4146:                        st => 1,
                   4147:              );
                   4148:         }
                   4149:         foreach my $entry (keys(%roleshash)) {
                   4150:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4151:             if ($trole =~ /^cr/) { 
                   4152:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4153:             } else {
                   4154:                 next if (!exists($roles{$trole}));
                   4155:             }
                   4156:             if ($tend) {
                   4157:                 next if ($tend < $now);
                   4158:             }
                   4159:             if ($tstart) {
                   4160:                 next if ($tstart > $now);
                   4161:             }
1.1058    raeburn  4162:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4163:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4164:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4165:             if ($secpart eq '') {
                   4166:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4167:                 $sec = 'none';
1.1058    raeburn  4168:                 $value .= $cnum.'/';
1.482     raeburn  4169:             } else {
                   4170:                 $cnum = $cnumpart;
                   4171:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4172:                 $value .= $cnum.'/'.$sec;
                   4173:             }
                   4174:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4175:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4176:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4177:                 }
                   4178:             } else {
                   4179:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4180:             }
1.482     raeburn  4181:         }
                   4182:     } else {
                   4183:         foreach my $key (keys(%env)) {
1.483     albertel 4184: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4185:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4186: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4187: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4188: 	        next if (%roles && !exists($roles{$role}));
                   4189: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4190:                 my $active=1;
                   4191:                 if ($starttime) {
                   4192: 		    if ($now<$starttime) { $active=0; }
                   4193:                 }
                   4194:                 if ($endtime) {
                   4195:                     if ($now>$endtime) { $active=0; }
                   4196:                 }
                   4197:                 if ($active) {
1.1058    raeburn  4198:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4199:                     if ($sec eq '') {
                   4200:                         $sec = 'none';
1.1058    raeburn  4201:                     } else {
                   4202:                         $value .= $sec;
                   4203:                     }
                   4204:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4205:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4206:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4207:                         }
                   4208:                     } else {
                   4209:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4210:                     }
1.474     raeburn  4211:                 }
                   4212:             }
1.51      www      4213:         }
                   4214:     }
1.474     raeburn  4215:     return %courses;
1.51      www      4216: }
1.37      matthew  4217: 
1.54      www      4218: ###############################################
1.474     raeburn  4219: 
                   4220: sub blockcheck {
1.1062    raeburn  4221:     my ($setters,$activity,$uname,$udom,$url) = @_;
1.490     raeburn  4222: 
                   4223:     if (!defined($udom)) {
                   4224:         $udom = $env{'user.domain'};
                   4225:     }
                   4226:     if (!defined($uname)) {
                   4227:         $uname = $env{'user.name'};
                   4228:     }
                   4229: 
                   4230:     # If uname and udom are for a course, check for blocks in the course.
                   4231: 
                   4232:     if (&Apache::lonnet::is_course($udom,$uname)) {
1.1062    raeburn  4233:         my ($startblock,$endblock,$triggerblock) = 
                   4234:             &get_blocks($setters,$activity,$udom,$uname,$url);
                   4235:         return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4236:     }
1.474     raeburn  4237: 
1.502     raeburn  4238:     my $startblock = 0;
                   4239:     my $endblock = 0;
1.1062    raeburn  4240:     my $triggerblock = '';
1.482     raeburn  4241:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4242: 
1.490     raeburn  4243:     # If uname is for a user, and activity is course-specific, i.e.,
                   4244:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4245: 
1.490     raeburn  4246:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   4247:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   4248:         foreach my $key (keys(%live_courses)) {
                   4249:             if ($key ne $env{'request.course.id'}) {
                   4250:                 delete($live_courses{$key});
                   4251:             }
                   4252:         }
                   4253:     }
                   4254: 
                   4255:     my $otheruser = 0;
                   4256:     my %own_courses;
                   4257:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4258:         # Resource belongs to user other than current user.
                   4259:         $otheruser = 1;
                   4260:         # Gather courses for current user
                   4261:         %own_courses = 
                   4262:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4263:     }
                   4264: 
                   4265:     # Gather active course roles - course coordinator, instructor, 
                   4266:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4267: 
                   4268:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4269:         my ($cdom,$cnum);
                   4270:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4271:             $cdom = $env{'course.'.$course.'.domain'};
                   4272:             $cnum = $env{'course.'.$course.'.num'};
                   4273:         } else {
1.490     raeburn  4274:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4275:         }
                   4276:         my $no_ownblock = 0;
                   4277:         my $no_userblock = 0;
1.533     raeburn  4278:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4279:             # Check if current user has 'evb' priv for this
                   4280:             if (defined($own_courses{$course})) {
                   4281:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4282:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4283:                     if ($sec ne 'none') {
                   4284:                         $checkrole .= '/'.$sec;
                   4285:                     }
                   4286:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4287:                         $no_ownblock = 1;
                   4288:                         last;
                   4289:                     }
                   4290:                 }
                   4291:             }
                   4292:             # if they have 'evb' priv and are currently not playing student
                   4293:             next if (($no_ownblock) &&
                   4294:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4295:         }
1.474     raeburn  4296:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4297:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4298:             if ($sec ne 'none') {
1.482     raeburn  4299:                 $checkrole .= '/'.$sec;
1.474     raeburn  4300:             }
1.490     raeburn  4301:             if ($otheruser) {
                   4302:                 # Resource belongs to user other than current user.
                   4303:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4304:                 my (%allroles,%userroles);
                   4305:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4306:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4307:                         my ($trole,$tdom,$tnum,$tsec);
                   4308:                         if ($entry =~ /^cr/) {
                   4309:                             ($trole,$tdom,$tnum,$tsec) = 
                   4310:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4311:                         } else {
                   4312:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4313:                         }
                   4314:                         my ($spec,$area,$trest);
                   4315:                         $area = '/'.$tdom.'/'.$tnum;
                   4316:                         $trest = $tnum;
                   4317:                         if ($tsec ne '') {
                   4318:                             $area .= '/'.$tsec;
                   4319:                             $trest .= '/'.$tsec;
                   4320:                         }
                   4321:                         $spec = $trole.'.'.$area;
                   4322:                         if ($trole =~ /^cr/) {
                   4323:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4324:                                                               $tdom,$spec,$trest,$area);
                   4325:                         } else {
                   4326:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4327:                                                                 $tdom,$spec,$trest,$area);
                   4328:                         }
                   4329:                     }
                   4330:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4331:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4332:                         if ($1) {
                   4333:                             $no_userblock = 1;
                   4334:                             last;
                   4335:                         }
1.486     raeburn  4336:                     }
                   4337:                 }
1.490     raeburn  4338:             } else {
                   4339:                 # Resource belongs to current user
                   4340:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4341:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4342:                     $no_ownblock = 1;
                   4343:                     last;
                   4344:                 }
1.474     raeburn  4345:             }
                   4346:         }
                   4347:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4348:         next if (($no_ownblock) &&
1.491     albertel 4349:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4350:         next if ($no_userblock);
1.474     raeburn  4351: 
1.866     kalberla 4352:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4353:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4354:         
1.1062    raeburn  4355:         my ($start,$end,$trigger) = 
                   4356:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4357:         if (($start != 0) && 
                   4358:             (($startblock == 0) || ($startblock > $start))) {
                   4359:             $startblock = $start;
1.1062    raeburn  4360:             if ($trigger ne '') {
                   4361:                 $triggerblock = $trigger;
                   4362:             }
1.502     raeburn  4363:         }
                   4364:         if (($end != 0)  &&
                   4365:             (($endblock == 0) || ($endblock < $end))) {
                   4366:             $endblock = $end;
1.1062    raeburn  4367:             if ($trigger ne '') {
                   4368:                 $triggerblock = $trigger;
                   4369:             }
1.502     raeburn  4370:         }
1.490     raeburn  4371:     }
1.1062    raeburn  4372:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4373: }
                   4374: 
                   4375: sub get_blocks {
1.1062    raeburn  4376:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4377:     my $startblock = 0;
                   4378:     my $endblock = 0;
1.1062    raeburn  4379:     my $triggerblock = '';
1.490     raeburn  4380:     my $course = $cdom.'_'.$cnum;
                   4381:     $setters->{$course} = {};
                   4382:     $setters->{$course}{'staff'} = [];
                   4383:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4384:     $setters->{$course}{'triggers'} = [];
                   4385:     my (@blockers,%triggered);
                   4386:     my $now = time;
                   4387:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4388:     if ($activity eq 'docs') {
                   4389:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4390:         foreach my $block (@blockers) {
                   4391:             if ($block =~ /^firstaccess____(.+)$/) {
                   4392:                 my $item = $1;
                   4393:                 my $type = 'map';
                   4394:                 my $timersymb = $item;
                   4395:                 if ($item eq 'course') {
                   4396:                     $type = 'course';
                   4397:                 } elsif ($item =~ /___\d+___/) {
                   4398:                     $type = 'resource';
                   4399:                 } else {
                   4400:                     $timersymb = &Apache::lonnet::symbread($item);
                   4401:                 }
                   4402:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4403:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4404:                 $triggered{$block} = {
                   4405:                                        start => $start,
                   4406:                                        end   => $end,
                   4407:                                        type  => $type,
                   4408:                                      };
                   4409:             }
                   4410:         }
                   4411:     } else {
                   4412:         foreach my $block (keys(%commblocks)) {
                   4413:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4414:                 my ($start,$end) = ($1,$2);
                   4415:                 if ($start <= time && $end >= time) {
                   4416:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4417:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4418:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4419:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4420:                                     push(@blockers,$block);
                   4421:                                 }
                   4422:                             }
                   4423:                         }
                   4424:                     }
                   4425:                 }
                   4426:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4427:                 my $item = $1;
                   4428:                 my $timersymb = $item; 
                   4429:                 my $type = 'map';
                   4430:                 if ($item eq 'course') {
                   4431:                     $type = 'course';
                   4432:                 } elsif ($item =~ /___\d+___/) {
                   4433:                     $type = 'resource';
                   4434:                 } else {
                   4435:                     $timersymb = &Apache::lonnet::symbread($item);
                   4436:                 }
                   4437:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4438:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4439:                 if ($start && $end) {
                   4440:                     if (($start <= time) && ($end >= time)) {
                   4441:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4442:                             push(@blockers,$block);
                   4443:                             $triggered{$block} = {
                   4444:                                                    start => $start,
                   4445:                                                    end   => $end,
                   4446:                                                    type  => $type,
                   4447:                                                  };
                   4448:                         }
                   4449:                     }
1.490     raeburn  4450:                 }
1.1062    raeburn  4451:             }
                   4452:         }
                   4453:     }
                   4454:     foreach my $blocker (@blockers) {
                   4455:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4456:             &parse_block_record($commblocks{$blocker});
                   4457:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4458:         my ($start,$end,$triggertype);
                   4459:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4460:             ($start,$end) = ($1,$2);
                   4461:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4462:             $start = $triggered{$blocker}{'start'};
                   4463:             $end = $triggered{$blocker}{'end'};
                   4464:             $triggertype = $triggered{$blocker}{'type'};
                   4465:         }
                   4466:         if ($start) {
                   4467:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4468:             if ($triggertype) {
                   4469:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4470:             } else {
                   4471:                 push(@{$$setters{$course}{'triggers'}},0);
                   4472:             }
                   4473:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4474:                 $startblock = $start;
                   4475:                 if ($triggertype) {
                   4476:                     $triggerblock = $blocker;
1.474     raeburn  4477:                 }
                   4478:             }
1.1062    raeburn  4479:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4480:                $endblock = $end;
                   4481:                if ($triggertype) {
                   4482:                    $triggerblock = $blocker;
                   4483:                }
                   4484:             }
1.474     raeburn  4485:         }
                   4486:     }
1.1062    raeburn  4487:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4488: }
                   4489: 
                   4490: sub parse_block_record {
                   4491:     my ($record) = @_;
                   4492:     my ($setuname,$setudom,$title,$blocks);
                   4493:     if (ref($record) eq 'HASH') {
                   4494:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4495:         $title = &unescape($record->{'event'});
                   4496:         $blocks = $record->{'blocks'};
                   4497:     } else {
                   4498:         my @data = split(/:/,$record,3);
                   4499:         if (scalar(@data) eq 2) {
                   4500:             $title = $data[1];
                   4501:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4502:         } else {
                   4503:             ($setuname,$setudom,$title) = @data;
                   4504:         }
                   4505:         $blocks = { 'com' => 'on' };
                   4506:     }
                   4507:     return ($setuname,$setudom,$title,$blocks);
                   4508: }
                   4509: 
1.854     kalberla 4510: sub blocking_status {
1.1062    raeburn  4511:     my ($activity,$uname,$udom,$url) = @_;
1.1061    raeburn  4512:     my %setters;
1.890     droeschl 4513: 
1.1061    raeburn  4514: # check for active blocking
1.1062    raeburn  4515:     my ($startblock,$endblock,$triggerblock) = 
                   4516:         &blockcheck(\%setters,$activity,$uname,$udom,$url);
                   4517:     my $blocked = 0;
                   4518:     if ($startblock && $endblock) {
                   4519:         $blocked = 1;
                   4520:     }
1.890     droeschl 4521: 
1.1061    raeburn  4522: # caller just wants to know whether a block is active
                   4523:     if (!wantarray) { return $blocked; }
                   4524: 
                   4525: # build a link to a popup window containing the details
                   4526:     my $querystring  = "?activity=$activity";
                   4527: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062    raeburn  4528:     if ($activity eq 'port') {
                   4529:         $querystring .= "&amp;udom=$udom"      if $udom;
                   4530:         $querystring .= "&amp;uname=$uname"    if $uname;
                   4531:     } elsif ($activity eq 'docs') {
                   4532:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4533:     }
1.1061    raeburn  4534: 
                   4535:     my $output .= <<'END_MYBLOCK';
                   4536: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4537:     var options = "width=" + w + ",height=" + h + ",";
                   4538:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4539:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4540:     var newWin = window.open(url, wdwName, options);
                   4541:     newWin.focus();
                   4542: }
1.890     droeschl 4543: END_MYBLOCK
1.854     kalberla 4544: 
1.1061    raeburn  4545:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4546:   
1.1061    raeburn  4547:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4548:     my $text = &mt('Communication Blocked');
                   4549:     if ($activity eq 'docs') {
                   4550:         $text = &mt('Content Access Blocked');
1.1063    raeburn  4551:     } elsif ($activity eq 'printout') {
                   4552:         $text = &mt('Printing Blocked');
1.1062    raeburn  4553:     }
1.1061    raeburn  4554:     $output .= <<"END_BLOCK";
1.867     kalberla 4555: <div class='LC_comblock'>
1.869     kalberla 4556:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4557:   title='$text'>
                   4558:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4559:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4560:   title='$text'>$text</a>
1.867     kalberla 4561: </div>
                   4562: 
                   4563: END_BLOCK
1.474     raeburn  4564: 
1.1061    raeburn  4565:     return ($blocked, $output);
1.854     kalberla 4566: }
1.490     raeburn  4567: 
1.60      matthew  4568: ###############################################
                   4569: 
1.682     raeburn  4570: sub check_ip_acc {
                   4571:     my ($acc)=@_;
                   4572:     &Apache::lonxml::debug("acc is $acc");
                   4573:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4574:         return 1;
                   4575:     }
                   4576:     my $allowed=0;
                   4577:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4578: 
                   4579:     my $name;
                   4580:     foreach my $pattern (split(',',$acc)) {
                   4581:         $pattern =~ s/^\s*//;
                   4582:         $pattern =~ s/\s*$//;
                   4583:         if ($pattern =~ /\*$/) {
                   4584:             #35.8.*
                   4585:             $pattern=~s/\*//;
                   4586:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4587:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4588:             #35.8.3.[34-56]
                   4589:             my $low=$2;
                   4590:             my $high=$3;
                   4591:             $pattern=$1;
                   4592:             if ($ip =~ /^\Q$pattern\E/) {
                   4593:                 my $last=(split(/\./,$ip))[3];
                   4594:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4595:             }
                   4596:         } elsif ($pattern =~ /^\*/) {
                   4597:             #*.msu.edu
                   4598:             $pattern=~s/\*//;
                   4599:             if (!defined($name)) {
                   4600:                 use Socket;
                   4601:                 my $netaddr=inet_aton($ip);
                   4602:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4603:             }
                   4604:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4605:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4606:             #127.0.0.1
                   4607:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4608:         } else {
                   4609:             #some.name.com
                   4610:             if (!defined($name)) {
                   4611:                 use Socket;
                   4612:                 my $netaddr=inet_aton($ip);
                   4613:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4614:             }
                   4615:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4616:         }
                   4617:         if ($allowed) { last; }
                   4618:     }
                   4619:     return $allowed;
                   4620: }
                   4621: 
                   4622: ###############################################
                   4623: 
1.60      matthew  4624: =pod
                   4625: 
1.112     bowersj2 4626: =head1 Domain Template Functions
                   4627: 
                   4628: =over 4
                   4629: 
                   4630: =item * &determinedomain()
1.60      matthew  4631: 
                   4632: Inputs: $domain (usually will be undef)
                   4633: 
1.63      www      4634: Returns: Determines which domain should be used for designs
1.60      matthew  4635: 
                   4636: =cut
1.54      www      4637: 
1.60      matthew  4638: ###############################################
1.63      www      4639: sub determinedomain {
                   4640:     my $domain=shift;
1.531     albertel 4641:     if (! $domain) {
1.60      matthew  4642:         # Determine domain if we have not been given one
1.893     raeburn  4643:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4644:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4645:         if ($env{'request.role.domain'}) { 
                   4646:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4647:         }
                   4648:     }
1.63      www      4649:     return $domain;
                   4650: }
                   4651: ###############################################
1.517     raeburn  4652: 
1.518     albertel 4653: sub devalidate_domconfig_cache {
                   4654:     my ($udom)=@_;
                   4655:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4656: }
                   4657: 
                   4658: # ---------------------- Get domain configuration for a domain
                   4659: sub get_domainconf {
                   4660:     my ($udom) = @_;
                   4661:     my $cachetime=1800;
                   4662:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4663:     if (defined($cached)) { return %{$result}; }
                   4664: 
                   4665:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4666: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4667:     my (%designhash,%legacy);
1.518     albertel 4668:     if (keys(%domconfig) > 0) {
                   4669:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4670:             if (keys(%{$domconfig{'login'}})) {
                   4671:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4672:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4673:                         if ($key eq 'loginvia') {
                   4674:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013    raeburn  4675:                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948     raeburn  4676:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4677:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4678:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4679:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4680:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4681: 
                   4682:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4683:                                             } else {
1.1013    raeburn  4684:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948     raeburn  4685:                                             }
                   4686:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4687:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4688:                                             }
1.946     raeburn  4689:                                         }
                   4690:                                     }
                   4691:                                 }
                   4692:                             }
                   4693:                         } else {
                   4694:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4695:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4696:                                     $domconfig{'login'}{$key}{$img};
                   4697:                             }
1.699     raeburn  4698:                         }
                   4699:                     } else {
                   4700:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4701:                     }
1.632     raeburn  4702:                 }
                   4703:             } else {
                   4704:                 $legacy{'login'} = 1;
1.518     albertel 4705:             }
1.632     raeburn  4706:         } else {
                   4707:             $legacy{'login'} = 1;
1.518     albertel 4708:         }
                   4709:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4710:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4711:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4712:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4713:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4714:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4715:                         }
1.518     albertel 4716:                     }
                   4717:                 }
1.632     raeburn  4718:             } else {
                   4719:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4720:             }
1.632     raeburn  4721:         } else {
                   4722:             $legacy{'rolecolors'} = 1;
1.518     albertel 4723:         }
1.948     raeburn  4724:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4725:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4726:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4727:             }
                   4728:         }
1.632     raeburn  4729:         if (keys(%legacy) > 0) {
                   4730:             my %legacyhash = &get_legacy_domconf($udom);
                   4731:             foreach my $item (keys(%legacyhash)) {
                   4732:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4733:                     if ($legacy{'login'}) { 
                   4734:                         $designhash{$item} = $legacyhash{$item};
                   4735:                     }
                   4736:                 } else {
                   4737:                     if ($legacy{'rolecolors'}) {
                   4738:                         $designhash{$item} = $legacyhash{$item};
                   4739:                     }
1.518     albertel 4740:                 }
                   4741:             }
                   4742:         }
1.632     raeburn  4743:     } else {
                   4744:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4745:     }
                   4746:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4747: 				  $cachetime);
                   4748:     return %designhash;
                   4749: }
                   4750: 
1.632     raeburn  4751: sub get_legacy_domconf {
                   4752:     my ($udom) = @_;
                   4753:     my %legacyhash;
                   4754:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4755:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4756:     if (-e $designfile) {
                   4757:         if ( open (my $fh,"<$designfile") ) {
                   4758:             while (my $line = <$fh>) {
                   4759:                 next if ($line =~ /^\#/);
                   4760:                 chomp($line);
                   4761:                 my ($key,$val)=(split(/\=/,$line));
                   4762:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4763:             }
                   4764:             close($fh);
                   4765:         }
                   4766:     }
1.1026    raeburn  4767:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4768:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4769:     }
                   4770:     return %legacyhash;
                   4771: }
                   4772: 
1.63      www      4773: =pod
                   4774: 
1.112     bowersj2 4775: =item * &domainlogo()
1.63      www      4776: 
                   4777: Inputs: $domain (usually will be undef)
                   4778: 
                   4779: Returns: A link to a domain logo, if the domain logo exists.
                   4780: If the domain logo does not exist, a description of the domain.
                   4781: 
                   4782: =cut
1.112     bowersj2 4783: 
1.63      www      4784: ###############################################
                   4785: sub domainlogo {
1.517     raeburn  4786:     my $domain = &determinedomain(shift);
1.518     albertel 4787:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4788:     # See if there is a logo
                   4789:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4790:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4791:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4792: 	    if ($imgsrc =~ m{^/res/}) {
                   4793: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4794: 		&Apache::lonnet::repcopy($local_name);
                   4795: 	    }
                   4796: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4797:         } 
                   4798:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4799:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4800:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4801:     } else {
1.60      matthew  4802:         return '';
1.59      www      4803:     }
                   4804: }
1.63      www      4805: ##############################################
                   4806: 
                   4807: =pod
                   4808: 
1.112     bowersj2 4809: =item * &designparm()
1.63      www      4810: 
                   4811: Inputs: $which parameter; $domain (usually will be undef)
                   4812: 
                   4813: Returns: value of designparamter $which
                   4814: 
                   4815: =cut
1.112     bowersj2 4816: 
1.397     albertel 4817: 
1.400     albertel 4818: ##############################################
1.397     albertel 4819: sub designparm {
                   4820:     my ($which,$domain)=@_;
                   4821:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4822:         return $env{'environment.color.'.$which};
1.96      www      4823:     }
1.63      www      4824:     $domain=&determinedomain($domain);
1.1016    raeburn  4825:     my %domdesign;
                   4826:     unless ($domain eq 'public') {
                   4827:         %domdesign = &get_domainconf($domain);
                   4828:     }
1.520     raeburn  4829:     my $output;
1.517     raeburn  4830:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4831:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4832:     } else {
1.520     raeburn  4833:         $output = $defaultdesign{$which};
                   4834:     }
                   4835:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4836:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4837:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4838:             if ($output =~ m{^/res/}) {
                   4839:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4840:                 &Apache::lonnet::repcopy($local_name);
                   4841:             }
1.520     raeburn  4842:             $output = &lonhttpdurl($output);
                   4843:         }
1.63      www      4844:     }
1.520     raeburn  4845:     return $output;
1.63      www      4846: }
1.59      www      4847: 
1.822     bisitz   4848: ##############################################
                   4849: =pod
                   4850: 
1.832     bisitz   4851: =item * &authorspace()
                   4852: 
1.1028    raeburn  4853: Inputs: $url (usually will be undef).
1.832     bisitz   4854: 
1.1075.2.40  raeburn  4855: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  4856:          directory being viewed (or for which action is being taken). 
                   4857:          If $url is provided, and begins /priv/<domain>/<uname>
                   4858:          the path will be that portion of the $context argument.
                   4859:          Otherwise the path will be for the author space of the current
                   4860:          user when the current role is author, or for that of the 
                   4861:          co-author/assistant co-author space when the current role 
                   4862:          is co-author or assistant co-author.
1.832     bisitz   4863: 
                   4864: =cut
                   4865: 
                   4866: sub authorspace {
1.1028    raeburn  4867:     my ($url) = @_;
                   4868:     if ($url ne '') {
                   4869:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4870:            return $1;
                   4871:         }
                   4872:     }
1.832     bisitz   4873:     my $caname = '';
1.1024    www      4874:     my $cadom = '';
1.1028    raeburn  4875:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4876:         ($cadom,$caname) =
1.832     bisitz   4877:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4878:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4879:         $caname = $env{'user.name'};
1.1024    www      4880:         $cadom = $env{'user.domain'};
1.832     bisitz   4881:     }
1.1028    raeburn  4882:     if (($caname ne '') && ($cadom ne '')) {
                   4883:         return "/priv/$cadom/$caname/";
                   4884:     }
                   4885:     return;
1.832     bisitz   4886: }
                   4887: 
                   4888: ##############################################
                   4889: =pod
                   4890: 
1.822     bisitz   4891: =item * &head_subbox()
                   4892: 
                   4893: Inputs: $content (contains HTML code with page functions, etc.)
                   4894: 
                   4895: Returns: HTML div with $content
                   4896:          To be included in page header
                   4897: 
                   4898: =cut
                   4899: 
                   4900: sub head_subbox {
                   4901:     my ($content)=@_;
                   4902:     my $output =
1.993     raeburn  4903:         '<div class="LC_head_subbox">'
1.822     bisitz   4904:        .$content
                   4905:        .'</div>'
                   4906: }
                   4907: 
                   4908: ##############################################
                   4909: =pod
                   4910: 
                   4911: =item * &CSTR_pageheader()
                   4912: 
1.1026    raeburn  4913: Input: (optional) filename from which breadcrumb trail is built.
                   4914:        In most cases no input as needed, as $env{'request.filename'}
                   4915:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   4916: 
                   4917: Returns: HTML div with CSTR path and recent box
1.1075.2.40  raeburn  4918:          To be included on Authoring Space pages
1.822     bisitz   4919: 
                   4920: =cut
                   4921: 
                   4922: sub CSTR_pageheader {
1.1026    raeburn  4923:     my ($trailfile) = @_;
                   4924:     if ($trailfile eq '') {
                   4925:         $trailfile = $env{'request.filename'};
                   4926:     }
                   4927: 
                   4928: # this is for resources; directories have customtitle, and crumbs
                   4929: # and select recent are created in lonpubdir.pm
                   4930: 
                   4931:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      4932:     my ($udom,$uname,$thisdisfn)=
1.1075.2.29  raeburn  4933:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  4934:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   4935:     $formaction =~ s{/+}{/}g;
1.822     bisitz   4936: 
                   4937:     my $parentpath = '';
                   4938:     my $lastitem = '';
                   4939:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   4940:         $parentpath = $1;
                   4941:         $lastitem = $2;
                   4942:     } else {
                   4943:         $lastitem = $thisdisfn;
                   4944:     }
1.921     bisitz   4945: 
                   4946:     my $output =
1.822     bisitz   4947:          '<div>'
                   4948:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40  raeburn  4949:         .'<b>'.&mt('Authoring Space:').'</b> '
1.822     bisitz   4950:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   4951:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      4952:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   4953: 
                   4954:     if ($lastitem) {
                   4955:         $output .=
                   4956:              '<span class="LC_filename">'
                   4957:             .$lastitem
                   4958:             .'</span>';
                   4959:     }
                   4960:     $output .=
                   4961:          '<br />'
1.822     bisitz   4962:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   4963:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   4964:         .'</form>'
                   4965:         .&Apache::lonmenu::constspaceform()
                   4966:         .'</div>';
1.921     bisitz   4967: 
                   4968:     return $output;
1.822     bisitz   4969: }
                   4970: 
1.60      matthew  4971: ###############################################
                   4972: ###############################################
                   4973: 
                   4974: =pod
                   4975: 
1.112     bowersj2 4976: =back
                   4977: 
1.549     albertel 4978: =head1 HTML Helpers
1.112     bowersj2 4979: 
                   4980: =over 4
                   4981: 
                   4982: =item * &bodytag()
1.60      matthew  4983: 
                   4984: Returns a uniform header for LON-CAPA web pages.
                   4985: 
                   4986: Inputs: 
                   4987: 
1.112     bowersj2 4988: =over 4
                   4989: 
                   4990: =item * $title, A title to be displayed on the page.
                   4991: 
                   4992: =item * $function, the current role (can be undef).
                   4993: 
                   4994: =item * $addentries, extra parameters for the <body> tag.
                   4995: 
                   4996: =item * $bodyonly, if defined, only return the <body> tag.
                   4997: 
                   4998: =item * $domain, if defined, force a given domain.
                   4999: 
                   5000: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5001:             text interface only)
1.60      matthew  5002: 
1.814     bisitz   5003: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5004:                      navigational links
1.317     albertel 5005: 
1.338     albertel 5006: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5007: 
1.1075.2.12  raeburn  5008: =item * $no_inline_link, if true and in remote mode, don't show the
                   5009:          'Switch To Inline Menu' link
                   5010: 
1.460     albertel 5011: =item * $args, optional argument valid values are
                   5012:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 5013:             inherit_jsmath -> when creating popup window in a page,
                   5014:                               should it have jsmath forced on by the
                   5015:                               current page
1.460     albertel 5016: 
1.1075.2.15  raeburn  5017: =item * $advtoolsref, optional argument, ref to an array containing
                   5018:             inlineremote items to be added in "Functions" menu below
                   5019:             breadcrumbs.
                   5020: 
1.112     bowersj2 5021: =back
                   5022: 
1.60      matthew  5023: Returns: A uniform header for LON-CAPA web pages.  
                   5024: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5025: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5026: other decorations will be returned.
                   5027: 
                   5028: =cut
                   5029: 
1.54      www      5030: sub bodytag {
1.831     bisitz   5031:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15  raeburn  5032:         $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339     albertel 5033: 
1.954     raeburn  5034:     my $public;
                   5035:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5036:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5037:         $public = 1;
                   5038:     }
1.460     albertel 5039:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339     albertel 5040: 
1.183     matthew  5041:     $function = &get_users_function() if (!$function);
1.339     albertel 5042:     my $img =    &designparm($function.'.img',$domain);
                   5043:     my $font =   &designparm($function.'.font',$domain);
                   5044:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5045: 
1.803     bisitz   5046:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5047: 		   'bgcolor' => $pgbg,
1.339     albertel 5048: 		   'text'    => $font,
                   5049:                    'alink'   => &designparm($function.'.alink',$domain),
                   5050: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5051: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5052:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5053: 
1.63      www      5054:  # role and realm
1.378     raeburn  5055:     my ($role,$realm) = split(/\./,$env{'request.role'},2);
                   5056:     if ($role  eq 'ca') {
1.479     albertel 5057:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5058:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5059:     } 
1.55      www      5060: # realm
1.258     albertel 5061:     if ($env{'request.course.id'}) {
1.378     raeburn  5062:         if ($env{'request.role'} !~ /^cr/) {
                   5063:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5064:         }
1.898     raeburn  5065:         if ($env{'request.course.sec'}) {
                   5066:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5067:         }   
1.359     albertel 5068: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5069:     } else {
                   5070:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5071:     }
1.433     albertel 5072: 
1.359     albertel 5073:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5074: 
1.438     albertel 5075:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5076: 
1.101     www      5077: # construct main body tag
1.359     albertel 5078:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 5079: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 5080: 
1.1075.2.38  raeburn  5081:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5082: 
                   5083:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5084:         return $bodytag;
1.1075.2.38  raeburn  5085:     }
1.359     albertel 5086: 
1.954     raeburn  5087:     if ($public) {
1.433     albertel 5088: 	undef($role);
                   5089:     }
1.359     albertel 5090:     
1.762     bisitz   5091:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5092:     #
                   5093:     # Extra info if you are the DC
                   5094:     my $dc_info = '';
                   5095:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5096:                         $env{'course.'.$env{'request.course.id'}.
                   5097:                                  '.domain'}.'/'})) {
                   5098:         my $cid = $env{'request.course.id'};
1.917     raeburn  5099:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5100:         $dc_info =~ s/\s+$//;
1.359     albertel 5101:     }
                   5102: 
1.898     raeburn  5103:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.903     droeschl 5104: 
1.1075.2.13  raeburn  5105:     if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5106: 
1.1075.2.38  raeburn  5107: 
                   5108: 
1.1075.2.21  raeburn  5109:     my $funclist;
                   5110:     if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
                   5111:         $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions(), 'start')."\n".
                   5112:                     Apache::lonmenu::serverform();
                   5113:         my $forbodytag;
                   5114:         &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5115:                                             $forcereg,$args->{'group'},
                   5116:                                             $args->{'bread_crumbs'},
                   5117:                                             $advtoolsref,'',\$forbodytag);
                   5118:         unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5119:             $funclist = $forbodytag;
                   5120:         }
                   5121:     } else {
1.903     droeschl 5122: 
                   5123:         #    if ($env{'request.state'} eq 'construct') {
                   5124:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5125:         #    }
                   5126: 
1.1075.2.38  raeburn  5127:         $bodytag .= Apache::lonhtmlcommon::scripttag(
                   5128:             Apache::lonmenu::utilityfunctions(), 'start');
1.359     albertel 5129: 
1.1075.2.38  raeburn  5130:         my ($left,$right) = Apache::lonmenu::primary_menu();
1.1075.2.2  raeburn  5131: 
1.916     droeschl 5132:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22  raeburn  5133:             if ($dc_info) {
                   5134:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1  raeburn  5135:             }
1.1075.2.38  raeburn  5136:             $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.1075.2.22  raeburn  5137:                            <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5138:             return $bodytag;
                   5139:         }
1.894     droeschl 5140: 
1.927     raeburn  5141:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1075.2.38  raeburn  5142:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5143:         }
1.916     droeschl 5144: 
1.1075.2.38  raeburn  5145:         $bodytag .= $right;
1.852     droeschl 5146: 
1.917     raeburn  5147:         if ($dc_info) {
                   5148:             $dc_info = &dc_courseid_toggle($dc_info);
                   5149:         }
                   5150:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5151: 
1.903     droeschl 5152:         #don't show menus for public users
1.954     raeburn  5153:         if (!$public){
1.903     droeschl 5154:             $bodytag .= Apache::lonmenu::secondary_menu();
                   5155:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5156:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5157:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5158:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5159:                                 $args->{'bread_crumbs'});
                   5160:             } elsif ($forcereg) { 
1.1075.2.22  raeburn  5161:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                   5162:                                                             $args->{'group'});
1.1075.2.15  raeburn  5163:             } else {
1.1075.2.21  raeburn  5164:                 my $forbodytag;
                   5165:                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5166:                                                     $forcereg,$args->{'group'},
                   5167:                                                     $args->{'bread_crumbs'},
                   5168:                                                     $advtoolsref,'',\$forbodytag);
                   5169:                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5170:                     $bodytag .= $forbodytag;
                   5171:                 }
1.920     raeburn  5172:             }
1.903     droeschl 5173:         }else{
                   5174:             # this is to seperate menu from content when there's no secondary
                   5175:             # menu. Especially needed for public accessible ressources.
                   5176:             $bodytag .= '<hr style="clear:both" />';
                   5177:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5178:         }
1.903     droeschl 5179: 
1.235     raeburn  5180:         return $bodytag;
1.1075.2.12  raeburn  5181:     }
                   5182: 
                   5183: #
                   5184: # Top frame rendering, Remote is up
                   5185: #
                   5186: 
                   5187:     my $imgsrc = $img;
                   5188:     if ($img =~ /^\/adm/) {
                   5189:         $imgsrc = &lonhttpdurl($img);
                   5190:     }
                   5191:     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
                   5192: 
                   5193:     # Explicit link to get inline menu
                   5194:     my $menu= ($no_inline_link?''
                   5195:                :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
                   5196: 
                   5197:     if ($dc_info) {
                   5198:         $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
                   5199:     }
                   5200: 
1.1075.2.38  raeburn  5201:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
                   5202:     unless ($public) {
                   5203:         $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
                   5204:                                 undef,'LC_menubuttons_link');
                   5205:     }
                   5206: 
1.1075.2.12  raeburn  5207:     unless ($env{'form.inhibitmenu'}) {
                   5208:         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.1075.2.38  raeburn  5209:                        <ol class="LC_primary_menu LC_floatright LC_right">
1.1075.2.12  raeburn  5210:                        <li>$menu</li>
                   5211:                        </ol><div id="LC_realm"> $realm $dc_info</div>|;
                   5212:     }
1.1075.2.13  raeburn  5213:     if ($env{'request.state'} eq 'construct') {
                   5214:         if (!$public){
                   5215:             if ($env{'request.state'} eq 'construct') {
                   5216:                 $funclist = &Apache::lonhtmlcommon::scripttag(
                   5217:                                 &Apache::lonmenu::utilityfunctions(), 'start').
                   5218:                             &Apache::lonhtmlcommon::scripttag('','end').
                   5219:                             &Apache::lonmenu::innerregister($forcereg,
                   5220:                                                             $args->{'bread_crumbs'});
                   5221:             }
                   5222:         }
                   5223:     }
1.1075.2.21  raeburn  5224:     return $bodytag."\n".$funclist;
1.182     matthew  5225: }
                   5226: 
1.917     raeburn  5227: sub dc_courseid_toggle {
                   5228:     my ($dc_info) = @_;
1.980     raeburn  5229:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5230:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5231:            &mt('(More ...)').'</a></span>'.
                   5232:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5233: }
                   5234: 
1.330     albertel 5235: sub make_attr_string {
                   5236:     my ($register,$attr_ref) = @_;
                   5237: 
                   5238:     if ($attr_ref && !ref($attr_ref)) {
                   5239: 	die("addentries Must be a hash ref ".
                   5240: 	    join(':',caller(1))." ".
                   5241: 	    join(':',caller(0))." ");
                   5242:     }
                   5243: 
                   5244:     if ($register) {
1.339     albertel 5245: 	my ($on_load,$on_unload);
                   5246: 	foreach my $key (keys(%{$attr_ref})) {
                   5247: 	    if      (lc($key) eq 'onload') {
                   5248: 		$on_load.=$attr_ref->{$key}.';';
                   5249: 		delete($attr_ref->{$key});
                   5250: 
                   5251: 	    } elsif (lc($key) eq 'onunload') {
                   5252: 		$on_unload.=$attr_ref->{$key}.';';
                   5253: 		delete($attr_ref->{$key});
                   5254: 	    }
                   5255: 	}
1.1075.2.12  raeburn  5256:         if ($env{'environment.remote'} eq 'on') {
                   5257:             $attr_ref->{'onload'}  =
                   5258:                 &Apache::lonmenu::loadevents().  $on_load;
                   5259:             $attr_ref->{'onunload'}=
                   5260:                 &Apache::lonmenu::unloadevents().$on_unload;
                   5261:         } else {  
                   5262: 	    $attr_ref->{'onload'}  = $on_load;
                   5263: 	    $attr_ref->{'onunload'}= $on_unload;
                   5264:         }
1.330     albertel 5265:     }
1.339     albertel 5266: 
1.330     albertel 5267:     my $attr_string;
                   5268:     foreach my $attr (keys(%$attr_ref)) {
                   5269: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5270:     }
                   5271:     return $attr_string;
                   5272: }
                   5273: 
                   5274: 
1.182     matthew  5275: ###############################################
1.251     albertel 5276: ###############################################
                   5277: 
                   5278: =pod
                   5279: 
                   5280: =item * &endbodytag()
                   5281: 
                   5282: Returns a uniform footer for LON-CAPA web pages.
                   5283: 
1.635     raeburn  5284: Inputs: 1 - optional reference to an args hash
                   5285: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5286: a 'Continue' link is not displayed if the page contains an
                   5287: internal redirect in the <head></head> section,
                   5288: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5289: 
                   5290: =cut
                   5291: 
                   5292: sub endbodytag {
1.635     raeburn  5293:     my ($args) = @_;
1.1075.2.6  raeburn  5294:     my $endbodytag;
                   5295:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5296:         $endbodytag='</body>';
                   5297:     }
1.269     albertel 5298:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 5299:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5300:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5301: 	    $endbodytag=
                   5302: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5303: 	        &mt('Continue').'</a>'.
                   5304: 	        $endbodytag;
                   5305:         }
1.315     albertel 5306:     }
1.251     albertel 5307:     return $endbodytag;
                   5308: }
                   5309: 
1.352     albertel 5310: =pod
                   5311: 
                   5312: =item * &standard_css()
                   5313: 
                   5314: Returns a style sheet
                   5315: 
                   5316: Inputs: (all optional)
                   5317:             domain         -> force to color decorate a page for a specific
                   5318:                                domain
                   5319:             function       -> force usage of a specific rolish color scheme
                   5320:             bgcolor        -> override the default page bgcolor
                   5321: 
                   5322: =cut
                   5323: 
1.343     albertel 5324: sub standard_css {
1.345     albertel 5325:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5326:     $function  = &get_users_function() if (!$function);
                   5327:     my $img    = &designparm($function.'.img',   $domain);
                   5328:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5329:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5330:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5331: #second colour for later usage
1.345     albertel 5332:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5333:     my $pgbg_or_bgcolor =
                   5334: 	         $bgcolor ||
1.352     albertel 5335: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5336:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5337:     my $alink  = &designparm($function.'.alink', $domain);
                   5338:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5339:     my $link   = &designparm($function.'.link',  $domain);
                   5340: 
1.602     albertel 5341:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5342:     my $mono                 = 'monospace';
1.850     bisitz   5343:     my $data_table_head      = $sidebg;
                   5344:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5345:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5346:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5347:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5348:     my $mail_new             = '#FFBB77';
                   5349:     my $mail_new_hover       = '#DD9955';
                   5350:     my $mail_read            = '#BBBB77';
                   5351:     my $mail_read_hover      = '#999944';
                   5352:     my $mail_replied         = '#AAAA88';
                   5353:     my $mail_replied_hover   = '#888855';
                   5354:     my $mail_other           = '#99BBBB';
                   5355:     my $mail_other_hover     = '#669999';
1.391     albertel 5356:     my $table_header         = '#DDDDDD';
1.489     raeburn  5357:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5358:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5359:     my $button_hover         = '#BF2317';
1.392     albertel 5360: 
1.608     albertel 5361:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5362:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5363:                                              : '0 3px 0 4px';
1.448     albertel 5364: 
1.523     albertel 5365: 
1.343     albertel 5366:     return <<END;
1.947     droeschl 5367: 
                   5368: /* needed for iframe to allow 100% height in FF */
                   5369: body, html { 
                   5370:     margin: 0;
                   5371:     padding: 0 0.5%;
                   5372:     height: 99%; /* to avoid scrollbars */
                   5373: }
                   5374: 
1.795     www      5375: body {
1.911     bisitz   5376:   font-family: $sans;
                   5377:   line-height:130%;
                   5378:   font-size:0.83em;
                   5379:   color:$font;
1.795     www      5380: }
                   5381: 
1.959     onken    5382: a:focus,
                   5383: a:focus img {
1.795     www      5384:   color: red;
                   5385: }
1.698     harmsja  5386: 
1.911     bisitz   5387: form, .inline {
                   5388:   display: inline;
1.795     www      5389: }
1.721     harmsja  5390: 
1.795     www      5391: .LC_right {
1.911     bisitz   5392:   text-align:right;
1.795     www      5393: }
                   5394: 
                   5395: .LC_middle {
1.911     bisitz   5396:   vertical-align:middle;
1.795     www      5397: }
1.721     harmsja  5398: 
1.1075.2.38  raeburn  5399: .LC_floatleft {
                   5400:   float: left;
                   5401: }
                   5402: 
                   5403: .LC_floatright {
                   5404:   float: right;
                   5405: }
                   5406: 
1.911     bisitz   5407: .LC_400Box {
                   5408:   width:400px;
                   5409: }
1.721     harmsja  5410: 
1.947     droeschl 5411: .LC_iframecontainer {
                   5412:     width: 98%;
                   5413:     margin: 0;
                   5414:     position: fixed;
                   5415:     top: 8.5em;
                   5416:     bottom: 0;
                   5417: }
                   5418: 
                   5419: .LC_iframecontainer iframe{
                   5420:     border: none;
                   5421:     width: 100%;
                   5422:     height: 100%;
                   5423: }
                   5424: 
1.778     bisitz   5425: .LC_filename {
                   5426:   font-family: $mono;
                   5427:   white-space:pre;
1.921     bisitz   5428:   font-size: 120%;
1.778     bisitz   5429: }
                   5430: 
                   5431: .LC_fileicon {
                   5432:   border: none;
                   5433:   height: 1.3em;
                   5434:   vertical-align: text-bottom;
                   5435:   margin-right: 0.3em;
                   5436:   text-decoration:none;
                   5437: }
                   5438: 
1.1008    www      5439: .LC_setting {
                   5440:   text-decoration:underline;
                   5441: }
                   5442: 
1.350     albertel 5443: .LC_error {
                   5444:   color: red;
                   5445: }
1.795     www      5446: 
1.1075.2.15  raeburn  5447: .LC_warning {
                   5448:   color: darkorange;
                   5449: }
                   5450: 
1.457     albertel 5451: .LC_diff_removed {
1.733     bisitz   5452:   color: red;
1.394     albertel 5453: }
1.532     albertel 5454: 
                   5455: .LC_info,
1.457     albertel 5456: .LC_success,
                   5457: .LC_diff_added {
1.350     albertel 5458:   color: green;
                   5459: }
1.795     www      5460: 
1.802     bisitz   5461: div.LC_confirm_box {
                   5462:   background-color: #FAFAFA;
                   5463:   border: 1px solid $lg_border_color;
                   5464:   margin-right: 0;
                   5465:   padding: 5px;
                   5466: }
                   5467: 
                   5468: div.LC_confirm_box .LC_error img,
                   5469: div.LC_confirm_box .LC_success img {
                   5470:   vertical-align: middle;
                   5471: }
                   5472: 
1.440     albertel 5473: .LC_icon {
1.771     droeschl 5474:   border: none;
1.790     droeschl 5475:   vertical-align: middle;
1.771     droeschl 5476: }
                   5477: 
1.543     albertel 5478: .LC_docs_spacer {
                   5479:   width: 25px;
                   5480:   height: 1px;
1.771     droeschl 5481:   border: none;
1.543     albertel 5482: }
1.346     albertel 5483: 
1.532     albertel 5484: .LC_internal_info {
1.735     bisitz   5485:   color: #999999;
1.532     albertel 5486: }
                   5487: 
1.794     www      5488: .LC_discussion {
1.1050    www      5489:   background: $data_table_dark;
1.911     bisitz   5490:   border: 1px solid black;
                   5491:   margin: 2px;
1.794     www      5492: }
                   5493: 
                   5494: .LC_disc_action_left {
1.1050    www      5495:   background: $sidebg;
1.911     bisitz   5496:   text-align: left;
1.1050    www      5497:   padding: 4px;
                   5498:   margin: 2px;
1.794     www      5499: }
                   5500: 
                   5501: .LC_disc_action_right {
1.1050    www      5502:   background: $sidebg;
1.911     bisitz   5503:   text-align: right;
1.1050    www      5504:   padding: 4px;
                   5505:   margin: 2px;
1.794     www      5506: }
                   5507: 
                   5508: .LC_disc_new_item {
1.911     bisitz   5509:   background: white;
                   5510:   border: 2px solid red;
1.1050    www      5511:   margin: 4px;
                   5512:   padding: 4px;
1.794     www      5513: }
                   5514: 
                   5515: .LC_disc_old_item {
1.911     bisitz   5516:   background: white;
1.1050    www      5517:   margin: 4px;
                   5518:   padding: 4px;
1.794     www      5519: }
                   5520: 
1.458     albertel 5521: table.LC_pastsubmission {
                   5522:   border: 1px solid black;
                   5523:   margin: 2px;
                   5524: }
                   5525: 
1.924     bisitz   5526: table#LC_menubuttons {
1.345     albertel 5527:   width: 100%;
                   5528:   background: $pgbg;
1.392     albertel 5529:   border: 2px;
1.402     albertel 5530:   border-collapse: separate;
1.803     bisitz   5531:   padding: 0;
1.345     albertel 5532: }
1.392     albertel 5533: 
1.801     tempelho 5534: table#LC_title_bar a {
                   5535:   color: $fontmenu;
                   5536: }
1.836     bisitz   5537: 
1.807     droeschl 5538: table#LC_title_bar {
1.819     tempelho 5539:   clear: both;
1.836     bisitz   5540:   display: none;
1.807     droeschl 5541: }
                   5542: 
1.795     www      5543: table#LC_title_bar,
1.933     droeschl 5544: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5545: table#LC_title_bar.LC_with_remote {
1.359     albertel 5546:   width: 100%;
1.392     albertel 5547:   border-color: $pgbg;
                   5548:   border-style: solid;
                   5549:   border-width: $border;
1.379     albertel 5550:   background: $pgbg;
1.801     tempelho 5551:   color: $fontmenu;
1.392     albertel 5552:   border-collapse: collapse;
1.803     bisitz   5553:   padding: 0;
1.819     tempelho 5554:   margin: 0;
1.359     albertel 5555: }
1.795     www      5556: 
1.933     droeschl 5557: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5558:     margin: 0;
                   5559:     padding: 0;
1.933     droeschl 5560:     position: relative;
                   5561:     list-style: none;
1.913     droeschl 5562: }
1.933     droeschl 5563: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5564:     display: inline;
                   5565: }
1.933     droeschl 5566: 
                   5567: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5568:     padding: 0;
1.933     droeschl 5569:     margin: 0;
                   5570:     float: left;
1.913     droeschl 5571: }
1.933     droeschl 5572: .LC_breadcrumb_tools_tools {
                   5573:     padding: 0;
                   5574:     margin: 0;
1.913     droeschl 5575:     float: right;
                   5576: }
                   5577: 
1.359     albertel 5578: table#LC_title_bar td {
                   5579:   background: $tabbg;
                   5580: }
1.795     www      5581: 
1.911     bisitz   5582: table#LC_menubuttons img {
1.803     bisitz   5583:   border: none;
1.346     albertel 5584: }
1.795     www      5585: 
1.842     droeschl 5586: .LC_breadcrumbs_component {
1.911     bisitz   5587:   float: right;
                   5588:   margin: 0 1em;
1.357     albertel 5589: }
1.842     droeschl 5590: .LC_breadcrumbs_component img {
1.911     bisitz   5591:   vertical-align: middle;
1.777     tempelho 5592: }
1.795     www      5593: 
1.383     albertel 5594: td.LC_table_cell_checkbox {
                   5595:   text-align: center;
                   5596: }
1.795     www      5597: 
                   5598: .LC_fontsize_small {
1.911     bisitz   5599:   font-size: 70%;
1.705     tempelho 5600: }
                   5601: 
1.844     bisitz   5602: #LC_breadcrumbs {
1.911     bisitz   5603:   clear:both;
                   5604:   background: $sidebg;
                   5605:   border-bottom: 1px solid $lg_border_color;
                   5606:   line-height: 2.5em;
1.933     droeschl 5607:   overflow: hidden;
1.911     bisitz   5608:   margin: 0;
                   5609:   padding: 0;
1.995     raeburn  5610:   text-align: left;
1.819     tempelho 5611: }
1.862     bisitz   5612: 
1.1075.2.16  raeburn  5613: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   5614:   clear:both;
                   5615:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5616:   border: 1px solid $sidebg;
1.1075.2.16  raeburn  5617:   margin: 0 0 10px 0;
1.966     bisitz   5618:   padding: 3px;
1.995     raeburn  5619:   text-align: left;
1.822     bisitz   5620: }
                   5621: 
1.795     www      5622: .LC_fontsize_medium {
1.911     bisitz   5623:   font-size: 85%;
1.705     tempelho 5624: }
                   5625: 
1.795     www      5626: .LC_fontsize_large {
1.911     bisitz   5627:   font-size: 120%;
1.705     tempelho 5628: }
                   5629: 
1.346     albertel 5630: .LC_menubuttons_inline_text {
                   5631:   color: $font;
1.698     harmsja  5632:   font-size: 90%;
1.701     harmsja  5633:   padding-left:3px;
1.346     albertel 5634: }
                   5635: 
1.934     droeschl 5636: .LC_menubuttons_inline_text img{
                   5637:   vertical-align: middle;
                   5638: }
                   5639: 
1.1051    www      5640: li.LC_menubuttons_inline_text img {
1.951     onken    5641:   cursor:pointer;
1.1002    droeschl 5642:   text-decoration: none;
1.951     onken    5643: }
                   5644: 
1.526     www      5645: .LC_menubuttons_link {
                   5646:   text-decoration: none;
                   5647: }
1.795     www      5648: 
1.522     albertel 5649: .LC_menubuttons_category {
1.521     www      5650:   color: $font;
1.526     www      5651:   background: $pgbg;
1.521     www      5652:   font-size: larger;
                   5653:   font-weight: bold;
                   5654: }
                   5655: 
1.346     albertel 5656: td.LC_menubuttons_text {
1.911     bisitz   5657:   color: $font;
1.346     albertel 5658: }
1.706     harmsja  5659: 
1.346     albertel 5660: .LC_current_location {
                   5661:   background: $tabbg;
                   5662: }
1.795     www      5663: 
1.938     bisitz   5664: table.LC_data_table {
1.347     albertel 5665:   border: 1px solid #000000;
1.402     albertel 5666:   border-collapse: separate;
1.426     albertel 5667:   border-spacing: 1px;
1.610     albertel 5668:   background: $pgbg;
1.347     albertel 5669: }
1.795     www      5670: 
1.422     albertel 5671: .LC_data_table_dense {
                   5672:   font-size: small;
                   5673: }
1.795     www      5674: 
1.507     raeburn  5675: table.LC_nested_outer {
                   5676:   border: 1px solid #000000;
1.589     raeburn  5677:   border-collapse: collapse;
1.803     bisitz   5678:   border-spacing: 0;
1.507     raeburn  5679:   width: 100%;
                   5680: }
1.795     www      5681: 
1.879     raeburn  5682: table.LC_innerpickbox,
1.507     raeburn  5683: table.LC_nested {
1.803     bisitz   5684:   border: none;
1.589     raeburn  5685:   border-collapse: collapse;
1.803     bisitz   5686:   border-spacing: 0;
1.507     raeburn  5687:   width: 100%;
                   5688: }
1.795     www      5689: 
1.911     bisitz   5690: table.LC_data_table tr th,
                   5691: table.LC_calendar tr th,
1.879     raeburn  5692: table.LC_prior_tries tr th,
                   5693: table.LC_innerpickbox tr th {
1.349     albertel 5694:   font-weight: bold;
                   5695:   background-color: $data_table_head;
1.801     tempelho 5696:   color:$fontmenu;
1.701     harmsja  5697:   font-size:90%;
1.347     albertel 5698: }
1.795     www      5699: 
1.879     raeburn  5700: table.LC_innerpickbox tr th,
                   5701: table.LC_innerpickbox tr td {
                   5702:   vertical-align: top;
                   5703: }
                   5704: 
1.711     raeburn  5705: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5706:   background-color: #CCCCCC;
1.711     raeburn  5707:   font-weight: bold;
                   5708:   text-align: left;
                   5709: }
1.795     www      5710: 
1.912     bisitz   5711: table.LC_data_table tr.LC_odd_row > td {
                   5712:   background-color: $data_table_light;
                   5713:   padding: 2px;
                   5714:   vertical-align: top;
                   5715: }
                   5716: 
1.809     bisitz   5717: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5718:   background-color: $data_table_light;
1.912     bisitz   5719:   vertical-align: top;
                   5720: }
                   5721: 
                   5722: table.LC_data_table tr.LC_even_row > td {
                   5723:   background-color: $data_table_dark;
1.425     albertel 5724:   padding: 2px;
1.900     bisitz   5725:   vertical-align: top;
1.347     albertel 5726: }
1.795     www      5727: 
1.809     bisitz   5728: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5729:   background-color: $data_table_dark;
1.900     bisitz   5730:   vertical-align: top;
1.347     albertel 5731: }
1.795     www      5732: 
1.425     albertel 5733: table.LC_data_table tr.LC_data_table_highlight td {
                   5734:   background-color: $data_table_darker;
                   5735: }
1.795     www      5736: 
1.639     raeburn  5737: table.LC_data_table tr td.LC_leftcol_header {
                   5738:   background-color: $data_table_head;
                   5739:   font-weight: bold;
                   5740: }
1.795     www      5741: 
1.451     albertel 5742: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5743: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5744:   font-weight: bold;
                   5745:   font-style: italic;
                   5746:   text-align: center;
                   5747:   padding: 8px;
1.347     albertel 5748: }
1.795     www      5749: 
1.1075.2.30  raeburn  5750: table.LC_data_table tr.LC_empty_row td,
                   5751: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   5752:   background-color: $sidebg;
                   5753: }
                   5754: 
                   5755: table.LC_nested tr.LC_empty_row td {
                   5756:   background-color: #FFFFFF;
                   5757: }
                   5758: 
1.890     droeschl 5759: table.LC_caption {
                   5760: }
                   5761: 
1.507     raeburn  5762: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5763:   padding: 4ex
                   5764: }
1.795     www      5765: 
1.507     raeburn  5766: table.LC_nested_outer tr th {
                   5767:   font-weight: bold;
1.801     tempelho 5768:   color:$fontmenu;
1.507     raeburn  5769:   background-color: $data_table_head;
1.701     harmsja  5770:   font-size: small;
1.507     raeburn  5771:   border-bottom: 1px solid #000000;
                   5772: }
1.795     www      5773: 
1.507     raeburn  5774: table.LC_nested_outer tr td.LC_subheader {
                   5775:   background-color: $data_table_head;
                   5776:   font-weight: bold;
                   5777:   font-size: small;
                   5778:   border-bottom: 1px solid #000000;
                   5779:   text-align: right;
1.451     albertel 5780: }
1.795     www      5781: 
1.507     raeburn  5782: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5783:   background-color: #CCCCCC;
1.451     albertel 5784:   font-weight: bold;
                   5785:   font-size: small;
1.507     raeburn  5786:   text-align: center;
                   5787: }
1.795     www      5788: 
1.589     raeburn  5789: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5790: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5791:   text-align: left;
1.451     albertel 5792: }
1.795     www      5793: 
1.507     raeburn  5794: table.LC_nested td {
1.735     bisitz   5795:   background-color: #FFFFFF;
1.451     albertel 5796:   font-size: small;
1.507     raeburn  5797: }
1.795     www      5798: 
1.507     raeburn  5799: table.LC_nested_outer tr th.LC_right_item,
                   5800: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5801: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5802: table.LC_nested tr td.LC_right_item {
1.451     albertel 5803:   text-align: right;
                   5804: }
                   5805: 
1.507     raeburn  5806: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5807:   background-color: #EEEEEE;
1.451     albertel 5808: }
                   5809: 
1.473     raeburn  5810: table.LC_createuser {
                   5811: }
                   5812: 
                   5813: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5814:   font-size: small;
1.473     raeburn  5815: }
                   5816: 
                   5817: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5818:   background-color: #CCCCCC;
1.473     raeburn  5819:   font-weight: bold;
                   5820:   text-align: center;
                   5821: }
                   5822: 
1.349     albertel 5823: table.LC_calendar {
                   5824:   border: 1px solid #000000;
                   5825:   border-collapse: collapse;
1.917     raeburn  5826:   width: 98%;
1.349     albertel 5827: }
1.795     www      5828: 
1.349     albertel 5829: table.LC_calendar_pickdate {
                   5830:   font-size: xx-small;
                   5831: }
1.795     www      5832: 
1.349     albertel 5833: table.LC_calendar tr td {
                   5834:   border: 1px solid #000000;
                   5835:   vertical-align: top;
1.917     raeburn  5836:   width: 14%;
1.349     albertel 5837: }
1.795     www      5838: 
1.349     albertel 5839: table.LC_calendar tr td.LC_calendar_day_empty {
                   5840:   background-color: $data_table_dark;
                   5841: }
1.795     www      5842: 
1.779     bisitz   5843: table.LC_calendar tr td.LC_calendar_day_current {
                   5844:   background-color: $data_table_highlight;
1.777     tempelho 5845: }
1.795     www      5846: 
1.938     bisitz   5847: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5848:   background-color: $mail_new;
                   5849: }
1.795     www      5850: 
1.938     bisitz   5851: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5852:   background-color: $mail_new_hover;
                   5853: }
1.795     www      5854: 
1.938     bisitz   5855: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5856:   background-color: $mail_read;
                   5857: }
1.795     www      5858: 
1.938     bisitz   5859: /*
                   5860: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5861:   background-color: $mail_read_hover;
                   5862: }
1.938     bisitz   5863: */
1.795     www      5864: 
1.938     bisitz   5865: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5866:   background-color: $mail_replied;
                   5867: }
1.795     www      5868: 
1.938     bisitz   5869: /*
                   5870: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5871:   background-color: $mail_replied_hover;
                   5872: }
1.938     bisitz   5873: */
1.795     www      5874: 
1.938     bisitz   5875: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5876:   background-color: $mail_other;
                   5877: }
1.795     www      5878: 
1.938     bisitz   5879: /*
                   5880: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5881:   background-color: $mail_other_hover;
                   5882: }
1.938     bisitz   5883: */
1.494     raeburn  5884: 
1.777     tempelho 5885: table.LC_data_table tr > td.LC_browser_file,
                   5886: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5887:   background: #AAEE77;
1.389     albertel 5888: }
1.795     www      5889: 
1.777     tempelho 5890: table.LC_data_table tr > td.LC_browser_file_locked,
                   5891: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5892:   background: #FFAA99;
1.387     albertel 5893: }
1.795     www      5894: 
1.777     tempelho 5895: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5896:   background: #888888;
1.779     bisitz   5897: }
1.795     www      5898: 
1.777     tempelho 5899: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5900: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5901:   background: #F8F866;
1.777     tempelho 5902: }
1.795     www      5903: 
1.696     bisitz   5904: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5905:   background: #E0E8FF;
1.387     albertel 5906: }
1.696     bisitz   5907: 
1.707     bisitz   5908: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5909:   /* background: #77FF77; */
1.707     bisitz   5910: }
1.795     www      5911: 
1.707     bisitz   5912: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5913:   border-right: 8px solid #FFFF77;
1.707     bisitz   5914: }
1.795     www      5915: 
1.707     bisitz   5916: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5917:   border-right: 8px solid #FFAA77;
1.707     bisitz   5918: }
1.795     www      5919: 
1.707     bisitz   5920: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5921:   border-right: 8px solid #FF7777;
1.707     bisitz   5922: }
1.795     www      5923: 
1.707     bisitz   5924: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5925:   border-right: 8px solid #AAFF77;
1.707     bisitz   5926: }
1.795     www      5927: 
1.707     bisitz   5928: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5929:   border-right: 8px solid #11CC55;
1.707     bisitz   5930: }
                   5931: 
1.388     albertel 5932: span.LC_current_location {
1.701     harmsja  5933:   font-size:larger;
1.388     albertel 5934:   background: $pgbg;
                   5935: }
1.387     albertel 5936: 
1.1029    www      5937: span.LC_current_nav_location {
                   5938:   font-weight:bold;
                   5939:   background: $sidebg;
                   5940: }
                   5941: 
1.395     albertel 5942: span.LC_parm_menu_item {
                   5943:   font-size: larger;
                   5944: }
1.795     www      5945: 
1.395     albertel 5946: span.LC_parm_scope_all {
                   5947:   color: red;
                   5948: }
1.795     www      5949: 
1.395     albertel 5950: span.LC_parm_scope_folder {
                   5951:   color: green;
                   5952: }
1.795     www      5953: 
1.395     albertel 5954: span.LC_parm_scope_resource {
                   5955:   color: orange;
                   5956: }
1.795     www      5957: 
1.395     albertel 5958: span.LC_parm_part {
                   5959:   color: blue;
                   5960: }
1.795     www      5961: 
1.911     bisitz   5962: span.LC_parm_folder,
                   5963: span.LC_parm_symb {
1.395     albertel 5964:   font-size: x-small;
                   5965:   font-family: $mono;
                   5966:   color: #AAAAAA;
                   5967: }
                   5968: 
1.977     bisitz   5969: ul.LC_parm_parmlist li {
                   5970:   display: inline-block;
                   5971:   padding: 0.3em 0.8em;
                   5972:   vertical-align: top;
                   5973:   width: 150px;
                   5974:   border-top:1px solid $lg_border_color;
                   5975: }
                   5976: 
1.795     www      5977: td.LC_parm_overview_level_menu,
                   5978: td.LC_parm_overview_map_menu,
                   5979: td.LC_parm_overview_parm_selectors,
                   5980: td.LC_parm_overview_restrictions  {
1.396     albertel 5981:   border: 1px solid black;
                   5982:   border-collapse: collapse;
                   5983: }
1.795     www      5984: 
1.396     albertel 5985: table.LC_parm_overview_restrictions td {
                   5986:   border-width: 1px 4px 1px 4px;
                   5987:   border-style: solid;
                   5988:   border-color: $pgbg;
                   5989:   text-align: center;
                   5990: }
1.795     www      5991: 
1.396     albertel 5992: table.LC_parm_overview_restrictions th {
                   5993:   background: $tabbg;
                   5994:   border-width: 1px 4px 1px 4px;
                   5995:   border-style: solid;
                   5996:   border-color: $pgbg;
                   5997: }
1.795     www      5998: 
1.398     albertel 5999: table#LC_helpmenu {
1.803     bisitz   6000:   border: none;
1.398     albertel 6001:   height: 55px;
1.803     bisitz   6002:   border-spacing: 0;
1.398     albertel 6003: }
                   6004: 
                   6005: table#LC_helpmenu fieldset legend {
                   6006:   font-size: larger;
                   6007: }
1.795     www      6008: 
1.397     albertel 6009: table#LC_helpmenu_links {
                   6010:   width: 100%;
                   6011:   border: 1px solid black;
                   6012:   background: $pgbg;
1.803     bisitz   6013:   padding: 0;
1.397     albertel 6014:   border-spacing: 1px;
                   6015: }
1.795     www      6016: 
1.397     albertel 6017: table#LC_helpmenu_links tr td {
                   6018:   padding: 1px;
                   6019:   background: $tabbg;
1.399     albertel 6020:   text-align: center;
                   6021:   font-weight: bold;
1.397     albertel 6022: }
1.396     albertel 6023: 
1.795     www      6024: table#LC_helpmenu_links a:link,
                   6025: table#LC_helpmenu_links a:visited,
1.397     albertel 6026: table#LC_helpmenu_links a:active {
                   6027:   text-decoration: none;
                   6028:   color: $font;
                   6029: }
1.795     www      6030: 
1.397     albertel 6031: table#LC_helpmenu_links a:hover {
                   6032:   text-decoration: underline;
                   6033:   color: $vlink;
                   6034: }
1.396     albertel 6035: 
1.417     albertel 6036: .LC_chrt_popup_exists {
                   6037:   border: 1px solid #339933;
                   6038:   margin: -1px;
                   6039: }
1.795     www      6040: 
1.417     albertel 6041: .LC_chrt_popup_up {
                   6042:   border: 1px solid yellow;
                   6043:   margin: -1px;
                   6044: }
1.795     www      6045: 
1.417     albertel 6046: .LC_chrt_popup {
                   6047:   border: 1px solid #8888FF;
                   6048:   background: #CCCCFF;
                   6049: }
1.795     www      6050: 
1.421     albertel 6051: table.LC_pick_box {
                   6052:   border-collapse: separate;
                   6053:   background: white;
                   6054:   border: 1px solid black;
                   6055:   border-spacing: 1px;
                   6056: }
1.795     www      6057: 
1.421     albertel 6058: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6059:   background: $sidebg;
1.421     albertel 6060:   font-weight: bold;
1.900     bisitz   6061:   text-align: left;
1.740     bisitz   6062:   vertical-align: top;
1.421     albertel 6063:   width: 184px;
                   6064:   padding: 8px;
                   6065: }
1.795     www      6066: 
1.579     raeburn  6067: table.LC_pick_box td.LC_pick_box_value {
                   6068:   text-align: left;
                   6069:   padding: 8px;
                   6070: }
1.795     www      6071: 
1.579     raeburn  6072: table.LC_pick_box td.LC_pick_box_select {
                   6073:   text-align: left;
                   6074:   padding: 8px;
                   6075: }
1.795     www      6076: 
1.424     albertel 6077: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6078:   padding: 0;
1.421     albertel 6079:   height: 1px;
                   6080:   background: black;
                   6081: }
1.795     www      6082: 
1.421     albertel 6083: table.LC_pick_box td.LC_pick_box_submit {
                   6084:   text-align: right;
                   6085: }
1.795     www      6086: 
1.579     raeburn  6087: table.LC_pick_box td.LC_evenrow_value {
                   6088:   text-align: left;
                   6089:   padding: 8px;
                   6090:   background-color: $data_table_light;
                   6091: }
1.795     www      6092: 
1.579     raeburn  6093: table.LC_pick_box td.LC_oddrow_value {
                   6094:   text-align: left;
                   6095:   padding: 8px;
                   6096:   background-color: $data_table_light;
                   6097: }
1.795     www      6098: 
1.579     raeburn  6099: span.LC_helpform_receipt_cat {
                   6100:   font-weight: bold;
                   6101: }
1.795     www      6102: 
1.424     albertel 6103: table.LC_group_priv_box {
                   6104:   background: white;
                   6105:   border: 1px solid black;
                   6106:   border-spacing: 1px;
                   6107: }
1.795     www      6108: 
1.424     albertel 6109: table.LC_group_priv_box td.LC_pick_box_title {
                   6110:   background: $tabbg;
                   6111:   font-weight: bold;
                   6112:   text-align: right;
                   6113:   width: 184px;
                   6114: }
1.795     www      6115: 
1.424     albertel 6116: table.LC_group_priv_box td.LC_groups_fixed {
                   6117:   background: $data_table_light;
                   6118:   text-align: center;
                   6119: }
1.795     www      6120: 
1.424     albertel 6121: table.LC_group_priv_box td.LC_groups_optional {
                   6122:   background: $data_table_dark;
                   6123:   text-align: center;
                   6124: }
1.795     www      6125: 
1.424     albertel 6126: table.LC_group_priv_box td.LC_groups_functionality {
                   6127:   background: $data_table_darker;
                   6128:   text-align: center;
                   6129:   font-weight: bold;
                   6130: }
1.795     www      6131: 
1.424     albertel 6132: table.LC_group_priv td {
                   6133:   text-align: left;
1.803     bisitz   6134:   padding: 0;
1.424     albertel 6135: }
                   6136: 
                   6137: .LC_navbuttons {
                   6138:   margin: 2ex 0ex 2ex 0ex;
                   6139: }
1.795     www      6140: 
1.423     albertel 6141: .LC_topic_bar {
                   6142:   font-weight: bold;
                   6143:   background: $tabbg;
1.918     wenzelju 6144:   margin: 1em 0em 1em 2em;
1.805     bisitz   6145:   padding: 3px;
1.918     wenzelju 6146:   font-size: 1.2em;
1.423     albertel 6147: }
1.795     www      6148: 
1.423     albertel 6149: .LC_topic_bar span {
1.918     wenzelju 6150:   left: 0.5em;
                   6151:   position: absolute;
1.423     albertel 6152:   vertical-align: middle;
1.918     wenzelju 6153:   font-size: 1.2em;
1.423     albertel 6154: }
1.795     www      6155: 
1.423     albertel 6156: table.LC_course_group_status {
                   6157:   margin: 20px;
                   6158: }
1.795     www      6159: 
1.423     albertel 6160: table.LC_status_selector td {
                   6161:   vertical-align: top;
                   6162:   text-align: center;
1.424     albertel 6163:   padding: 4px;
                   6164: }
1.795     www      6165: 
1.599     albertel 6166: div.LC_feedback_link {
1.616     albertel 6167:   clear: both;
1.829     kalberla 6168:   background: $sidebg;
1.779     bisitz   6169:   width: 100%;
1.829     kalberla 6170:   padding-bottom: 10px;
                   6171:   border: 1px $tabbg solid;
1.833     kalberla 6172:   height: 22px;
                   6173:   line-height: 22px;
                   6174:   padding-top: 5px;
                   6175: }
                   6176: 
                   6177: div.LC_feedback_link img {
                   6178:   height: 22px;
1.867     kalberla 6179:   vertical-align:middle;
1.829     kalberla 6180: }
                   6181: 
1.911     bisitz   6182: div.LC_feedback_link a {
1.829     kalberla 6183:   text-decoration: none;
1.489     raeburn  6184: }
1.795     www      6185: 
1.867     kalberla 6186: div.LC_comblock {
1.911     bisitz   6187:   display:inline;
1.867     kalberla 6188:   color:$font;
                   6189:   font-size:90%;
                   6190: }
                   6191: 
                   6192: div.LC_feedback_link div.LC_comblock {
                   6193:   padding-left:5px;
                   6194: }
                   6195: 
                   6196: div.LC_feedback_link div.LC_comblock a {
                   6197:   color:$font;
                   6198: }
                   6199: 
1.489     raeburn  6200: span.LC_feedback_link {
1.858     bisitz   6201:   /* background: $feedback_link_bg; */
1.599     albertel 6202:   font-size: larger;
                   6203: }
1.795     www      6204: 
1.599     albertel 6205: span.LC_message_link {
1.858     bisitz   6206:   /* background: $feedback_link_bg; */
1.599     albertel 6207:   font-size: larger;
                   6208:   position: absolute;
                   6209:   right: 1em;
1.489     raeburn  6210: }
1.421     albertel 6211: 
1.515     albertel 6212: table.LC_prior_tries {
1.524     albertel 6213:   border: 1px solid #000000;
                   6214:   border-collapse: separate;
                   6215:   border-spacing: 1px;
1.515     albertel 6216: }
1.523     albertel 6217: 
1.515     albertel 6218: table.LC_prior_tries td {
1.524     albertel 6219:   padding: 2px;
1.515     albertel 6220: }
1.523     albertel 6221: 
                   6222: .LC_answer_correct {
1.795     www      6223:   background: lightgreen;
                   6224:   color: darkgreen;
                   6225:   padding: 6px;
1.523     albertel 6226: }
1.795     www      6227: 
1.523     albertel 6228: .LC_answer_charged_try {
1.797     www      6229:   background: #FFAAAA;
1.795     www      6230:   color: darkred;
                   6231:   padding: 6px;
1.523     albertel 6232: }
1.795     www      6233: 
1.779     bisitz   6234: .LC_answer_not_charged_try,
1.523     albertel 6235: .LC_answer_no_grade,
                   6236: .LC_answer_late {
1.795     www      6237:   background: lightyellow;
1.523     albertel 6238:   color: black;
1.795     www      6239:   padding: 6px;
1.523     albertel 6240: }
1.795     www      6241: 
1.523     albertel 6242: .LC_answer_previous {
1.795     www      6243:   background: lightblue;
                   6244:   color: darkblue;
                   6245:   padding: 6px;
1.523     albertel 6246: }
1.795     www      6247: 
1.779     bisitz   6248: .LC_answer_no_message {
1.777     tempelho 6249:   background: #FFFFFF;
                   6250:   color: black;
1.795     www      6251:   padding: 6px;
1.779     bisitz   6252: }
1.795     www      6253: 
1.779     bisitz   6254: .LC_answer_unknown {
                   6255:   background: orange;
                   6256:   color: black;
1.795     www      6257:   padding: 6px;
1.777     tempelho 6258: }
1.795     www      6259: 
1.529     albertel 6260: span.LC_prior_numerical,
                   6261: span.LC_prior_string,
                   6262: span.LC_prior_custom,
                   6263: span.LC_prior_reaction,
                   6264: span.LC_prior_math {
1.925     bisitz   6265:   font-family: $mono;
1.523     albertel 6266:   white-space: pre;
                   6267: }
                   6268: 
1.525     albertel 6269: span.LC_prior_string {
1.925     bisitz   6270:   font-family: $mono;
1.525     albertel 6271:   white-space: pre;
                   6272: }
                   6273: 
1.523     albertel 6274: table.LC_prior_option {
                   6275:   width: 100%;
                   6276:   border-collapse: collapse;
                   6277: }
1.795     www      6278: 
1.911     bisitz   6279: table.LC_prior_rank,
1.795     www      6280: table.LC_prior_match {
1.528     albertel 6281:   border-collapse: collapse;
                   6282: }
1.795     www      6283: 
1.528     albertel 6284: table.LC_prior_option tr td,
                   6285: table.LC_prior_rank tr td,
                   6286: table.LC_prior_match tr td {
1.524     albertel 6287:   border: 1px solid #000000;
1.515     albertel 6288: }
                   6289: 
1.855     bisitz   6290: .LC_nobreak {
1.544     albertel 6291:   white-space: nowrap;
1.519     raeburn  6292: }
                   6293: 
1.576     raeburn  6294: span.LC_cusr_emph {
                   6295:   font-style: italic;
                   6296: }
                   6297: 
1.633     raeburn  6298: span.LC_cusr_subheading {
                   6299:   font-weight: normal;
                   6300:   font-size: 85%;
                   6301: }
                   6302: 
1.861     bisitz   6303: div.LC_docs_entry_move {
1.859     bisitz   6304:   border: 1px solid #BBBBBB;
1.545     albertel 6305:   background: #DDDDDD;
1.861     bisitz   6306:   width: 22px;
1.859     bisitz   6307:   padding: 1px;
                   6308:   margin: 0;
1.545     albertel 6309: }
                   6310: 
1.861     bisitz   6311: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6312: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6313:   font-size: x-small;
                   6314: }
1.795     www      6315: 
1.861     bisitz   6316: .LC_docs_entry_parameter {
                   6317:   white-space: nowrap;
                   6318: }
                   6319: 
1.544     albertel 6320: .LC_docs_copy {
1.545     albertel 6321:   color: #000099;
1.544     albertel 6322: }
1.795     www      6323: 
1.544     albertel 6324: .LC_docs_cut {
1.545     albertel 6325:   color: #550044;
1.544     albertel 6326: }
1.795     www      6327: 
1.544     albertel 6328: .LC_docs_rename {
1.545     albertel 6329:   color: #009900;
1.544     albertel 6330: }
1.795     www      6331: 
1.544     albertel 6332: .LC_docs_remove {
1.545     albertel 6333:   color: #990000;
                   6334: }
                   6335: 
1.547     albertel 6336: .LC_docs_reinit_warn,
                   6337: .LC_docs_ext_edit {
                   6338:   font-size: x-small;
                   6339: }
                   6340: 
1.545     albertel 6341: table.LC_docs_adddocs td,
                   6342: table.LC_docs_adddocs th {
                   6343:   border: 1px solid #BBBBBB;
                   6344:   padding: 4px;
                   6345:   background: #DDDDDD;
1.543     albertel 6346: }
                   6347: 
1.584     albertel 6348: table.LC_sty_begin {
                   6349:   background: #BBFFBB;
                   6350: }
1.795     www      6351: 
1.584     albertel 6352: table.LC_sty_end {
                   6353:   background: #FFBBBB;
                   6354: }
                   6355: 
1.589     raeburn  6356: table.LC_double_column {
1.803     bisitz   6357:   border-width: 0;
1.589     raeburn  6358:   border-collapse: collapse;
                   6359:   width: 100%;
                   6360:   padding: 2px;
                   6361: }
                   6362: 
                   6363: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6364:   top: 2px;
1.589     raeburn  6365:   left: 2px;
                   6366:   width: 47%;
                   6367:   vertical-align: top;
                   6368: }
                   6369: 
                   6370: table.LC_double_column tr td.LC_right_col {
                   6371:   top: 2px;
1.779     bisitz   6372:   right: 2px;
1.589     raeburn  6373:   width: 47%;
                   6374:   vertical-align: top;
                   6375: }
                   6376: 
1.591     raeburn  6377: div.LC_left_float {
                   6378:   float: left;
                   6379:   padding-right: 5%;
1.597     albertel 6380:   padding-bottom: 4px;
1.591     raeburn  6381: }
                   6382: 
                   6383: div.LC_clear_float_header {
1.597     albertel 6384:   padding-bottom: 2px;
1.591     raeburn  6385: }
                   6386: 
                   6387: div.LC_clear_float_footer {
1.597     albertel 6388:   padding-top: 10px;
1.591     raeburn  6389:   clear: both;
                   6390: }
                   6391: 
1.597     albertel 6392: div.LC_grade_show_user {
1.941     bisitz   6393: /*  border-left: 5px solid $sidebg; */
                   6394:   border-top: 5px solid #000000;
                   6395:   margin: 50px 0 0 0;
1.936     bisitz   6396:   padding: 15px 0 5px 10px;
1.597     albertel 6397: }
1.795     www      6398: 
1.936     bisitz   6399: div.LC_grade_show_user_odd_row {
1.941     bisitz   6400: /*  border-left: 5px solid #000000; */
                   6401: }
                   6402: 
                   6403: div.LC_grade_show_user div.LC_Box {
                   6404:   margin-right: 50px;
1.597     albertel 6405: }
                   6406: 
                   6407: div.LC_grade_submissions,
                   6408: div.LC_grade_message_center,
1.936     bisitz   6409: div.LC_grade_info_links {
1.597     albertel 6410:   margin: 5px;
                   6411:   width: 99%;
                   6412:   background: #FFFFFF;
                   6413: }
1.795     www      6414: 
1.597     albertel 6415: div.LC_grade_submissions_header,
1.936     bisitz   6416: div.LC_grade_message_center_header {
1.705     tempelho 6417:   font-weight: bold;
                   6418:   font-size: large;
1.597     albertel 6419: }
1.795     www      6420: 
1.597     albertel 6421: div.LC_grade_submissions_body,
1.936     bisitz   6422: div.LC_grade_message_center_body {
1.597     albertel 6423:   border: 1px solid black;
                   6424:   width: 99%;
                   6425:   background: #FFFFFF;
                   6426: }
1.795     www      6427: 
1.613     albertel 6428: table.LC_scantron_action {
                   6429:   width: 100%;
                   6430: }
1.795     www      6431: 
1.613     albertel 6432: table.LC_scantron_action tr th {
1.698     harmsja  6433:   font-weight:bold;
                   6434:   font-style:normal;
1.613     albertel 6435: }
1.795     www      6436: 
1.779     bisitz   6437: .LC_edit_problem_header,
1.614     albertel 6438: div.LC_edit_problem_footer {
1.705     tempelho 6439:   font-weight: normal;
                   6440:   font-size:  medium;
1.602     albertel 6441:   margin: 2px;
1.1060    bisitz   6442:   background-color: $sidebg;
1.600     albertel 6443: }
1.795     www      6444: 
1.600     albertel 6445: div.LC_edit_problem_header,
1.602     albertel 6446: div.LC_edit_problem_header div,
1.614     albertel 6447: div.LC_edit_problem_footer,
                   6448: div.LC_edit_problem_footer div,
1.602     albertel 6449: div.LC_edit_problem_editxml_header,
                   6450: div.LC_edit_problem_editxml_header div {
1.600     albertel 6451:   margin-top: 5px;
                   6452: }
1.795     www      6453: 
1.600     albertel 6454: div.LC_edit_problem_header_title {
1.705     tempelho 6455:   font-weight: bold;
                   6456:   font-size: larger;
1.602     albertel 6457:   background: $tabbg;
                   6458:   padding: 3px;
1.1060    bisitz   6459:   margin: 0 0 5px 0;
1.602     albertel 6460: }
1.795     www      6461: 
1.602     albertel 6462: table.LC_edit_problem_header_title {
                   6463:   width: 100%;
1.600     albertel 6464:   background: $tabbg;
1.602     albertel 6465: }
                   6466: 
                   6467: div.LC_edit_problem_discards {
                   6468:   float: left;
                   6469:   padding-bottom: 5px;
                   6470: }
1.795     www      6471: 
1.602     albertel 6472: div.LC_edit_problem_saves {
                   6473:   float: right;
                   6474:   padding-bottom: 5px;
1.600     albertel 6475: }
1.795     www      6476: 
1.1075.2.34  raeburn  6477: .LC_edit_opt {
                   6478:   padding-left: 1em;
                   6479:   white-space: nowrap;
                   6480: }
                   6481: 
1.911     bisitz   6482: img.stift {
1.803     bisitz   6483:   border-width: 0;
                   6484:   vertical-align: middle;
1.677     riegler  6485: }
1.680     riegler  6486: 
1.923     bisitz   6487: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6488:   vertical-align: top;
1.777     tempelho 6489: }
1.795     www      6490: 
1.716     raeburn  6491: div.LC_createcourse {
1.911     bisitz   6492:   margin: 10px 10px 10px 10px;
1.716     raeburn  6493: }
                   6494: 
1.917     raeburn  6495: .LC_dccid {
1.1075.2.38  raeburn  6496:   float: right;
1.917     raeburn  6497:   margin: 0.2em 0 0 0;
                   6498:   padding: 0;
                   6499:   font-size: 90%;
                   6500:   display:none;
                   6501: }
                   6502: 
1.897     wenzelju 6503: ol.LC_primary_menu a:hover,
1.721     harmsja  6504: ol#LC_MenuBreadcrumbs a:hover,
                   6505: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6506: ul#LC_secondary_menu a:hover,
1.721     harmsja  6507: .LC_FormSectionClearButton input:hover
1.795     www      6508: ul.LC_TabContent   li:hover a {
1.952     onken    6509:   color:$button_hover;
1.911     bisitz   6510:   text-decoration:none;
1.693     droeschl 6511: }
                   6512: 
1.779     bisitz   6513: h1 {
1.911     bisitz   6514:   padding: 0;
                   6515:   line-height:130%;
1.693     droeschl 6516: }
1.698     harmsja  6517: 
1.911     bisitz   6518: h2,
                   6519: h3,
                   6520: h4,
                   6521: h5,
                   6522: h6 {
                   6523:   margin: 5px 0 5px 0;
                   6524:   padding: 0;
                   6525:   line-height:130%;
1.693     droeschl 6526: }
1.795     www      6527: 
                   6528: .LC_hcell {
1.911     bisitz   6529:   padding:3px 15px 3px 15px;
                   6530:   margin: 0;
                   6531:   background-color:$tabbg;
                   6532:   color:$fontmenu;
                   6533:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6534: }
1.795     www      6535: 
1.840     bisitz   6536: .LC_Box > .LC_hcell {
1.911     bisitz   6537:   margin: 0 -10px 10px -10px;
1.835     bisitz   6538: }
                   6539: 
1.721     harmsja  6540: .LC_noBorder {
1.911     bisitz   6541:   border: 0;
1.698     harmsja  6542: }
1.693     droeschl 6543: 
1.721     harmsja  6544: .LC_FormSectionClearButton input {
1.911     bisitz   6545:   background-color:transparent;
                   6546:   border: none;
                   6547:   cursor:pointer;
                   6548:   text-decoration:underline;
1.693     droeschl 6549: }
1.763     bisitz   6550: 
                   6551: .LC_help_open_topic {
1.911     bisitz   6552:   color: #FFFFFF;
                   6553:   background-color: #EEEEFF;
                   6554:   margin: 1px;
                   6555:   padding: 4px;
                   6556:   border: 1px solid #000033;
                   6557:   white-space: nowrap;
                   6558:   /* vertical-align: middle; */
1.759     neumanie 6559: }
1.693     droeschl 6560: 
1.911     bisitz   6561: dl,
                   6562: ul,
                   6563: div,
                   6564: fieldset {
                   6565:   margin: 10px 10px 10px 0;
                   6566:   /* overflow: hidden; */
1.693     droeschl 6567: }
1.795     www      6568: 
1.838     bisitz   6569: fieldset > legend {
1.911     bisitz   6570:   font-weight: bold;
                   6571:   padding: 0 5px 0 5px;
1.838     bisitz   6572: }
                   6573: 
1.813     bisitz   6574: #LC_nav_bar {
1.911     bisitz   6575:   float: left;
1.995     raeburn  6576:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6577:   margin: 0 0 2px 0;
1.807     droeschl 6578: }
                   6579: 
1.916     droeschl 6580: #LC_realm {
                   6581:   margin: 0.2em 0 0 0;
                   6582:   padding: 0;
                   6583:   font-weight: bold;
                   6584:   text-align: center;
1.995     raeburn  6585:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6586: }
                   6587: 
1.911     bisitz   6588: #LC_nav_bar em {
                   6589:   font-weight: bold;
                   6590:   font-style: normal;
1.807     droeschl 6591: }
                   6592: 
1.897     wenzelju 6593: ol.LC_primary_menu {
1.934     droeschl 6594:   margin: 0;
1.1075.2.2  raeburn  6595:   padding: 0;
1.995     raeburn  6596:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6597: }
                   6598: 
1.852     droeschl 6599: ol#LC_PathBreadcrumbs {
1.911     bisitz   6600:   margin: 0;
1.693     droeschl 6601: }
                   6602: 
1.897     wenzelju 6603: ol.LC_primary_menu li {
1.1075.2.2  raeburn  6604:   color: RGB(80, 80, 80);
                   6605:   vertical-align: middle;
                   6606:   text-align: left;
                   6607:   list-style: none;
                   6608:   float: left;
                   6609: }
                   6610: 
                   6611: ol.LC_primary_menu li a {
                   6612:   display: block;
                   6613:   margin: 0;
                   6614:   padding: 0 5px 0 10px;
                   6615:   text-decoration: none;
                   6616: }
                   6617: 
                   6618: ol.LC_primary_menu li ul {
                   6619:   display: none;
                   6620:   width: 10em;
                   6621:   background-color: $data_table_light;
                   6622: }
                   6623: 
                   6624: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
                   6625:   display: block;
                   6626:   position: absolute;
                   6627:   margin: 0;
                   6628:   padding: 0;
1.1075.2.5  raeburn  6629:   z-index: 2;
1.1075.2.2  raeburn  6630: }
                   6631: 
                   6632: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
                   6633:   font-size: 90%;
1.911     bisitz   6634:   vertical-align: top;
1.1075.2.2  raeburn  6635:   float: none;
1.1075.2.5  raeburn  6636:   border-left: 1px solid black;
                   6637:   border-right: 1px solid black;
1.1075.2.2  raeburn  6638: }
                   6639: 
                   6640: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1075.2.5  raeburn  6641:   background-color:$data_table_light;
1.1075.2.2  raeburn  6642: }
                   6643: 
                   6644: ol.LC_primary_menu li li a:hover {
                   6645:    color:$button_hover;
                   6646:    background-color:$data_table_dark;
1.693     droeschl 6647: }
                   6648: 
1.897     wenzelju 6649: ol.LC_primary_menu li img {
1.911     bisitz   6650:   vertical-align: bottom;
1.934     droeschl 6651:   height: 1.1em;
1.1075.2.3  raeburn  6652:   margin: 0.2em 0 0 0;
1.693     droeschl 6653: }
                   6654: 
1.897     wenzelju 6655: ol.LC_primary_menu a {
1.911     bisitz   6656:   color: RGB(80, 80, 80);
                   6657:   text-decoration: none;
1.693     droeschl 6658: }
1.795     www      6659: 
1.949     droeschl 6660: ol.LC_primary_menu a.LC_new_message {
                   6661:   font-weight:bold;
                   6662:   color: darkred;
                   6663: }
                   6664: 
1.975     raeburn  6665: ol.LC_docs_parameters {
                   6666:   margin-left: 0;
                   6667:   padding: 0;
                   6668:   list-style: none;
                   6669: }
                   6670: 
                   6671: ol.LC_docs_parameters li {
                   6672:   margin: 0;
                   6673:   padding-right: 20px;
                   6674:   display: inline;
                   6675: }
                   6676: 
1.976     raeburn  6677: ol.LC_docs_parameters li:before {
                   6678:   content: "\\002022 \\0020";
                   6679: }
                   6680: 
                   6681: li.LC_docs_parameters_title {
                   6682:   font-weight: bold;
                   6683: }
                   6684: 
                   6685: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6686:   content: "";
                   6687: }
                   6688: 
1.897     wenzelju 6689: ul#LC_secondary_menu {
1.1075.2.23  raeburn  6690:   clear: right;
1.911     bisitz   6691:   color: $fontmenu;
                   6692:   background: $tabbg;
                   6693:   list-style: none;
                   6694:   padding: 0;
                   6695:   margin: 0;
                   6696:   width: 100%;
1.995     raeburn  6697:   text-align: left;
1.1075.2.4  raeburn  6698:   float: left;
1.808     droeschl 6699: }
                   6700: 
1.897     wenzelju 6701: ul#LC_secondary_menu li {
1.911     bisitz   6702:   font-weight: bold;
                   6703:   line-height: 1.8em;
                   6704:   border-right: 1px solid black;
                   6705:   vertical-align: middle;
1.1075.2.4  raeburn  6706:   float: left;
                   6707: }
                   6708: 
                   6709: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   6710:   background-color: $data_table_light;
                   6711: }
                   6712: 
                   6713: ul#LC_secondary_menu li a {
                   6714:   padding: 0 0.8em;
                   6715: }
                   6716: 
                   6717: ul#LC_secondary_menu li ul {
                   6718:   display: none;
                   6719: }
                   6720: 
                   6721: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   6722:   display: block;
                   6723:   position: absolute;
                   6724:   margin: 0;
                   6725:   padding: 0;
                   6726:   list-style:none;
                   6727:   float: none;
                   6728:   background-color: $data_table_light;
1.1075.2.5  raeburn  6729:   z-index: 2;
1.1075.2.10  raeburn  6730:   margin-left: -1px;
1.1075.2.4  raeburn  6731: }
                   6732: 
                   6733: ul#LC_secondary_menu li ul li {
                   6734:   font-size: 90%;
                   6735:   vertical-align: top;
                   6736:   border-left: 1px solid black;
                   6737:   border-right: 1px solid black;
1.1075.2.33  raeburn  6738:   background-color: $data_table_light;
1.1075.2.4  raeburn  6739:   list-style:none;
                   6740:   float: none;
                   6741: }
                   6742: 
                   6743: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   6744:   background-color: $data_table_dark;
1.807     droeschl 6745: }
                   6746: 
1.847     tempelho 6747: ul.LC_TabContent {
1.911     bisitz   6748:   display:block;
                   6749:   background: $sidebg;
                   6750:   border-bottom: solid 1px $lg_border_color;
                   6751:   list-style:none;
1.1020    raeburn  6752:   margin: -1px -10px 0 -10px;
1.911     bisitz   6753:   padding: 0;
1.693     droeschl 6754: }
                   6755: 
1.795     www      6756: ul.LC_TabContent li,
                   6757: ul.LC_TabContentBigger li {
1.911     bisitz   6758:   float:left;
1.741     harmsja  6759: }
1.795     www      6760: 
1.897     wenzelju 6761: ul#LC_secondary_menu li a {
1.911     bisitz   6762:   color: $fontmenu;
                   6763:   text-decoration: none;
1.693     droeschl 6764: }
1.795     www      6765: 
1.721     harmsja  6766: ul.LC_TabContent {
1.952     onken    6767:   min-height:20px;
1.721     harmsja  6768: }
1.795     www      6769: 
                   6770: ul.LC_TabContent li {
1.911     bisitz   6771:   vertical-align:middle;
1.959     onken    6772:   padding: 0 16px 0 10px;
1.911     bisitz   6773:   background-color:$tabbg;
                   6774:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6775:   border-left: solid 1px $font;
1.721     harmsja  6776: }
1.795     www      6777: 
1.847     tempelho 6778: ul.LC_TabContent .right {
1.911     bisitz   6779:   float:right;
1.847     tempelho 6780: }
                   6781: 
1.911     bisitz   6782: ul.LC_TabContent li a,
                   6783: ul.LC_TabContent li {
                   6784:   color:rgb(47,47,47);
                   6785:   text-decoration:none;
                   6786:   font-size:95%;
                   6787:   font-weight:bold;
1.952     onken    6788:   min-height:20px;
                   6789: }
                   6790: 
1.959     onken    6791: ul.LC_TabContent li a:hover,
                   6792: ul.LC_TabContent li a:focus {
1.952     onken    6793:   color: $button_hover;
1.959     onken    6794:   background:none;
                   6795:   outline:none;
1.952     onken    6796: }
                   6797: 
                   6798: ul.LC_TabContent li:hover {
                   6799:   color: $button_hover;
                   6800:   cursor:pointer;
1.721     harmsja  6801: }
1.795     www      6802: 
1.911     bisitz   6803: ul.LC_TabContent li.active {
1.952     onken    6804:   color: $font;
1.911     bisitz   6805:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6806:   border-bottom:solid 1px #FFFFFF;
                   6807:   cursor: default;
1.744     ehlerst  6808: }
1.795     www      6809: 
1.959     onken    6810: ul.LC_TabContent li.active a {
                   6811:   color:$font;
                   6812:   background:#FFFFFF;
                   6813:   outline: none;
                   6814: }
1.1047    raeburn  6815: 
                   6816: ul.LC_TabContent li.goback {
                   6817:   float: left;
                   6818:   border-left: none;
                   6819: }
                   6820: 
1.870     tempelho 6821: #maincoursedoc {
1.911     bisitz   6822:   clear:both;
1.870     tempelho 6823: }
                   6824: 
                   6825: ul.LC_TabContentBigger {
1.911     bisitz   6826:   display:block;
                   6827:   list-style:none;
                   6828:   padding: 0;
1.870     tempelho 6829: }
                   6830: 
1.795     www      6831: ul.LC_TabContentBigger li {
1.911     bisitz   6832:   vertical-align:bottom;
                   6833:   height: 30px;
                   6834:   font-size:110%;
                   6835:   font-weight:bold;
                   6836:   color: #737373;
1.841     tempelho 6837: }
                   6838: 
1.957     onken    6839: ul.LC_TabContentBigger li.active {
                   6840:   position: relative;
                   6841:   top: 1px;
                   6842: }
                   6843: 
1.870     tempelho 6844: ul.LC_TabContentBigger li a {
1.911     bisitz   6845:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6846:   height: 30px;
                   6847:   line-height: 30px;
                   6848:   text-align: center;
                   6849:   display: block;
                   6850:   text-decoration: none;
1.958     onken    6851:   outline: none;  
1.741     harmsja  6852: }
1.795     www      6853: 
1.870     tempelho 6854: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6855:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6856:   color:$font;
1.744     ehlerst  6857: }
1.795     www      6858: 
1.870     tempelho 6859: ul.LC_TabContentBigger li b {
1.911     bisitz   6860:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6861:   display: block;
                   6862:   float: left;
                   6863:   padding: 0 30px;
1.957     onken    6864:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6865: }
                   6866: 
1.956     onken    6867: ul.LC_TabContentBigger li:hover b {
                   6868:   color:$button_hover;
                   6869: }
                   6870: 
1.870     tempelho 6871: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6872:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6873:   color:$font;
1.957     onken    6874:   border: 0;
1.741     harmsja  6875: }
1.693     droeschl 6876: 
1.870     tempelho 6877: 
1.862     bisitz   6878: ul.LC_CourseBreadcrumbs {
                   6879:   background: $sidebg;
1.1020    raeburn  6880:   height: 2em;
1.862     bisitz   6881:   padding-left: 10px;
1.1020    raeburn  6882:   margin: 0;
1.862     bisitz   6883:   list-style-position: inside;
                   6884: }
                   6885: 
1.911     bisitz   6886: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6887: ol#LC_PathBreadcrumbs {
1.911     bisitz   6888:   padding-left: 10px;
                   6889:   margin: 0;
1.933     droeschl 6890:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6891: }
                   6892: 
1.911     bisitz   6893: ol#LC_MenuBreadcrumbs li,
                   6894: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6895: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6896:   display: inline;
1.933     droeschl 6897:   white-space: normal;  
1.693     droeschl 6898: }
                   6899: 
1.823     bisitz   6900: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6901: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6902:   text-decoration: none;
                   6903:   font-size:90%;
1.693     droeschl 6904: }
1.795     www      6905: 
1.969     droeschl 6906: ol#LC_MenuBreadcrumbs h1 {
                   6907:   display: inline;
                   6908:   font-size: 90%;
                   6909:   line-height: 2.5em;
                   6910:   margin: 0;
                   6911:   padding: 0;
                   6912: }
                   6913: 
1.795     www      6914: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6915:   text-decoration:none;
                   6916:   font-size:100%;
                   6917:   font-weight:bold;
1.693     droeschl 6918: }
1.795     www      6919: 
1.840     bisitz   6920: .LC_Box {
1.911     bisitz   6921:   border: solid 1px $lg_border_color;
                   6922:   padding: 0 10px 10px 10px;
1.746     neumanie 6923: }
1.795     www      6924: 
1.1020    raeburn  6925: .LC_DocsBox {
                   6926:   border: solid 1px $lg_border_color;
                   6927:   padding: 0 0 10px 10px;
                   6928: }
                   6929: 
1.795     www      6930: .LC_AboutMe_Image {
1.911     bisitz   6931:   float:left;
                   6932:   margin-right:10px;
1.747     neumanie 6933: }
1.795     www      6934: 
                   6935: .LC_Clear_AboutMe_Image {
1.911     bisitz   6936:   clear:left;
1.747     neumanie 6937: }
1.795     www      6938: 
1.721     harmsja  6939: dl.LC_ListStyleClean dt {
1.911     bisitz   6940:   padding-right: 5px;
                   6941:   display: table-header-group;
1.693     droeschl 6942: }
                   6943: 
1.721     harmsja  6944: dl.LC_ListStyleClean dd {
1.911     bisitz   6945:   display: table-row;
1.693     droeschl 6946: }
                   6947: 
1.721     harmsja  6948: .LC_ListStyleClean,
                   6949: .LC_ListStyleSimple,
                   6950: .LC_ListStyleNormal,
1.795     www      6951: .LC_ListStyleSpecial {
1.911     bisitz   6952:   /* display:block; */
                   6953:   list-style-position: inside;
                   6954:   list-style-type: none;
                   6955:   overflow: hidden;
                   6956:   padding: 0;
1.693     droeschl 6957: }
                   6958: 
1.721     harmsja  6959: .LC_ListStyleSimple li,
                   6960: .LC_ListStyleSimple dd,
                   6961: .LC_ListStyleNormal li,
                   6962: .LC_ListStyleNormal dd,
                   6963: .LC_ListStyleSpecial li,
1.795     www      6964: .LC_ListStyleSpecial dd {
1.911     bisitz   6965:   margin: 0;
                   6966:   padding: 5px 5px 5px 10px;
                   6967:   clear: both;
1.693     droeschl 6968: }
                   6969: 
1.721     harmsja  6970: .LC_ListStyleClean li,
                   6971: .LC_ListStyleClean dd {
1.911     bisitz   6972:   padding-top: 0;
                   6973:   padding-bottom: 0;
1.693     droeschl 6974: }
                   6975: 
1.721     harmsja  6976: .LC_ListStyleSimple dd,
1.795     www      6977: .LC_ListStyleSimple li {
1.911     bisitz   6978:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 6979: }
                   6980: 
1.721     harmsja  6981: .LC_ListStyleSpecial li,
                   6982: .LC_ListStyleSpecial dd {
1.911     bisitz   6983:   list-style-type: none;
                   6984:   background-color: RGB(220, 220, 220);
                   6985:   margin-bottom: 4px;
1.693     droeschl 6986: }
                   6987: 
1.721     harmsja  6988: table.LC_SimpleTable {
1.911     bisitz   6989:   margin:5px;
                   6990:   border:solid 1px $lg_border_color;
1.795     www      6991: }
1.693     droeschl 6992: 
1.721     harmsja  6993: table.LC_SimpleTable tr {
1.911     bisitz   6994:   padding: 0;
                   6995:   border:solid 1px $lg_border_color;
1.693     droeschl 6996: }
1.795     www      6997: 
                   6998: table.LC_SimpleTable thead {
1.911     bisitz   6999:   background:rgb(220,220,220);
1.693     droeschl 7000: }
                   7001: 
1.721     harmsja  7002: div.LC_columnSection {
1.911     bisitz   7003:   display: block;
                   7004:   clear: both;
                   7005:   overflow: hidden;
                   7006:   margin: 0;
1.693     droeschl 7007: }
                   7008: 
1.721     harmsja  7009: div.LC_columnSection>* {
1.911     bisitz   7010:   float: left;
                   7011:   margin: 10px 20px 10px 0;
                   7012:   overflow:hidden;
1.693     droeschl 7013: }
1.721     harmsja  7014: 
1.795     www      7015: table em {
1.911     bisitz   7016:   font-weight: bold;
                   7017:   font-style: normal;
1.748     schulted 7018: }
1.795     www      7019: 
1.779     bisitz   7020: table.LC_tableBrowseRes,
1.795     www      7021: table.LC_tableOfContent {
1.911     bisitz   7022:   border:none;
                   7023:   border-spacing: 1px;
                   7024:   padding: 3px;
                   7025:   background-color: #FFFFFF;
                   7026:   font-size: 90%;
1.753     droeschl 7027: }
1.789     droeschl 7028: 
1.911     bisitz   7029: table.LC_tableOfContent {
                   7030:   border-collapse: collapse;
1.789     droeschl 7031: }
                   7032: 
1.771     droeschl 7033: table.LC_tableBrowseRes a,
1.768     schulted 7034: table.LC_tableOfContent a {
1.911     bisitz   7035:   background-color: transparent;
                   7036:   text-decoration: none;
1.753     droeschl 7037: }
                   7038: 
1.795     www      7039: table.LC_tableOfContent img {
1.911     bisitz   7040:   border: none;
                   7041:   height: 1.3em;
                   7042:   vertical-align: text-bottom;
                   7043:   margin-right: 0.3em;
1.753     droeschl 7044: }
1.757     schulted 7045: 
1.795     www      7046: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7047:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7048: }
                   7049: 
1.795     www      7050: a#LC_content_toolbar_everything {
1.911     bisitz   7051:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7052: }
                   7053: 
1.795     www      7054: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7055:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7056: }
                   7057: 
1.795     www      7058: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7059:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7060: }
                   7061: 
1.795     www      7062: a#LC_content_toolbar_changefolder {
1.911     bisitz   7063:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7064: }
                   7065: 
1.795     www      7066: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7067:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7068: }
                   7069: 
1.1043    raeburn  7070: a#LC_content_toolbar_edittoplevel {
                   7071:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7072: }
                   7073: 
1.795     www      7074: ul#LC_toolbar li a:hover {
1.911     bisitz   7075:   background-position: bottom center;
1.757     schulted 7076: }
                   7077: 
1.795     www      7078: ul#LC_toolbar {
1.911     bisitz   7079:   padding: 0;
                   7080:   margin: 2px;
                   7081:   list-style:none;
                   7082:   position:relative;
                   7083:   background-color:white;
1.1075.2.9  raeburn  7084:   overflow: auto;
1.757     schulted 7085: }
                   7086: 
1.795     www      7087: ul#LC_toolbar li {
1.911     bisitz   7088:   border:1px solid white;
                   7089:   padding: 0;
                   7090:   margin: 0;
                   7091:   float: left;
                   7092:   display:inline;
                   7093:   vertical-align:middle;
1.1075.2.9  raeburn  7094:   white-space: nowrap;
1.911     bisitz   7095: }
1.757     schulted 7096: 
1.783     amueller 7097: 
1.795     www      7098: a.LC_toolbarItem {
1.911     bisitz   7099:   display:block;
                   7100:   padding: 0;
                   7101:   margin: 0;
                   7102:   height: 32px;
                   7103:   width: 32px;
                   7104:   color:white;
                   7105:   border: none;
                   7106:   background-repeat:no-repeat;
                   7107:   background-color:transparent;
1.757     schulted 7108: }
                   7109: 
1.915     droeschl 7110: ul.LC_funclist {
                   7111:     margin: 0;
                   7112:     padding: 0.5em 1em 0.5em 0;
                   7113: }
                   7114: 
1.933     droeschl 7115: ul.LC_funclist > li:first-child {
                   7116:     font-weight:bold; 
                   7117:     margin-left:0.8em;
                   7118: }
                   7119: 
1.915     droeschl 7120: ul.LC_funclist + ul.LC_funclist {
                   7121:     /* 
                   7122:        left border as a seperator if we have more than
                   7123:        one list 
                   7124:     */
                   7125:     border-left: 1px solid $sidebg;
                   7126:     /* 
                   7127:        this hides the left border behind the border of the 
                   7128:        outer box if element is wrapped to the next 'line' 
                   7129:     */
                   7130:     margin-left: -1px;
                   7131: }
                   7132: 
1.843     bisitz   7133: ul.LC_funclist li {
1.915     droeschl 7134:   display: inline;
1.782     bisitz   7135:   white-space: nowrap;
1.915     droeschl 7136:   margin: 0 0 0 25px;
                   7137:   line-height: 150%;
1.782     bisitz   7138: }
                   7139: 
1.974     wenzelju 7140: .LC_hidden {
                   7141:   display: none;
                   7142: }
                   7143: 
1.1030    www      7144: .LCmodal-overlay {
                   7145: 		position:fixed;
                   7146: 		top:0;
                   7147: 		right:0;
                   7148: 		bottom:0;
                   7149: 		left:0;
                   7150: 		height:100%;
                   7151: 		width:100%;
                   7152: 		margin:0;
                   7153: 		padding:0;
                   7154: 		background:#999;
                   7155: 		opacity:.75;
                   7156: 		filter: alpha(opacity=75);
                   7157: 		-moz-opacity: 0.75;
                   7158: 		z-index:101;
                   7159: }
                   7160: 
                   7161: * html .LCmodal-overlay {   
                   7162: 		position: absolute;
                   7163: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7164: }
                   7165: 
                   7166: .LCmodal-window {
                   7167: 		position:fixed;
                   7168: 		top:50%;
                   7169: 		left:50%;
                   7170: 		margin:0;
                   7171: 		padding:0;
                   7172: 		z-index:102;
                   7173: 	}
                   7174: 
                   7175: * html .LCmodal-window {
                   7176: 		position:absolute;
                   7177: }
                   7178: 
                   7179: .LCclose-window {
                   7180: 		position:absolute;
                   7181: 		width:32px;
                   7182: 		height:32px;
                   7183: 		right:8px;
                   7184: 		top:8px;
                   7185: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7186: 		text-indent:-99999px;
                   7187: 		overflow:hidden;
                   7188: 		cursor:pointer;
                   7189: }
                   7190: 
1.1075.2.17  raeburn  7191: /*
                   7192:   styles used by TTH when "Default set of options to pass to tth/m
                   7193:   when converting TeX" in course settings has been set
                   7194: 
                   7195:   option passed: -t
                   7196: 
                   7197: */
                   7198: 
                   7199: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7200: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7201: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7202: td div.norm {line-height:normal;}
                   7203: 
                   7204: /*
                   7205:   option passed -y3
                   7206: */
                   7207: 
                   7208: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7209: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7210: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7211: 
1.343     albertel 7212: END
                   7213: }
                   7214: 
1.306     albertel 7215: =pod
                   7216: 
                   7217: =item * &headtag()
                   7218: 
                   7219: Returns a uniform footer for LON-CAPA web pages.
                   7220: 
1.307     albertel 7221: Inputs: $title - optional title for the head
                   7222:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7223:         $args - optional arguments
1.319     albertel 7224:             force_register - if is true call registerurl so the remote is 
                   7225:                              informed
1.415     albertel 7226:             redirect       -> array ref of
                   7227:                                    1- seconds before redirect occurs
                   7228:                                    2- url to redirect to
                   7229:                                    3- whether the side effect should occur
1.315     albertel 7230:                            (side effect of setting 
                   7231:                                $env{'internal.head.redirect'} to the url 
                   7232:                                redirected too)
1.352     albertel 7233:             domain         -> force to color decorate a page for a specific
                   7234:                                domain
                   7235:             function       -> force usage of a specific rolish color scheme
                   7236:             bgcolor        -> override the default page bgcolor
1.460     albertel 7237:             no_auto_mt_title
                   7238:                            -> prevent &mt()ing the title arg
1.464     albertel 7239: 
1.306     albertel 7240: =cut
                   7241: 
                   7242: sub headtag {
1.313     albertel 7243:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7244:     
1.363     albertel 7245:     my $function = $args->{'function'} || &get_users_function();
                   7246:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7247:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.418     albertel 7248:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7249: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7250: 		   #time(),
1.418     albertel 7251: 		   $env{'environment.color.timestamp'},
1.363     albertel 7252: 		   $function,$domain,$bgcolor);
                   7253: 
1.369     www      7254:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7255: 
1.308     albertel 7256:     my $result =
                   7257: 	'<head>'.
1.461     albertel 7258: 	&font_settings();
1.319     albertel 7259: 
1.1064    raeburn  7260:     my $inhibitprint = &print_suppression();
                   7261: 
1.461     albertel 7262:     if (!$args->{'frameset'}) {
                   7263: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7264:     }
1.1075.2.12  raeburn  7265:     if ($args->{'force_register'}) {
                   7266:         $result .= &Apache::lonmenu::registerurl(1);
1.319     albertel 7267:     }
1.436     albertel 7268:     if (!$args->{'no_nav_bar'} 
                   7269: 	&& !$args->{'only_body'}
                   7270: 	&& !$args->{'frameset'}) {
                   7271: 	$result .= &help_menu_js();
1.1032    www      7272:         $result.=&modal_window();
1.1038    www      7273:         $result.=&togglebox_script();
1.1034    www      7274:         $result.=&wishlist_window();
1.1041    www      7275:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7276:     } else {
                   7277:         if ($args->{'add_modal'}) {
                   7278:            $result.=&modal_window();
                   7279:         }
                   7280:         if ($args->{'add_wishlist'}) {
                   7281:            $result.=&wishlist_window();
                   7282:         }
1.1038    www      7283:         if ($args->{'add_togglebox'}) {
                   7284:            $result.=&togglebox_script();
                   7285:         }
1.1041    www      7286:         if ($args->{'add_progressbar'}) {
                   7287:            $result.=&LCprogressbarUpdate_script();
                   7288:         }
1.436     albertel 7289:     }
1.314     albertel 7290:     if (ref($args->{'redirect'})) {
1.414     albertel 7291: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7292: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7293: 	if (!$inhibit_continue) {
                   7294: 	    $env{'internal.head.redirect'} = $url;
                   7295: 	}
1.313     albertel 7296: 	$result.=<<ADDMETA
                   7297: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7298: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7299: ADDMETA
                   7300:     }
1.306     albertel 7301:     if (!defined($title)) {
                   7302: 	$title = 'The LearningOnline Network with CAPA';
                   7303:     }
1.460     albertel 7304:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7305:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 7306: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
1.1064    raeburn  7307:         .$inhibitprint
1.414     albertel 7308: 	.$head_extra;
1.1075.2.42  raeburn  7309:     if ($env{'browser.mobile'}) {
                   7310:         $result .= '
                   7311: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   7312: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   7313:     }
1.962     droeschl 7314:     return $result.'</head>';
1.306     albertel 7315: }
                   7316: 
                   7317: =pod
                   7318: 
1.340     albertel 7319: =item * &font_settings()
                   7320: 
                   7321: Returns neccessary <meta> to set the proper encoding
                   7322: 
                   7323: Inputs: none
                   7324: 
                   7325: =cut
                   7326: 
                   7327: sub font_settings {
                   7328:     my $headerstring='';
1.647     www      7329:     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340     albertel 7330: 	$headerstring.=
                   7331: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   7332:     }
                   7333:     return $headerstring;
                   7334: }
                   7335: 
1.341     albertel 7336: =pod
                   7337: 
1.1064    raeburn  7338: =item * &print_suppression()
                   7339: 
                   7340: In course context returns css which causes the body to be blank when media="print",
                   7341: if printout generation is unavailable for the current resource.
                   7342: 
                   7343: This could be because:
                   7344: 
                   7345: (a) printstartdate is in the future
                   7346: 
                   7347: (b) printenddate is in the past
                   7348: 
                   7349: (c) there is an active exam block with "printout"
                   7350: functionality blocked
                   7351: 
                   7352: Users with pav, pfo or evb privileges are exempt.
                   7353: 
                   7354: Inputs: none
                   7355: 
                   7356: =cut
                   7357: 
                   7358: 
                   7359: sub print_suppression {
                   7360:     my $noprint;
                   7361:     if ($env{'request.course.id'}) {
                   7362:         my $scope = $env{'request.course.id'};
                   7363:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7364:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7365:             return;
                   7366:         }
                   7367:         if ($env{'request.course.sec'} ne '') {
                   7368:             $scope .= "/$env{'request.course.sec'}";
                   7369:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7370:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7371:                 return;
1.1064    raeburn  7372:             }
                   7373:         }
                   7374:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7375:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1065    raeburn  7376:         my $blocked = &blocking_status('printout',$cnum,$cdom);
1.1064    raeburn  7377:         if ($blocked) {
                   7378:             my $checkrole = "cm./$cdom/$cnum";
                   7379:             if ($env{'request.course.sec'} ne '') {
                   7380:                 $checkrole .= "/$env{'request.course.sec'}";
                   7381:             }
                   7382:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7383:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7384:                 $noprint = 1;
                   7385:             }
                   7386:         }
                   7387:         unless ($noprint) {
                   7388:             my $symb = &Apache::lonnet::symbread();
                   7389:             if ($symb ne '') {
                   7390:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7391:                 if (ref($navmap)) {
                   7392:                     my $res = $navmap->getBySymb($symb);
                   7393:                     if (ref($res)) {
                   7394:                         if (!$res->resprintable()) {
                   7395:                             $noprint = 1;
                   7396:                         }
                   7397:                     }
                   7398:                 }
                   7399:             }
                   7400:         }
                   7401:         if ($noprint) {
                   7402:             return <<"ENDSTYLE";
                   7403: <style type="text/css" media="print">
                   7404:     body { display:none }
                   7405: </style>
                   7406: ENDSTYLE
                   7407:         }
                   7408:     }
                   7409:     return;
                   7410: }
                   7411: 
                   7412: =pod
                   7413: 
1.341     albertel 7414: =item * &xml_begin()
                   7415: 
                   7416: Returns the needed doctype and <html>
                   7417: 
                   7418: Inputs: none
                   7419: 
                   7420: =cut
                   7421: 
                   7422: sub xml_begin {
                   7423:     my $output='';
                   7424: 
                   7425:     if ($env{'browser.mathml'}) {
                   7426: 	$output='<?xml version="1.0"?>'
                   7427:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7428: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7429:             
                   7430: #	    .'<!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">] >'
                   7431: 	    .'<!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">'
                   7432:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7433: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   7434:     } else {
1.849     bisitz   7435: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
                   7436:            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341     albertel 7437:     }
                   7438:     return $output;
                   7439: }
1.340     albertel 7440: 
                   7441: =pod
                   7442: 
1.306     albertel 7443: =item * &start_page()
                   7444: 
                   7445: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7446: 
1.648     raeburn  7447: Inputs:
                   7448: 
                   7449: =over 4
                   7450: 
                   7451: $title - optional title for the page
                   7452: 
                   7453: $head_extra - optional extra HTML to incude inside the <head>
                   7454: 
                   7455: $args - additional optional args supported are:
                   7456: 
                   7457: =over 8
                   7458: 
                   7459:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 7460:                                     arg on
1.814     bisitz   7461:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  7462:              add_entries    -> additional attributes to add to the  <body>
                   7463:              domain         -> force to color decorate a page for a 
1.317     albertel 7464:                                     specific domain
1.648     raeburn  7465:              function       -> force usage of a specific rolish color
1.317     albertel 7466:                                     scheme
1.648     raeburn  7467:              redirect       -> see &headtag()
                   7468:              bgcolor        -> override the default page bg color
                   7469:              js_ready       -> return a string ready for being used in 
1.317     albertel 7470:                                     a javascript writeln
1.648     raeburn  7471:              html_encode    -> return a string ready for being used in 
1.320     albertel 7472:                                     a html attribute
1.648     raeburn  7473:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 7474:                                     $forcereg arg
1.648     raeburn  7475:              frameset       -> if true will start with a <frameset>
1.330     albertel 7476:                                     rather than <body>
1.648     raeburn  7477:              skip_phases    -> hash ref of 
1.338     albertel 7478:                                     head -> skip the <html><head> generation
                   7479:                                     body -> skip all <body> generation
1.1075.2.12  raeburn  7480:              no_inline_link -> if true and in remote mode, don't show the
                   7481:                                     'Switch To Inline Menu' link
1.648     raeburn  7482:              no_auto_mt_title -> prevent &mt()ing the title arg
                   7483:              inherit_jsmath -> when creating popup window in a page,
                   7484:                                     should it have jsmath forced on by the
                   7485:                                     current page
1.867     kalberla 7486:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  7487:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1075.2.15  raeburn  7488:              group          -> includes the current group, if page is for a
                   7489:                                specific group
1.361     albertel 7490: 
1.648     raeburn  7491: =back
1.460     albertel 7492: 
1.648     raeburn  7493: =back
1.562     albertel 7494: 
1.306     albertel 7495: =cut
                   7496: 
                   7497: sub start_page {
1.309     albertel 7498:     my ($title,$head_extra,$args) = @_;
1.318     albertel 7499:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 7500: 
1.315     albertel 7501:     $env{'internal.start_page'}++;
1.1075.2.15  raeburn  7502:     my ($result,@advtools);
1.964     droeschl 7503: 
1.338     albertel 7504:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1030    www      7505:         $result .= &xml_begin() . &headtag($title, $head_extra, $args);
1.338     albertel 7506:     }
                   7507:     
                   7508:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   7509: 	if ($args->{'frameset'}) {
                   7510: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   7511: 						$args->{'add_entries'});
                   7512: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   7513:         } else {
                   7514:             $result .=
                   7515:                 &bodytag($title, 
                   7516:                          $args->{'function'},       $args->{'add_entries'},
                   7517:                          $args->{'only_body'},      $args->{'domain'},
                   7518:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12  raeburn  7519:                          $args->{'bgcolor'},        $args->{'no_inline_link'},
1.1075.2.15  raeburn  7520:                          $args,                     \@advtools);
1.831     bisitz   7521:         }
1.330     albertel 7522:     }
1.338     albertel 7523: 
1.315     albertel 7524:     if ($args->{'js_ready'}) {
1.713     kaisler  7525: 		$result = &js_ready($result);
1.315     albertel 7526:     }
1.320     albertel 7527:     if ($args->{'html_encode'}) {
1.713     kaisler  7528: 		$result = &html_encode($result);
                   7529:     }
                   7530: 
1.813     bisitz   7531:     # Preparation for new and consistent functionlist at top of screen
                   7532:     # if ($args->{'functionlist'}) {
                   7533:     #            $result .= &build_functionlist();
                   7534:     #}
                   7535: 
1.964     droeschl 7536:     # Don't add anything more if only_body wanted or in const space
                   7537:     return $result if    $args->{'only_body'} 
                   7538:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   7539: 
                   7540:     #Breadcrumbs
1.758     kaisler  7541:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   7542: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   7543: 		#if any br links exists, add them to the breadcrumbs
                   7544: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   7545: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   7546: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   7547: 			}
                   7548: 		}
1.1075.2.19  raeburn  7549:                 # if @advtools array contains items add then to the breadcrumbs
                   7550:                 if (@advtools > 0) {
                   7551:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   7552:                 }
1.758     kaisler  7553: 
                   7554: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   7555: 		if(exists($args->{'bread_crumbs_component'})){
                   7556: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   7557: 		}else{
                   7558: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   7559: 		}
1.1075.2.24  raeburn  7560:     } elsif (($env{'environment.remote'} eq 'on') &&
                   7561:              ($env{'form.inhibitmenu'} ne 'yes') &&
                   7562:              ($env{'request.noversionuri'} =~ m{^/res/}) &&
                   7563:              ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21  raeburn  7564:         $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320     albertel 7565:     }
1.315     albertel 7566:     return $result;
1.306     albertel 7567: }
                   7568: 
                   7569: sub end_page {
1.315     albertel 7570:     my ($args) = @_;
                   7571:     $env{'internal.end_page'}++;
1.330     albertel 7572:     my $result;
1.335     albertel 7573:     if ($args->{'discussion'}) {
                   7574: 	my ($target,$parser);
                   7575: 	if (ref($args->{'discussion'})) {
                   7576: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   7577: 				$args->{'discussion'}{'parser'});
                   7578: 	}
                   7579: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   7580:     }
1.330     albertel 7581:     if ($args->{'frameset'}) {
                   7582: 	$result .= '</frameset>';
                   7583:     } else {
1.635     raeburn  7584: 	$result .= &endbodytag($args);
1.330     albertel 7585:     }
1.1075.2.6  raeburn  7586:     unless ($args->{'notbody'}) {
                   7587:         $result .= "\n</html>";
                   7588:     }
1.330     albertel 7589: 
1.315     albertel 7590:     if ($args->{'js_ready'}) {
1.317     albertel 7591: 	$result = &js_ready($result);
1.315     albertel 7592:     }
1.335     albertel 7593: 
1.320     albertel 7594:     if ($args->{'html_encode'}) {
                   7595: 	$result = &html_encode($result);
                   7596:     }
1.335     albertel 7597: 
1.315     albertel 7598:     return $result;
                   7599: }
                   7600: 
1.1034    www      7601: sub wishlist_window {
                   7602:     return(<<'ENDWISHLIST');
1.1046    raeburn  7603: <script type="text/javascript">
1.1034    www      7604: // <![CDATA[
                   7605: // <!-- BEGIN LON-CAPA Internal
                   7606: function set_wishlistlink(title, path) {
                   7607:     if (!title) {
                   7608:         title = document.title;
                   7609:         title = title.replace(/^LON-CAPA /,'');
                   7610:     }
                   7611:     if (!path) {
                   7612:         path = location.pathname;
                   7613:     }
                   7614:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   7615:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   7616: }
                   7617: // END LON-CAPA Internal -->
                   7618: // ]]>
                   7619: </script>
                   7620: ENDWISHLIST
                   7621: }
                   7622: 
1.1030    www      7623: sub modal_window {
                   7624:     return(<<'ENDMODAL');
1.1046    raeburn  7625: <script type="text/javascript">
1.1030    www      7626: // <![CDATA[
                   7627: // <!-- BEGIN LON-CAPA Internal
                   7628: var modalWindow = {
                   7629: 	parent:"body",
                   7630: 	windowId:null,
                   7631: 	content:null,
                   7632: 	width:null,
                   7633: 	height:null,
                   7634: 	close:function()
                   7635: 	{
                   7636: 	        $(".LCmodal-window").remove();
                   7637: 	        $(".LCmodal-overlay").remove();
                   7638: 	},
                   7639: 	open:function()
                   7640: 	{
                   7641: 		var modal = "";
                   7642: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7643: 		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;\">";
                   7644: 		modal += this.content;
                   7645: 		modal += "</div>";	
                   7646: 
                   7647: 		$(this.parent).append(modal);
                   7648: 
                   7649: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7650: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7651: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7652: 	}
                   7653: };
1.1075.2.42  raeburn  7654: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      7655: 	{
                   7656: 		modalWindow.windowId = "myModal";
                   7657: 		modalWindow.width = width;
                   7658: 		modalWindow.height = height;
1.1075.2.42  raeburn  7659: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'>&lt/iframe>";
1.1030    www      7660: 		modalWindow.open();
                   7661: 	};	
                   7662: // END LON-CAPA Internal -->
                   7663: // ]]>
                   7664: </script>
                   7665: ENDMODAL
                   7666: }
                   7667: 
                   7668: sub modal_link {
1.1075.2.42  raeburn  7669:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      7670:     unless ($width) { $width=480; }
                   7671:     unless ($height) { $height=400; }
1.1031    www      7672:     unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42  raeburn  7673:     unless ($transparency) { $transparency='true'; }
                   7674: 
1.1074    raeburn  7675:     my $target_attr;
                   7676:     if (defined($target)) {
                   7677:         $target_attr = 'target="'.$target.'"';
                   7678:     }
                   7679:     return <<"ENDLINK";
1.1075.2.42  raeburn  7680: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074    raeburn  7681:            $linktext</a>
                   7682: ENDLINK
1.1030    www      7683: }
                   7684: 
1.1032    www      7685: sub modal_adhoc_script {
                   7686:     my ($funcname,$width,$height,$content)=@_;
                   7687:     return (<<ENDADHOC);
1.1046    raeburn  7688: <script type="text/javascript">
1.1032    www      7689: // <![CDATA[
                   7690:         var $funcname = function()
                   7691:         {
                   7692:                 modalWindow.windowId = "myModal";
                   7693:                 modalWindow.width = $width;
                   7694:                 modalWindow.height = $height;
                   7695:                 modalWindow.content = '$content';
                   7696:                 modalWindow.open();
                   7697:         };  
                   7698: // ]]>
                   7699: </script>
                   7700: ENDADHOC
                   7701: }
                   7702: 
1.1041    www      7703: sub modal_adhoc_inner {
                   7704:     my ($funcname,$width,$height,$content)=@_;
                   7705:     my $innerwidth=$width-20;
                   7706:     $content=&js_ready(
1.1042    www      7707:                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42  raeburn  7708:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   7709:                  $content.
1.1041    www      7710:                  &end_scrollbox().
1.1075.2.42  raeburn  7711:                  &end_page()
1.1041    www      7712:              );
                   7713:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   7714: }
                   7715: 
                   7716: sub modal_adhoc_window {
                   7717:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7718:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   7719:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7720: }
                   7721: 
                   7722: sub modal_adhoc_launch {
                   7723:     my ($funcname,$width,$height,$content)=@_;
                   7724:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   7725: <script type="text/javascript">
                   7726: // <![CDATA[
                   7727: $funcname();
                   7728: // ]]>
                   7729: </script>
                   7730: ENDLAUNCH
                   7731: }
                   7732: 
                   7733: sub modal_adhoc_close {
                   7734:     return (<<ENDCLOSE);
                   7735: <script type="text/javascript">
                   7736: // <![CDATA[
                   7737: modalWindow.close();
                   7738: // ]]>
                   7739: </script>
                   7740: ENDCLOSE
                   7741: }
                   7742: 
1.1038    www      7743: sub togglebox_script {
                   7744:    return(<<ENDTOGGLE);
                   7745: <script type="text/javascript"> 
                   7746: // <![CDATA[
                   7747: function LCtoggleDisplay(id,hidetext,showtext) {
                   7748:    link = document.getElementById(id + "link").childNodes[0];
                   7749:    with (document.getElementById(id).style) {
                   7750:       if (display == "none" ) {
                   7751:           display = "inline";
                   7752:           link.nodeValue = hidetext;
                   7753:         } else {
                   7754:           display = "none";
                   7755:           link.nodeValue = showtext;
                   7756:        }
                   7757:    }
                   7758: }
                   7759: // ]]>
                   7760: </script>
                   7761: ENDTOGGLE
                   7762: }
                   7763: 
1.1039    www      7764: sub start_togglebox {
                   7765:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7766:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7767:     unless ($showtext) { $showtext=&mt('show'); }
                   7768:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7769:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7770:     return &start_data_table().
                   7771:            &start_data_table_header_row().
                   7772:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7773:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7774:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7775:            &end_data_table_header_row().
                   7776:            '<tr id="'.$id.'" style="display:none""><td>';
                   7777: }
                   7778: 
                   7779: sub end_togglebox {
                   7780:     return '</td></tr>'.&end_data_table();
                   7781: }
                   7782: 
1.1041    www      7783: sub LCprogressbar_script {
1.1045    www      7784:    my ($id)=@_;
1.1041    www      7785:    return(<<ENDPROGRESS);
                   7786: <script type="text/javascript">
                   7787: // <![CDATA[
1.1045    www      7788: \$('#progressbar$id').progressbar({
1.1041    www      7789:   value: 0,
                   7790:   change: function(event, ui) {
                   7791:     var newVal = \$(this).progressbar('option', 'value');
                   7792:     \$('.pblabel', this).text(LCprogressTxt);
                   7793:   }
                   7794: });
                   7795: // ]]>
                   7796: </script>
                   7797: ENDPROGRESS
                   7798: }
                   7799: 
                   7800: sub LCprogressbarUpdate_script {
                   7801:    return(<<ENDPROGRESSUPDATE);
                   7802: <style type="text/css">
                   7803: .ui-progressbar { position:relative; }
                   7804: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   7805: </style>
                   7806: <script type="text/javascript">
                   7807: // <![CDATA[
1.1045    www      7808: var LCprogressTxt='---';
                   7809: 
                   7810: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      7811:    LCprogressTxt=progresstext;
1.1045    www      7812:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      7813: }
                   7814: // ]]>
                   7815: </script>
                   7816: ENDPROGRESSUPDATE
                   7817: }
                   7818: 
1.1042    www      7819: my $LClastpercent;
1.1045    www      7820: my $LCidcnt;
                   7821: my $LCcurrentid;
1.1042    www      7822: 
1.1041    www      7823: sub LCprogressbar {
1.1042    www      7824:     my ($r)=(@_);
                   7825:     $LClastpercent=0;
1.1045    www      7826:     $LCidcnt++;
                   7827:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      7828:     my $starting=&mt('Starting');
                   7829:     my $content=(<<ENDPROGBAR);
1.1045    www      7830:   <div id="progressbar$LCcurrentid">
1.1041    www      7831:     <span class="pblabel">$starting</span>
                   7832:   </div>
                   7833: ENDPROGBAR
1.1045    www      7834:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      7835: }
                   7836: 
                   7837: sub LCprogressbarUpdate {
1.1042    www      7838:     my ($r,$val,$text)=@_;
                   7839:     unless ($val) { 
                   7840:        if ($LClastpercent) {
                   7841:            $val=$LClastpercent;
                   7842:        } else {
                   7843:            $val=0;
                   7844:        }
                   7845:     }
1.1041    www      7846:     if ($val<0) { $val=0; }
                   7847:     if ($val>100) { $val=0; }
1.1042    www      7848:     $LClastpercent=$val;
1.1041    www      7849:     unless ($text) { $text=$val.'%'; }
                   7850:     $text=&js_ready($text);
1.1044    www      7851:     &r_print($r,<<ENDUPDATE);
1.1041    www      7852: <script type="text/javascript">
                   7853: // <![CDATA[
1.1045    www      7854: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      7855: // ]]>
                   7856: </script>
                   7857: ENDUPDATE
1.1035    www      7858: }
                   7859: 
1.1042    www      7860: sub LCprogressbarClose {
                   7861:     my ($r)=@_;
                   7862:     $LClastpercent=0;
1.1044    www      7863:     &r_print($r,<<ENDCLOSE);
1.1042    www      7864: <script type="text/javascript">
                   7865: // <![CDATA[
1.1045    www      7866: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      7867: // ]]>
                   7868: </script>
                   7869: ENDCLOSE
1.1044    www      7870: }
                   7871: 
                   7872: sub r_print {
                   7873:     my ($r,$to_print)=@_;
                   7874:     if ($r) {
                   7875:       $r->print($to_print);
                   7876:       $r->rflush();
                   7877:     } else {
                   7878:       print($to_print);
                   7879:     }
1.1042    www      7880: }
                   7881: 
1.320     albertel 7882: sub html_encode {
                   7883:     my ($result) = @_;
                   7884: 
1.322     albertel 7885:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7886:     
                   7887:     return $result;
                   7888: }
1.1044    www      7889: 
1.317     albertel 7890: sub js_ready {
                   7891:     my ($result) = @_;
                   7892: 
1.323     albertel 7893:     $result =~ s/[\n\r]/ /xmsg;
                   7894:     $result =~ s/\\/\\\\/xmsg;
                   7895:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7896:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7897:     
                   7898:     return $result;
                   7899: }
                   7900: 
1.315     albertel 7901: sub validate_page {
                   7902:     if (  exists($env{'internal.start_page'})
1.316     albertel 7903: 	  &&     $env{'internal.start_page'} > 1) {
                   7904: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7905: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7906: 				 $ENV{'request.filename'});
1.315     albertel 7907:     }
                   7908:     if (  exists($env{'internal.end_page'})
1.316     albertel 7909: 	  &&     $env{'internal.end_page'} > 1) {
                   7910: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7911: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7912: 				 $env{'request.filename'});
1.315     albertel 7913:     }
                   7914:     if (     exists($env{'internal.start_page'})
                   7915: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7916: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7917: 				 $env{'request.filename'});
1.315     albertel 7918:     }
                   7919:     if (   ! exists($env{'internal.start_page'})
                   7920: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7921: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7922: 				 $env{'request.filename'});
1.315     albertel 7923:     }
1.306     albertel 7924: }
1.315     albertel 7925: 
1.996     www      7926: 
                   7927: sub start_scrollbox {
1.1075.2.42  raeburn  7928:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready)=@_;
1.998     raeburn  7929:     unless ($outerwidth) { $outerwidth='520px'; }
                   7930:     unless ($width) { $width='500px'; }
                   7931:     unless ($height) { $height='200px'; }
1.1075    raeburn  7932:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  7933:     if ($id ne '') {
1.1075.2.42  raeburn  7934:         $table_id = ' id="table_'.$id.'"';
                   7935:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  7936:     }
1.1075    raeburn  7937:     if ($bgcolor ne '') {
                   7938:         $tdcol = "background-color: $bgcolor;";
                   7939:     }
1.1075.2.42  raeburn  7940:     my $nicescroll_js;
                   7941:     if ($env{'browser.mobile'}) {
                   7942:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   7943:     }
1.1075    raeburn  7944:     return <<"END";
1.1075.2.42  raeburn  7945: $nicescroll_js
                   7946: 
                   7947: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
                   7948: <div style="overflow:auto; width:$width; height: $height;"$div_id>
1.1075    raeburn  7949: END
1.996     www      7950: }
                   7951: 
                   7952: sub end_scrollbox {
1.1036    www      7953:     return '</div></td></tr></table>';
1.996     www      7954: }
                   7955: 
1.1075.2.42  raeburn  7956: sub nicescroll_javascript {
                   7957:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   7958:     my %options;
                   7959:     if (ref($cursor) eq 'HASH') {
                   7960:         %options = %{$cursor};
                   7961:     }
                   7962:     unless ($options{'railalign'} =~ /^left|right$/) {
                   7963:         $options{'railalign'} = 'left';
                   7964:     }
                   7965:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   7966:         my $function  = &get_users_function();
                   7967:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
                   7968:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   7969:             $options{'cursorcolor'} = '#00F';
                   7970:         }
                   7971:     }
                   7972:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   7973:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
                   7974:             $options{'cursoropacity'}='1.0';
                   7975:         }
                   7976:     } else {
                   7977:         $options{'cursoropacity'}='1.0';
                   7978:     }
                   7979:     if ($options{'cursorfixedheight'} eq 'none') {
                   7980:         delete($options{'cursorfixedheight'});
                   7981:     } else {
                   7982:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   7983:     }
                   7984:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   7985:         delete($options{'railoffset'});
                   7986:     }
                   7987:     my @niceoptions;
                   7988:     while (my($key,$value) = each(%options)) {
                   7989:         if ($value =~ /^\{.+\}$/) {
                   7990:             push(@niceoptions,$key.':'.$value);
                   7991:         } else {
                   7992:             push(@niceoptions,$key.':"'.$value.'"');
                   7993:         }
                   7994:     }
                   7995:     my $nicescroll_js = '
                   7996: $(document).ready(
                   7997:       function() {
                   7998:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   7999:       }
                   8000: );
                   8001: ';
                   8002:     if ($framecheck) {
                   8003:         $nicescroll_js .= '
                   8004: function expand_div(caller) {
                   8005:     if (top === self) {
                   8006:         document.getElementById("'.$id.'").style.width = "auto";
                   8007:         document.getElementById("'.$id.'").style.height = "auto";
                   8008:     } else {
                   8009:         try {
                   8010:             if (parent.frames) {
                   8011:                 if (parent.frames.length > 1) {
                   8012:                     var framesrc = parent.frames[1].location.href;
                   8013:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   8014:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   8015:                         document.getElementById("'.$id.'").style.width = "auto";
                   8016:                         document.getElementById("'.$id.'").style.height = "auto";
                   8017:                     }
                   8018:                 }
                   8019:             }
                   8020:         } catch (e) {
                   8021:             return;
                   8022:         }
                   8023:     }
                   8024:     return;
                   8025: }
                   8026: ';
                   8027:     }
                   8028:     if ($needjsready) {
                   8029:         $nicescroll_js = '
                   8030: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   8031:     } else {
                   8032:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   8033:     }
                   8034:     return $nicescroll_js;
                   8035: }
                   8036: 
1.318     albertel 8037: sub simple_error_page {
                   8038:     my ($r,$title,$msg) = @_;
                   8039:     my $page =
                   8040: 	&Apache::loncommon::start_page($title).
1.1075.2.15  raeburn  8041: 	'<p class="LC_error">'.&mt($msg).'</p>'.
1.318     albertel 8042: 	&Apache::loncommon::end_page();
                   8043:     if (ref($r)) {
                   8044: 	$r->print($page);
1.327     albertel 8045: 	return;
1.318     albertel 8046:     }
                   8047:     return $page;
                   8048: }
1.347     albertel 8049: 
                   8050: {
1.610     albertel 8051:     my @row_count;
1.961     onken    8052: 
                   8053:     sub start_data_table_count {
                   8054:         unshift(@row_count, 0);
                   8055:         return;
                   8056:     }
                   8057: 
                   8058:     sub end_data_table_count {
                   8059:         shift(@row_count);
                   8060:         return;
                   8061:     }
                   8062: 
1.347     albertel 8063:     sub start_data_table {
1.1018    raeburn  8064: 	my ($add_class,$id) = @_;
1.422     albertel 8065: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  8066:         my $table_id;
                   8067:         if (defined($id)) {
                   8068:             $table_id = ' id="'.$id.'"';
                   8069:         }
1.961     onken    8070: 	&start_data_table_count();
1.1018    raeburn  8071: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 8072:     }
                   8073: 
                   8074:     sub end_data_table {
1.961     onken    8075: 	&end_data_table_count();
1.389     albertel 8076: 	return '</table>'."\n";;
1.347     albertel 8077:     }
                   8078: 
                   8079:     sub start_data_table_row {
1.974     wenzelju 8080: 	my ($add_class, $id) = @_;
1.610     albertel 8081: 	$row_count[0]++;
                   8082: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   8083: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 8084:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8085:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 8086:     }
1.471     banghart 8087:     
                   8088:     sub continue_data_table_row {
1.974     wenzelju 8089: 	my ($add_class, $id) = @_;
1.610     albertel 8090: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 8091: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   8092:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8093:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 8094:     }
1.347     albertel 8095: 
                   8096:     sub end_data_table_row {
1.389     albertel 8097: 	return '</tr>'."\n";;
1.347     albertel 8098:     }
1.367     www      8099: 
1.421     albertel 8100:     sub start_data_table_empty_row {
1.707     bisitz   8101: #	$row_count[0]++;
1.421     albertel 8102: 	return  '<tr class="LC_empty_row" >'."\n";;
                   8103:     }
                   8104: 
                   8105:     sub end_data_table_empty_row {
                   8106: 	return '</tr>'."\n";;
                   8107:     }
                   8108: 
1.367     www      8109:     sub start_data_table_header_row {
1.389     albertel 8110: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      8111:     }
                   8112: 
                   8113:     sub end_data_table_header_row {
1.389     albertel 8114: 	return '</tr>'."\n";;
1.367     www      8115:     }
1.890     droeschl 8116: 
                   8117:     sub data_table_caption {
                   8118:         my $caption = shift;
                   8119:         return "<caption class=\"LC_caption\">$caption</caption>";
                   8120:     }
1.347     albertel 8121: }
                   8122: 
1.548     albertel 8123: =pod
                   8124: 
                   8125: =item * &inhibit_menu_check($arg)
                   8126: 
                   8127: Checks for a inhibitmenu state and generates output to preserve it
                   8128: 
                   8129: Inputs:         $arg - can be any of
                   8130:                      - undef - in which case the return value is a string 
                   8131:                                to add  into arguments list of a uri
                   8132:                      - 'input' - in which case the return value is a HTML
                   8133:                                  <form> <input> field of type hidden to
                   8134:                                  preserve the value
                   8135:                      - a url - in which case the return value is the url with
                   8136:                                the neccesary cgi args added to preserve the
                   8137:                                inhibitmenu state
                   8138:                      - a ref to a url - no return value, but the string is
                   8139:                                         updated to include the neccessary cgi
                   8140:                                         args to preserve the inhibitmenu state
                   8141: 
                   8142: =cut
                   8143: 
                   8144: sub inhibit_menu_check {
                   8145:     my ($arg) = @_;
                   8146:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   8147:     if ($arg eq 'input') {
                   8148: 	if ($env{'form.inhibitmenu'}) {
                   8149: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   8150: 	} else {
                   8151: 	    return
                   8152: 	}
                   8153:     }
                   8154:     if ($env{'form.inhibitmenu'}) {
                   8155: 	if (ref($arg)) {
                   8156: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8157: 	} elsif ($arg eq '') {
                   8158: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8159: 	} else {
                   8160: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8161: 	}
                   8162:     }
                   8163:     if (!ref($arg)) {
                   8164: 	return $arg;
                   8165:     }
                   8166: }
                   8167: 
1.251     albertel 8168: ###############################################
1.182     matthew  8169: 
                   8170: =pod
                   8171: 
1.549     albertel 8172: =back
                   8173: 
                   8174: =head1 User Information Routines
                   8175: 
                   8176: =over 4
                   8177: 
1.405     albertel 8178: =item * &get_users_function()
1.182     matthew  8179: 
                   8180: Used by &bodytag to determine the current users primary role.
                   8181: Returns either 'student','coordinator','admin', or 'author'.
                   8182: 
                   8183: =cut
                   8184: 
                   8185: ###############################################
                   8186: sub get_users_function {
1.815     tempelho 8187:     my $function = 'norole';
1.818     tempelho 8188:     if ($env{'request.role'}=~/^(st)/) {
                   8189:         $function='student';
                   8190:     }
1.907     raeburn  8191:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8192:         $function='coordinator';
                   8193:     }
1.258     albertel 8194:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8195:         $function='admin';
                   8196:     }
1.826     bisitz   8197:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8198:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8199:         $function='author';
                   8200:     }
                   8201:     return $function;
1.54      www      8202: }
1.99      www      8203: 
                   8204: ###############################################
                   8205: 
1.233     raeburn  8206: =pod
                   8207: 
1.821     raeburn  8208: =item * &show_course()
                   8209: 
                   8210: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8211: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8212: 
                   8213: Inputs:
                   8214: None
                   8215: 
                   8216: Outputs:
                   8217: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8218: 
                   8219: =cut
                   8220: 
                   8221: ###############################################
                   8222: sub show_course {
                   8223:     my $course = !$env{'user.adv'};
                   8224:     if (!$env{'user.adv'}) {
                   8225:         foreach my $env (keys(%env)) {
                   8226:             next if ($env !~ m/^user\.priv\./);
                   8227:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8228:                 $course = 0;
                   8229:                 last;
                   8230:             }
                   8231:         }
                   8232:     }
                   8233:     return $course;
                   8234: }
                   8235: 
                   8236: ###############################################
                   8237: 
                   8238: =pod
                   8239: 
1.542     raeburn  8240: =item * &check_user_status()
1.274     raeburn  8241: 
                   8242: Determines current status of supplied role for a
                   8243: specific user. Roles can be active, previous or future.
                   8244: 
                   8245: Inputs: 
                   8246: user's domain, user's username, course's domain,
1.375     raeburn  8247: course's number, optional section ID.
1.274     raeburn  8248: 
                   8249: Outputs:
                   8250: role status: active, previous or future. 
                   8251: 
                   8252: =cut
                   8253: 
                   8254: sub check_user_status {
1.412     raeburn  8255:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8256:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274     raeburn  8257:     my @uroles = keys %userinfo;
                   8258:     my $srchstr;
                   8259:     my $active_chk = 'none';
1.412     raeburn  8260:     my $now = time;
1.274     raeburn  8261:     if (@uroles > 0) {
1.908     raeburn  8262:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8263:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8264:         } else {
1.412     raeburn  8265:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8266:         }
                   8267:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8268:             my $role_end = 0;
                   8269:             my $role_start = 0;
                   8270:             $active_chk = 'active';
1.412     raeburn  8271:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8272:                 $role_end = $1;
                   8273:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8274:                     $role_start = $1;
1.274     raeburn  8275:                 }
                   8276:             }
                   8277:             if ($role_start > 0) {
1.412     raeburn  8278:                 if ($now < $role_start) {
1.274     raeburn  8279:                     $active_chk = 'future';
                   8280:                 }
                   8281:             }
                   8282:             if ($role_end > 0) {
1.412     raeburn  8283:                 if ($now > $role_end) {
1.274     raeburn  8284:                     $active_chk = 'previous';
                   8285:                 }
                   8286:             }
                   8287:         }
                   8288:     }
                   8289:     return $active_chk;
                   8290: }
                   8291: 
                   8292: ###############################################
                   8293: 
                   8294: =pod
                   8295: 
1.405     albertel 8296: =item * &get_sections()
1.233     raeburn  8297: 
                   8298: Determines all the sections for a course including
                   8299: sections with students and sections containing other roles.
1.419     raeburn  8300: Incoming parameters: 
                   8301: 
                   8302: 1. domain
                   8303: 2. course number 
                   8304: 3. reference to array containing roles for which sections should 
                   8305: be gathered (optional).
                   8306: 4. reference to array containing status types for which sections 
                   8307: should be gathered (optional).
                   8308: 
                   8309: If the third argument is undefined, sections are gathered for any role. 
                   8310: If the fourth argument is undefined, sections are gathered for any status.
                   8311: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  8312:  
1.374     raeburn  8313: Returns section hash (keys are section IDs, values are
                   8314: number of users in each section), subject to the
1.419     raeburn  8315: optional roles filter, optional status filter 
1.233     raeburn  8316: 
                   8317: =cut
                   8318: 
                   8319: ###############################################
                   8320: sub get_sections {
1.419     raeburn  8321:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 8322:     if (!defined($cdom) || !defined($cnum)) {
                   8323:         my $cid =  $env{'request.course.id'};
                   8324: 
                   8325: 	return if (!defined($cid));
                   8326: 
                   8327:         $cdom = $env{'course.'.$cid.'.domain'};
                   8328:         $cnum = $env{'course.'.$cid.'.num'};
                   8329:     }
                   8330: 
                   8331:     my %sectioncount;
1.419     raeburn  8332:     my $now = time;
1.240     albertel 8333: 
1.1075.2.33  raeburn  8334:     my $check_students = 1;
                   8335:     my $only_students = 0;
                   8336:     if (ref($possible_roles) eq 'ARRAY') {
                   8337:         if (grep(/^st$/,@{$possible_roles})) {
                   8338:             if (@{$possible_roles} == 1) {
                   8339:                 $only_students = 1;
                   8340:             }
                   8341:         } else {
                   8342:             $check_students = 0;
                   8343:         }
                   8344:     }
                   8345: 
                   8346:     if ($check_students) {
1.276     albertel 8347: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 8348: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   8349: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  8350:         my $start_index = &Apache::loncoursedata::CL_START();
                   8351:         my $end_index = &Apache::loncoursedata::CL_END();
                   8352:         my $status;
1.366     albertel 8353: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  8354: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   8355: 				                     $data->[$status_index],
                   8356:                                                      $data->[$start_index],
                   8357:                                                      $data->[$end_index]);
                   8358:             if ($stu_status eq 'Active') {
                   8359:                 $status = 'active';
                   8360:             } elsif ($end < $now) {
                   8361:                 $status = 'previous';
                   8362:             } elsif ($start > $now) {
                   8363:                 $status = 'future';
                   8364:             } 
                   8365: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   8366:                 if ((!defined($possible_status)) || (($status ne '') && 
                   8367:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   8368: 		    $sectioncount{$section}++;
                   8369:                 }
1.240     albertel 8370: 	    }
                   8371: 	}
                   8372:     }
1.1075.2.33  raeburn  8373:     if ($only_students) {
                   8374:         return %sectioncount;
                   8375:     }
1.240     albertel 8376:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8377:     foreach my $user (sort(keys(%courseroles))) {
                   8378: 	if ($user !~ /^(\w{2})/) { next; }
                   8379: 	my ($role) = ($user =~ /^(\w{2})/);
                   8380: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  8381: 	my ($section,$status);
1.240     albertel 8382: 	if ($role eq 'cr' &&
                   8383: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   8384: 	    $section=$1;
                   8385: 	}
                   8386: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   8387: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  8388:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   8389:         if ($end == -1 && $start == -1) {
                   8390:             next; #deleted role
                   8391:         }
                   8392:         if (!defined($possible_status)) { 
                   8393:             $sectioncount{$section}++;
                   8394:         } else {
                   8395:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   8396:                 $status = 'active';
                   8397:             } elsif ($end < $now) {
                   8398:                 $status = 'future';
                   8399:             } elsif ($start > $now) {
                   8400:                 $status = 'previous';
                   8401:             }
                   8402:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   8403:                 $sectioncount{$section}++;
                   8404:             }
                   8405:         }
1.233     raeburn  8406:     }
1.366     albertel 8407:     return %sectioncount;
1.233     raeburn  8408: }
                   8409: 
1.274     raeburn  8410: ###############################################
1.294     raeburn  8411: 
                   8412: =pod
1.405     albertel 8413: 
                   8414: =item * &get_course_users()
                   8415: 
1.275     raeburn  8416: Retrieves usernames:domains for users in the specified course
                   8417: with specific role(s), and access status. 
                   8418: 
                   8419: Incoming parameters:
1.277     albertel 8420: 1. course domain
                   8421: 2. course number
                   8422: 3. access status: users must have - either active, 
1.275     raeburn  8423: previous, future, or all.
1.277     albertel 8424: 4. reference to array of permissible roles
1.288     raeburn  8425: 5. reference to array of section restrictions (optional)
                   8426: 6. reference to results object (hash of hashes).
                   8427: 7. reference to optional userdata hash
1.609     raeburn  8428: 8. reference to optional statushash
1.630     raeburn  8429: 9. flag if privileged users (except those set to unhide in
                   8430:    course settings) should be excluded    
1.609     raeburn  8431: Keys of top level results hash are roles.
1.275     raeburn  8432: Keys of inner hashes are username:domain, with 
                   8433: values set to access type.
1.288     raeburn  8434: Optional userdata hash returns an array with arguments in the 
                   8435: same order as loncoursedata::get_classlist() for student data.
                   8436: 
1.609     raeburn  8437: Optional statushash returns
                   8438: 
1.288     raeburn  8439: Entries for end, start, section and status are blank because
                   8440: of the possibility of multiple values for non-student roles.
                   8441: 
1.275     raeburn  8442: =cut
1.405     albertel 8443: 
1.275     raeburn  8444: ###############################################
1.405     albertel 8445: 
1.275     raeburn  8446: sub get_course_users {
1.630     raeburn  8447:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  8448:     my %idx = ();
1.419     raeburn  8449:     my %seclists;
1.288     raeburn  8450: 
                   8451:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   8452:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   8453:     $idx{end} = &Apache::loncoursedata::CL_END();
                   8454:     $idx{start} = &Apache::loncoursedata::CL_START();
                   8455:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   8456:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   8457:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   8458:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   8459: 
1.290     albertel 8460:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 8461:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  8462:         my $now = time;
1.277     albertel 8463:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  8464:             my $match = 0;
1.412     raeburn  8465:             my $secmatch = 0;
1.419     raeburn  8466:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  8467:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  8468:             if ($section eq '') {
                   8469:                 $section = 'none';
                   8470:             }
1.291     albertel 8471:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8472:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8473:                     $secmatch = 1;
                   8474:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 8475:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8476:                         $secmatch = 1;
                   8477:                     }
                   8478:                 } else {  
1.419     raeburn  8479: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  8480: 		        $secmatch = 1;
                   8481:                     }
1.290     albertel 8482: 		}
1.412     raeburn  8483:                 if (!$secmatch) {
                   8484:                     next;
                   8485:                 }
1.419     raeburn  8486:             }
1.275     raeburn  8487:             if (defined($$types{'active'})) {
1.288     raeburn  8488:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  8489:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  8490:                     $match = 1;
1.275     raeburn  8491:                 }
                   8492:             }
                   8493:             if (defined($$types{'previous'})) {
1.609     raeburn  8494:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  8495:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  8496:                     $match = 1;
1.275     raeburn  8497:                 }
                   8498:             }
                   8499:             if (defined($$types{'future'})) {
1.609     raeburn  8500:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  8501:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  8502:                     $match = 1;
1.275     raeburn  8503:                 }
                   8504:             }
1.609     raeburn  8505:             if ($match) {
                   8506:                 push(@{$seclists{$student}},$section);
                   8507:                 if (ref($userdata) eq 'HASH') {
                   8508:                     $$userdata{$student} = $$classlist{$student};
                   8509:                 }
                   8510:                 if (ref($statushash) eq 'HASH') {
                   8511:                     $statushash->{$student}{'st'}{$section} = $status;
                   8512:                 }
1.288     raeburn  8513:             }
1.275     raeburn  8514:         }
                   8515:     }
1.412     raeburn  8516:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  8517:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8518:         my $now = time;
1.609     raeburn  8519:         my %displaystatus = ( previous => 'Expired',
                   8520:                               active   => 'Active',
                   8521:                               future   => 'Future',
                   8522:                             );
1.1075.2.36  raeburn  8523:         my (%nothide,@possdoms);
1.630     raeburn  8524:         if ($hidepriv) {
                   8525:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   8526:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   8527:                 if ($user !~ /:/) {
                   8528:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   8529:                 } else {
                   8530:                     $nothide{$user} = 1;
                   8531:                 }
                   8532:             }
1.1075.2.36  raeburn  8533:             my @possdoms = ($cdom);
                   8534:             if ($coursehash{'checkforpriv'}) {
                   8535:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   8536:             }
1.630     raeburn  8537:         }
1.439     raeburn  8538:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  8539:             my $match = 0;
1.412     raeburn  8540:             my $secmatch = 0;
1.439     raeburn  8541:             my $status;
1.412     raeburn  8542:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  8543:             $user =~ s/:$//;
1.439     raeburn  8544:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   8545:             if ($end == -1 || $start == -1) {
                   8546:                 next;
                   8547:             }
                   8548:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   8549:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  8550:                 my ($uname,$udom) = split(/:/,$user);
                   8551:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8552:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8553:                         $secmatch = 1;
                   8554:                     } elsif ($usec eq '') {
1.420     albertel 8555:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8556:                             $secmatch = 1;
                   8557:                         }
                   8558:                     } else {
                   8559:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   8560:                             $secmatch = 1;
                   8561:                         }
                   8562:                     }
                   8563:                     if (!$secmatch) {
                   8564:                         next;
                   8565:                     }
1.288     raeburn  8566:                 }
1.419     raeburn  8567:                 if ($usec eq '') {
                   8568:                     $usec = 'none';
                   8569:                 }
1.275     raeburn  8570:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  8571:                     if ($hidepriv) {
1.1075.2.36  raeburn  8572:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  8573:                             (!$nothide{$uname.':'.$udom})) {
                   8574:                             next;
                   8575:                         }
                   8576:                     }
1.503     raeburn  8577:                     if ($end > 0 && $end < $now) {
1.439     raeburn  8578:                         $status = 'previous';
                   8579:                     } elsif ($start > $now) {
                   8580:                         $status = 'future';
                   8581:                     } else {
                   8582:                         $status = 'active';
                   8583:                     }
1.277     albertel 8584:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  8585:                         if ($status eq $type) {
1.420     albertel 8586:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  8587:                                 push(@{$$users{$role}{$user}},$type);
                   8588:                             }
1.288     raeburn  8589:                             $match = 1;
                   8590:                         }
                   8591:                     }
1.419     raeburn  8592:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   8593:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   8594: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   8595:                         }
1.420     albertel 8596:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  8597:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   8598:                         }
1.609     raeburn  8599:                         if (ref($statushash) eq 'HASH') {
                   8600:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   8601:                         }
1.275     raeburn  8602:                     }
                   8603:                 }
                   8604:             }
                   8605:         }
1.290     albertel 8606:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  8607:             if ((defined($cdom)) && (defined($cnum))) {
                   8608:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   8609:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   8610:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  8611:                     next if ($owner eq '');
                   8612:                     my ($ownername,$ownerdom);
                   8613:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   8614:                         $ownername = $1;
                   8615:                         $ownerdom = $2;
                   8616:                     } else {
                   8617:                         $ownername = $owner;
                   8618:                         $ownerdom = $cdom;
                   8619:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  8620:                     }
                   8621:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 8622:                     if (defined($userdata) && 
1.609     raeburn  8623: 			!exists($$userdata{$owner})) {
                   8624: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   8625:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   8626:                             push(@{$seclists{$owner}},'none');
                   8627:                         }
                   8628:                         if (ref($statushash) eq 'HASH') {
                   8629:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  8630:                         }
1.290     albertel 8631: 		    }
1.279     raeburn  8632:                 }
                   8633:             }
                   8634:         }
1.419     raeburn  8635:         foreach my $user (keys(%seclists)) {
                   8636:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   8637:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   8638:         }
1.275     raeburn  8639:     }
                   8640:     return;
                   8641: }
                   8642: 
1.288     raeburn  8643: sub get_user_info {
                   8644:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 8645:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   8646: 	&plainname($uname,$udom,'lastname');
1.291     albertel 8647:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  8648:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  8649:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   8650:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  8651:     return;
                   8652: }
1.275     raeburn  8653: 
1.472     raeburn  8654: ###############################################
                   8655: 
                   8656: =pod
                   8657: 
                   8658: =item * &get_user_quota()
                   8659: 
1.1075.2.41  raeburn  8660: Retrieves quota assigned for storage of user files.
                   8661: Default is to report quota for portfolio files.
1.472     raeburn  8662: 
                   8663: Incoming parameters:
                   8664: 1. user's username
                   8665: 2. user's domain
1.1075.2.41  raeburn  8666: 3. quota name - portfolio, author, or course
                   8667:    (if no quota name provided, defaults to portfolio).
1.1075.2.42  raeburn  8668: 4. crstype - official, unofficial or community, if quota name is
                   8669:    course
1.472     raeburn  8670: 
                   8671: Returns:
1.536     raeburn  8672: 1. Disk quota (in Mb) assigned to student.
                   8673: 2. (Optional) Type of setting: custom or default
                   8674:    (individually assigned or default for user's 
                   8675:    institutional status).
                   8676: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   8677:    or student - types as defined in localenroll::inst_usertypes 
                   8678:    for user's domain, which determines default quota for user.
                   8679: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  8680: 
                   8681: If a value has been stored in the user's environment, 
1.536     raeburn  8682: it will return that, otherwise it returns the maximal default
1.1075.2.41  raeburn  8683: defined for the user's institutional status(es) in the domain.
1.472     raeburn  8684: 
                   8685: =cut
                   8686: 
                   8687: ###############################################
                   8688: 
                   8689: 
                   8690: sub get_user_quota {
1.1075.2.42  raeburn  8691:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  8692:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  8693:     if (!defined($udom)) {
                   8694:         $udom = $env{'user.domain'};
                   8695:     }
                   8696:     if (!defined($uname)) {
                   8697:         $uname = $env{'user.name'};
                   8698:     }
                   8699:     if (($udom eq '' || $uname eq '') ||
                   8700:         ($udom eq 'public') && ($uname eq 'public')) {
                   8701:         $quota = 0;
1.536     raeburn  8702:         $quotatype = 'default';
                   8703:         $defquota = 0; 
1.472     raeburn  8704:     } else {
1.536     raeburn  8705:         my $inststatus;
1.1075.2.41  raeburn  8706:         if ($quotaname eq 'course') {
                   8707:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   8708:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   8709:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   8710:             } else {
                   8711:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   8712:                 $quota = $cenv{'internal.uploadquota'};
                   8713:             }
1.536     raeburn  8714:         } else {
1.1075.2.41  raeburn  8715:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   8716:                 if ($quotaname eq 'author') {
                   8717:                     $quota = $env{'environment.authorquota'};
                   8718:                 } else {
                   8719:                     $quota = $env{'environment.portfolioquota'};
                   8720:                 }
                   8721:                 $inststatus = $env{'environment.inststatus'};
                   8722:             } else {
                   8723:                 my %userenv = 
                   8724:                     &Apache::lonnet::get('environment',['portfolioquota',
                   8725:                                          'authorquota','inststatus'],$udom,$uname);
                   8726:                 my ($tmp) = keys(%userenv);
                   8727:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8728:                     if ($quotaname eq 'author') {
                   8729:                         $quota = $userenv{'authorquota'};
                   8730:                     } else {
                   8731:                         $quota = $userenv{'portfolioquota'};
                   8732:                     }
                   8733:                     $inststatus = $userenv{'inststatus'};
                   8734:                 } else {
                   8735:                     undef(%userenv);
                   8736:                 }
                   8737:             }
                   8738:         }
                   8739:         if ($quota eq '' || wantarray) {
                   8740:             if ($quotaname eq 'course') {
                   8741:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.42  raeburn  8742:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') || ($crstype eq 'community')) {
                   8743:                     $defquota = $domdefs{$crstype.'quota'};
                   8744:                 }
                   8745:                 if ($defquota eq '') {
                   8746:                     $defquota = 500;
                   8747:                 }
1.1075.2.41  raeburn  8748:             } else {
                   8749:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   8750:             }
                   8751:             if ($quota eq '') {
                   8752:                 $quota = $defquota;
                   8753:                 $quotatype = 'default';
                   8754:             } else {
                   8755:                 $quotatype = 'custom';
                   8756:             }
1.472     raeburn  8757:         }
                   8758:     }
1.536     raeburn  8759:     if (wantarray) {
                   8760:         return ($quota,$quotatype,$settingstatus,$defquota);
                   8761:     } else {
                   8762:         return $quota;
                   8763:     }
1.472     raeburn  8764: }
                   8765: 
                   8766: ###############################################
                   8767: 
                   8768: =pod
                   8769: 
                   8770: =item * &default_quota()
                   8771: 
1.536     raeburn  8772: Retrieves default quota assigned for storage of user portfolio files,
                   8773: given an (optional) user's institutional status.
1.472     raeburn  8774: 
                   8775: Incoming parameters:
1.1075.2.42  raeburn  8776: 
1.472     raeburn  8777: 1. domain
1.536     raeburn  8778: 2. (Optional) institutional status(es).  This is a : separated list of 
                   8779:    status types (e.g., faculty, staff, student etc.)
                   8780:    which apply to the user for whom the default is being retrieved.
                   8781:    If the institutional status string in undefined, the domain
1.1075.2.41  raeburn  8782:    default quota will be returned.
                   8783: 3.  quota name - portfolio, author, or course
                   8784:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  8785: 
                   8786: Returns:
1.1075.2.42  raeburn  8787: 
1.472     raeburn  8788: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  8789: 2. (Optional) institutional type which determined the value of the
                   8790:    default quota.
1.472     raeburn  8791: 
                   8792: If a value has been stored in the domain's configuration db,
                   8793: it will return that, otherwise it returns 20 (for backwards 
                   8794: compatibility with domains which have not set up a configuration
                   8795: db file; the original statically defined portfolio quota was 20 Mb). 
                   8796: 
1.536     raeburn  8797: If the user's status includes multiple types (e.g., staff and student),
                   8798: the largest default quota which applies to the user determines the
                   8799: default quota returned.
                   8800: 
1.472     raeburn  8801: =cut
                   8802: 
                   8803: ###############################################
                   8804: 
                   8805: 
                   8806: sub default_quota {
1.1075.2.41  raeburn  8807:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  8808:     my ($defquota,$settingstatus);
                   8809:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  8810:                                             ['quotas'],$udom);
1.1075.2.41  raeburn  8811:     my $key = 'defaultquota';
                   8812:     if ($quotaname eq 'author') {
                   8813:         $key = 'authorquota';
                   8814:     }
1.622     raeburn  8815:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  8816:         if ($inststatus ne '') {
1.765     raeburn  8817:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  8818:             foreach my $item (@statuses) {
1.1075.2.41  raeburn  8819:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8820:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  8821:                         if ($defquota eq '') {
1.1075.2.41  raeburn  8822:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8823:                             $settingstatus = $item;
1.1075.2.41  raeburn  8824:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   8825:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8826:                             $settingstatus = $item;
                   8827:                         }
                   8828:                     }
1.1075.2.41  raeburn  8829:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  8830:                     if ($quotahash{'quotas'}{$item} ne '') {
                   8831:                         if ($defquota eq '') {
                   8832:                             $defquota = $quotahash{'quotas'}{$item};
                   8833:                             $settingstatus = $item;
                   8834:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   8835:                             $defquota = $quotahash{'quotas'}{$item};
                   8836:                             $settingstatus = $item;
                   8837:                         }
1.536     raeburn  8838:                     }
                   8839:                 }
                   8840:             }
                   8841:         }
                   8842:         if ($defquota eq '') {
1.1075.2.41  raeburn  8843:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8844:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   8845:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  8846:                 $defquota = $quotahash{'quotas'}{'default'};
                   8847:             }
1.536     raeburn  8848:             $settingstatus = 'default';
1.1075.2.42  raeburn  8849:             if ($defquota eq '') {
                   8850:                 if ($quotaname eq 'author') {
                   8851:                     $defquota = 500;
                   8852:                 }
                   8853:             }
1.536     raeburn  8854:         }
                   8855:     } else {
                   8856:         $settingstatus = 'default';
1.1075.2.41  raeburn  8857:         if ($quotaname eq 'author') {
                   8858:             $defquota = 500;
                   8859:         } else {
                   8860:             $defquota = 20;
                   8861:         }
1.536     raeburn  8862:     }
                   8863:     if (wantarray) {
                   8864:         return ($defquota,$settingstatus);
1.472     raeburn  8865:     } else {
1.536     raeburn  8866:         return $defquota;
1.472     raeburn  8867:     }
                   8868: }
                   8869: 
1.1075.2.41  raeburn  8870: ###############################################
                   8871: 
                   8872: =pod
                   8873: 
1.1075.2.42  raeburn  8874: =item * &excess_filesize_warning()
1.1075.2.41  raeburn  8875: 
                   8876: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42  raeburn  8877: of existing file within authoring space will cause quota for the authoring
                   8878: space to be exceeded.
                   8879: 
                   8880: Same, if upload of a file directly to a course/community via Course Editor
                   8881: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41  raeburn  8882: 
                   8883: Inputs: 6
1.1075.2.42  raeburn  8884: 1. username or coursenum
1.1075.2.41  raeburn  8885: 2. domain
1.1075.2.42  raeburn  8886: 3. context ('author' or 'course')
1.1075.2.41  raeburn  8887: 4. filename of file for which action is being requested
                   8888: 5. filesize (kB) of file
                   8889: 6. action being taken: copy or upload.
                   8890: 
                   8891: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
                   8892:          otherwise return null.
                   8893: 
1.1075.2.42  raeburn  8894: =back
                   8895: 
1.1075.2.41  raeburn  8896: =cut
                   8897: 
1.1075.2.42  raeburn  8898: sub excess_filesize_warning {
                   8899:     my ($uname,$udom,$context,$filename,$filesize,$action) = @_;
                   8900:     my $current_disk_usage = 0;
                   8901:     my $disk_quota = &get_user_quota($uname,$udom,$context); #expressed in MB
                   8902:     if ($context eq 'author') {
                   8903:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   8904:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   8905:     } else {
                   8906:         foreach my $subdir ('docs','supplemental') {
                   8907:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   8908:         }
                   8909:     }
1.1075.2.41  raeburn  8910:     $disk_quota = int($disk_quota * 1000);
                   8911:     if (($current_disk_usage + $filesize) > $disk_quota) {
                   8912:         return '<p><span class="LC_warning">'.
                   8913:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
                   8914:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</span>'.
                   8915:                '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   8916:                             $disk_quota,$current_disk_usage).
                   8917:                '</p>';
                   8918:     }
                   8919:     return;
                   8920: }
                   8921: 
                   8922: ###############################################
                   8923: 
                   8924: 
1.384     raeburn  8925: sub get_secgrprole_info {
                   8926:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   8927:     my %sections_count = &get_sections($cdom,$cnum);
                   8928:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   8929:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   8930:     my @groups = sort(keys(%curr_groups));
                   8931:     my $allroles = [];
                   8932:     my $rolehash;
                   8933:     my $accesshash = {
                   8934:                      active => 'Currently has access',
                   8935:                      future => 'Will have future access',
                   8936:                      previous => 'Previously had access',
                   8937:                   };
                   8938:     if ($needroles) {
                   8939:         $rolehash = {'all' => 'all'};
1.385     albertel 8940:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8941: 	if (&Apache::lonnet::error(%user_roles)) {
                   8942: 	    undef(%user_roles);
                   8943: 	}
                   8944:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  8945:             my ($role)=split(/\:/,$item,2);
                   8946:             if ($role eq 'cr') { next; }
                   8947:             if ($role =~ /^cr/) {
                   8948:                 $$rolehash{$role} = (split('/',$role))[3];
                   8949:             } else {
                   8950:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   8951:             }
                   8952:         }
                   8953:         foreach my $key (sort(keys(%{$rolehash}))) {
                   8954:             push(@{$allroles},$key);
                   8955:         }
                   8956:         push (@{$allroles},'st');
                   8957:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   8958:     }
                   8959:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   8960: }
                   8961: 
1.555     raeburn  8962: sub user_picker {
1.994     raeburn  8963:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  8964:     my $currdom = $dom;
                   8965:     my %curr_selected = (
                   8966:                         srchin => 'dom',
1.580     raeburn  8967:                         srchby => 'lastname',
1.555     raeburn  8968:                       );
                   8969:     my $srchterm;
1.625     raeburn  8970:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  8971:         if ($srch->{'srchby'} ne '') {
                   8972:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   8973:         }
                   8974:         if ($srch->{'srchin'} ne '') {
                   8975:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   8976:         }
                   8977:         if ($srch->{'srchtype'} ne '') {
                   8978:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   8979:         }
                   8980:         if ($srch->{'srchdomain'} ne '') {
                   8981:             $currdom = $srch->{'srchdomain'};
                   8982:         }
                   8983:         $srchterm = $srch->{'srchterm'};
                   8984:     }
                   8985:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  8986:                     'usr'       => 'Search criteria',
1.563     raeburn  8987:                     'doma'      => 'Domain/institution to search',
1.558     albertel 8988:                     'uname'     => 'username',
                   8989:                     'lastname'  => 'last name',
1.555     raeburn  8990:                     'lastfirst' => 'last name, first name',
1.558     albertel 8991:                     'crs'       => 'in this course',
1.576     raeburn  8992:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 8993:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  8994:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 8995:                     'exact'     => 'is',
                   8996:                     'contains'  => 'contains',
1.569     raeburn  8997:                     'begins'    => 'begins with',
1.571     raeburn  8998:                     'youm'      => "You must include some text to search for.",
                   8999:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   9000:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   9001:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   9002:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   9003:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   9004:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   9005:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  9006:                                        );
1.563     raeburn  9007:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   9008:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  9009: 
                   9010:     my @srchins = ('crs','dom','alc','instd');
                   9011: 
                   9012:     foreach my $option (@srchins) {
                   9013:         # FIXME 'alc' option unavailable until 
                   9014:         #       loncreateuser::print_user_query_page()
                   9015:         #       has been completed.
                   9016:         next if ($option eq 'alc');
1.880     raeburn  9017:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  9018:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  9019:         if ($curr_selected{'srchin'} eq $option) {
                   9020:             $srchinsel .= ' 
                   9021:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9022:         } else {
                   9023:             $srchinsel .= '
                   9024:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9025:         }
1.555     raeburn  9026:     }
1.563     raeburn  9027:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  9028: 
                   9029:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  9030:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  9031:         if ($curr_selected{'srchby'} eq $option) {
                   9032:             $srchbysel .= '
                   9033:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9034:         } else {
                   9035:             $srchbysel .= '
                   9036:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9037:          }
                   9038:     }
                   9039:     $srchbysel .= "\n  </select>\n";
                   9040: 
                   9041:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  9042:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  9043:         if ($curr_selected{'srchtype'} eq $option) {
                   9044:             $srchtypesel .= '
                   9045:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9046:         } else {
                   9047:             $srchtypesel .= '
                   9048:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9049:         }
                   9050:     }
                   9051:     $srchtypesel .= "\n  </select>\n";
                   9052: 
1.558     albertel 9053:     my ($newuserscript,$new_user_create);
1.994     raeburn  9054:     my $context_dom = $env{'request.role.domain'};
                   9055:     if ($context eq 'requestcrs') {
                   9056:         if ($env{'form.coursedom'} ne '') { 
                   9057:             $context_dom = $env{'form.coursedom'};
                   9058:         }
                   9059:     }
1.556     raeburn  9060:     if ($forcenewuser) {
1.576     raeburn  9061:         if (ref($srch) eq 'HASH') {
1.994     raeburn  9062:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  9063:                 if ($cancreate) {
                   9064:                     $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>';
                   9065:                 } else {
1.799     bisitz   9066:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  9067:                     my %usertypetext = (
                   9068:                         official   => 'institutional',
                   9069:                         unofficial => 'non-institutional',
                   9070:                     );
1.799     bisitz   9071:                     $new_user_create = '<p class="LC_warning">'
                   9072:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   9073:                                       .' '
                   9074:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   9075:                                           ,'<a href="'.$helplink.'">','</a>')
                   9076:                                       .'</p><br />';
1.627     raeburn  9077:                 }
1.576     raeburn  9078:             }
                   9079:         }
                   9080: 
1.556     raeburn  9081:         $newuserscript = <<"ENDSCRIPT";
                   9082: 
1.570     raeburn  9083: function setSearch(createnew,callingForm) {
1.556     raeburn  9084:     if (createnew == 1) {
1.570     raeburn  9085:         for (var i=0; i<callingForm.srchby.length; i++) {
                   9086:             if (callingForm.srchby.options[i].value == 'uname') {
                   9087:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  9088:             }
                   9089:         }
1.570     raeburn  9090:         for (var i=0; i<callingForm.srchin.length; i++) {
                   9091:             if ( callingForm.srchin.options[i].value == 'dom') {
                   9092: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  9093:             }
                   9094:         }
1.570     raeburn  9095:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   9096:             if (callingForm.srchtype.options[i].value == 'exact') {
                   9097:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  9098:             }
                   9099:         }
1.570     raeburn  9100:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  9101:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  9102:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  9103:             }
                   9104:         }
                   9105:     }
                   9106: }
                   9107: ENDSCRIPT
1.558     albertel 9108: 
1.556     raeburn  9109:     }
                   9110: 
1.555     raeburn  9111:     my $output = <<"END_BLOCK";
1.556     raeburn  9112: <script type="text/javascript">
1.824     bisitz   9113: // <![CDATA[
1.570     raeburn  9114: function validateEntry(callingForm) {
1.558     albertel 9115: 
1.556     raeburn  9116:     var checkok = 1;
1.558     albertel 9117:     var srchin;
1.570     raeburn  9118:     for (var i=0; i<callingForm.srchin.length; i++) {
                   9119: 	if ( callingForm.srchin[i].checked ) {
                   9120: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 9121: 	}
                   9122:     }
                   9123: 
1.570     raeburn  9124:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   9125:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   9126:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   9127:     var srchterm =  callingForm.srchterm.value;
                   9128:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  9129:     var msg = "";
                   9130: 
                   9131:     if (srchterm == "") {
                   9132:         checkok = 0;
1.571     raeburn  9133:         msg += "$lt{'youm'}\\n";
1.556     raeburn  9134:     }
                   9135: 
1.569     raeburn  9136:     if (srchtype== 'begins') {
                   9137:         if (srchterm.length < 2) {
                   9138:             checkok = 0;
1.571     raeburn  9139:             msg += "$lt{'thte'}\\n";
1.569     raeburn  9140:         }
                   9141:     }
                   9142: 
1.556     raeburn  9143:     if (srchtype== 'contains') {
                   9144:         if (srchterm.length < 3) {
                   9145:             checkok = 0;
1.571     raeburn  9146:             msg += "$lt{'thet'}\\n";
1.556     raeburn  9147:         }
                   9148:     }
                   9149:     if (srchin == 'instd') {
                   9150:         if (srchdomain == '') {
                   9151:             checkok = 0;
1.571     raeburn  9152:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  9153:         }
                   9154:     }
                   9155:     if (srchin == 'dom') {
                   9156:         if (srchdomain == '') {
                   9157:             checkok = 0;
1.571     raeburn  9158:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  9159:         }
                   9160:     }
                   9161:     if (srchby == 'lastfirst') {
                   9162:         if (srchterm.indexOf(",") == -1) {
                   9163:             checkok = 0;
1.571     raeburn  9164:             msg += "$lt{'whus'}\\n";
1.556     raeburn  9165:         }
                   9166:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   9167:             checkok = 0;
1.571     raeburn  9168:             msg += "$lt{'whse'}\\n";
1.556     raeburn  9169:         }
                   9170:     }
                   9171:     if (checkok == 0) {
1.571     raeburn  9172:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  9173:         return;
                   9174:     }
                   9175:     if (checkok == 1) {
1.570     raeburn  9176:         callingForm.submit();
1.556     raeburn  9177:     }
                   9178: }
                   9179: 
                   9180: $newuserscript
                   9181: 
1.824     bisitz   9182: // ]]>
1.556     raeburn  9183: </script>
1.558     albertel 9184: 
                   9185: $new_user_create
                   9186: 
1.555     raeburn  9187: END_BLOCK
1.558     albertel 9188: 
1.876     raeburn  9189:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   9190:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   9191:                $domform.
                   9192:                &Apache::lonhtmlcommon::row_closure().
                   9193:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   9194:                $srchbysel.
                   9195:                $srchtypesel. 
                   9196:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   9197:                $srchinsel.
                   9198:                &Apache::lonhtmlcommon::row_closure(1). 
                   9199:                &Apache::lonhtmlcommon::end_pick_box().
                   9200:                '<br />';
1.555     raeburn  9201:     return $output;
                   9202: }
                   9203: 
1.612     raeburn  9204: sub user_rule_check {
1.615     raeburn  9205:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  9206:     my $response;
                   9207:     if (ref($usershash) eq 'HASH') {
                   9208:         foreach my $user (keys(%{$usershash})) {
                   9209:             my ($uname,$udom) = split(/:/,$user);
                   9210:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  9211:             my ($id,$newuser);
1.612     raeburn  9212:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  9213:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  9214:                 $id = $usershash->{$user}->{'id'};
                   9215:             }
                   9216:             my $inst_response;
                   9217:             if (ref($checks) eq 'HASH') {
                   9218:                 if (defined($checks->{'username'})) {
1.615     raeburn  9219:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  9220:                         &Apache::lonnet::get_instuser($udom,$uname);
                   9221:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  9222:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  9223:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   9224:                 }
1.615     raeburn  9225:             } else {
                   9226:                 ($inst_response,%{$inst_results->{$user}}) =
                   9227:                     &Apache::lonnet::get_instuser($udom,$uname);
                   9228:                 return;
1.612     raeburn  9229:             }
1.615     raeburn  9230:             if (!$got_rules->{$udom}) {
1.612     raeburn  9231:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   9232:                                                   ['usercreation'],$udom);
                   9233:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  9234:                     foreach my $item ('username','id') {
1.612     raeburn  9235:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   9236:                             $$curr_rules{$udom}{$item} = 
                   9237:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  9238:                         }
                   9239:                     }
                   9240:                 }
1.615     raeburn  9241:                 $got_rules->{$udom} = 1;  
1.585     raeburn  9242:             }
1.612     raeburn  9243:             foreach my $item (keys(%{$checks})) {
                   9244:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   9245:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   9246:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   9247:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   9248:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   9249:                                 if ($rule_check{$rule}) {
                   9250:                                     $$rulematch{$user}{$item} = $rule;
                   9251:                                     if ($inst_response eq 'ok') {
1.615     raeburn  9252:                                         if (ref($inst_results) eq 'HASH') {
                   9253:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   9254:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   9255:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   9256:                                                 }
1.612     raeburn  9257:                                             }
                   9258:                                         }
1.615     raeburn  9259:                                     }
                   9260:                                     last;
1.585     raeburn  9261:                                 }
                   9262:                             }
                   9263:                         }
                   9264:                     }
                   9265:                 }
                   9266:             }
                   9267:         }
                   9268:     }
1.612     raeburn  9269:     return;
                   9270: }
                   9271: 
                   9272: sub user_rule_formats {
                   9273:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   9274:     my %text = ( 
                   9275:                  'username' => 'Usernames',
                   9276:                  'id'       => 'IDs',
                   9277:                );
                   9278:     my $output;
                   9279:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   9280:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   9281:         if (@{$ruleorder} > 0) {
1.1075.2.20  raeburn  9282:             $output = '<br />'.
                   9283:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   9284:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   9285:                       ' <ul>';
1.612     raeburn  9286:             foreach my $rule (@{$ruleorder}) {
                   9287:                 if (ref($curr_rules) eq 'ARRAY') {
                   9288:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   9289:                         if (ref($rules->{$rule}) eq 'HASH') {
                   9290:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   9291:                                         $rules->{$rule}{'desc'}.'</li>';
                   9292:                         }
                   9293:                     }
                   9294:                 }
                   9295:             }
                   9296:             $output .= '</ul>';
                   9297:         }
                   9298:     }
                   9299:     return $output;
                   9300: }
                   9301: 
                   9302: sub instrule_disallow_msg {
1.615     raeburn  9303:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  9304:     my $response;
                   9305:     my %text = (
                   9306:                   item   => 'username',
                   9307:                   items  => 'usernames',
                   9308:                   match  => 'matches',
                   9309:                   do     => 'does',
                   9310:                   action => 'a username',
                   9311:                   one    => 'one',
                   9312:                );
                   9313:     if ($count > 1) {
                   9314:         $text{'item'} = 'usernames';
                   9315:         $text{'match'} ='match';
                   9316:         $text{'do'} = 'do';
                   9317:         $text{'action'} = 'usernames',
                   9318:         $text{'one'} = 'ones';
                   9319:     }
                   9320:     if ($checkitem eq 'id') {
                   9321:         $text{'items'} = 'IDs';
                   9322:         $text{'item'} = 'ID';
                   9323:         $text{'action'} = 'an ID';
1.615     raeburn  9324:         if ($count > 1) {
                   9325:             $text{'item'} = 'IDs';
                   9326:             $text{'action'} = 'IDs';
                   9327:         }
1.612     raeburn  9328:     }
1.674     bisitz   9329:     $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  9330:     if ($mode eq 'upload') {
                   9331:         if ($checkitem eq 'username') {
                   9332:             $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'}.");
                   9333:         } elsif ($checkitem eq 'id') {
1.674     bisitz   9334:             $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  9335:         }
1.669     raeburn  9336:     } elsif ($mode eq 'selfcreate') {
                   9337:         if ($checkitem eq 'id') {
                   9338:             $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.");
                   9339:         }
1.615     raeburn  9340:     } else {
                   9341:         if ($checkitem eq 'username') {
                   9342:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   9343:         } elsif ($checkitem eq 'id') {
                   9344:             $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.");
                   9345:         }
1.612     raeburn  9346:     }
                   9347:     return $response;
1.585     raeburn  9348: }
                   9349: 
1.624     raeburn  9350: sub personal_data_fieldtitles {
                   9351:     my %fieldtitles = &Apache::lonlocal::texthash (
                   9352:                         id => 'Student/Employee ID',
                   9353:                         permanentemail => 'E-mail address',
                   9354:                         lastname => 'Last Name',
                   9355:                         firstname => 'First Name',
                   9356:                         middlename => 'Middle Name',
                   9357:                         generation => 'Generation',
                   9358:                         gen => 'Generation',
1.765     raeburn  9359:                         inststatus => 'Affiliation',
1.624     raeburn  9360:                    );
                   9361:     return %fieldtitles;
                   9362: }
                   9363: 
1.642     raeburn  9364: sub sorted_inst_types {
                   9365:     my ($dom) = @_;
                   9366:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   9367:     my $othertitle = &mt('All users');
                   9368:     if ($env{'request.course.id'}) {
1.668     raeburn  9369:         $othertitle  = &mt('Any users');
1.642     raeburn  9370:     }
                   9371:     my @types;
                   9372:     if (ref($order) eq 'ARRAY') {
                   9373:         @types = @{$order};
                   9374:     }
                   9375:     if (@types == 0) {
                   9376:         if (ref($usertypes) eq 'HASH') {
                   9377:             @types = sort(keys(%{$usertypes}));
                   9378:         }
                   9379:     }
                   9380:     if (keys(%{$usertypes}) > 0) {
                   9381:         $othertitle = &mt('Other users');
                   9382:     }
                   9383:     return ($othertitle,$usertypes,\@types);
                   9384: }
                   9385: 
1.645     raeburn  9386: sub get_institutional_codes {
                   9387:     my ($settings,$allcourses,$LC_code) = @_;
                   9388: # Get complete list of course sections to update
                   9389:     my @currsections = ();
                   9390:     my @currxlists = ();
                   9391:     my $coursecode = $$settings{'internal.coursecode'};
                   9392: 
                   9393:     if ($$settings{'internal.sectionnums'} ne '') {
                   9394:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   9395:     }
                   9396: 
                   9397:     if ($$settings{'internal.crosslistings'} ne '') {
                   9398:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   9399:     }
                   9400: 
                   9401:     if (@currxlists > 0) {
                   9402:         foreach (@currxlists) {
                   9403:             if (m/^([^:]+):(\w*)$/) {
                   9404:                 unless (grep/^$1$/,@{$allcourses}) {
                   9405:                     push @{$allcourses},$1;
                   9406:                     $$LC_code{$1} = $2;
                   9407:                 }
                   9408:             }
                   9409:         }
                   9410:     }
                   9411:  
                   9412:     if (@currsections > 0) {
                   9413:         foreach (@currsections) {
                   9414:             if (m/^(\w+):(\w*)$/) {
                   9415:                 my $sec = $coursecode.$1;
                   9416:                 my $lc_sec = $2;
                   9417:                 unless (grep/^$sec$/,@{$allcourses}) {
                   9418:                     push @{$allcourses},$sec;
                   9419:                     $$LC_code{$sec} = $lc_sec;
                   9420:                 }
                   9421:             }
                   9422:         }
                   9423:     }
                   9424:     return;
                   9425: }
                   9426: 
1.971     raeburn  9427: sub get_standard_codeitems {
                   9428:     return ('Year','Semester','Department','Number','Section');
                   9429: }
                   9430: 
1.112     bowersj2 9431: =pod
                   9432: 
1.780     raeburn  9433: =head1 Slot Helpers
                   9434: 
                   9435: =over 4
                   9436: 
                   9437: =item * sorted_slots()
                   9438: 
1.1040    raeburn  9439: Sorts an array of slot names in order of an optional sort key,
                   9440: default sort is by slot start time (earliest first). 
1.780     raeburn  9441: 
                   9442: Inputs:
                   9443: 
                   9444: =over 4
                   9445: 
                   9446: slotsarr  - Reference to array of unsorted slot names.
                   9447: 
                   9448: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   9449: 
1.1040    raeburn  9450: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   9451: 
1.549     albertel 9452: =back
                   9453: 
1.780     raeburn  9454: Returns:
                   9455: 
                   9456: =over 4
                   9457: 
1.1040    raeburn  9458: sorted   - An array of slot names sorted by a specified sort key 
                   9459:            (default sort key is start time of the slot).
1.780     raeburn  9460: 
                   9461: =back
                   9462: 
                   9463: =cut
                   9464: 
                   9465: 
                   9466: sub sorted_slots {
1.1040    raeburn  9467:     my ($slotsarr,$slots,$sortkey) = @_;
                   9468:     if ($sortkey eq '') {
                   9469:         $sortkey = 'starttime';
                   9470:     }
1.780     raeburn  9471:     my @sorted;
                   9472:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   9473:         @sorted =
                   9474:             sort {
                   9475:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  9476:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  9477:                      }
                   9478:                      if (ref($slots->{$a})) { return -1;}
                   9479:                      if (ref($slots->{$b})) { return 1;}
                   9480:                      return 0;
                   9481:                  } @{$slotsarr};
                   9482:     }
                   9483:     return @sorted;
                   9484: }
                   9485: 
1.1040    raeburn  9486: =pod
                   9487: 
                   9488: =item * get_future_slots()
                   9489: 
                   9490: Inputs:
                   9491: 
                   9492: =over 4
                   9493: 
                   9494: cnum - course number
                   9495: 
                   9496: cdom - course domain
                   9497: 
                   9498: now - current UNIX time
                   9499: 
                   9500: symb - optional symb
                   9501: 
                   9502: =back
                   9503: 
                   9504: Returns:
                   9505: 
                   9506: =over 4
                   9507: 
                   9508: sorted_reservable - ref to array of student_schedulable slots currently 
                   9509:                     reservable, ordered by end date of reservation period.
                   9510: 
                   9511: reservable_now - ref to hash of student_schedulable slots currently
                   9512:                  reservable.
                   9513: 
                   9514:     Keys in inner hash are:
                   9515:     (a) symb: either blank or symb to which slot use is restricted.
                   9516:     (b) endreserve: end date of reservation period. 
                   9517: 
                   9518: sorted_future - ref to array of student_schedulable slots reservable in
                   9519:                 the future, ordered by start date of reservation period.
                   9520: 
                   9521: future_reservable - ref to hash of student_schedulable slots reservable
                   9522:                     in the future.
                   9523: 
                   9524:     Keys in inner hash are:
                   9525:     (a) symb: either blank or symb to which slot use is restricted.
                   9526:     (b) startreserve:  start date of reservation period.
                   9527: 
                   9528: =back
                   9529: 
                   9530: =cut
                   9531: 
                   9532: sub get_future_slots {
                   9533:     my ($cnum,$cdom,$now,$symb) = @_;
                   9534:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   9535:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   9536:     foreach my $slot (keys(%slots)) {
                   9537:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   9538:         if ($symb) {
                   9539:             next if (($slots{$slot}->{'symb'} ne '') && 
                   9540:                      ($slots{$slot}->{'symb'} ne $symb));
                   9541:         }
                   9542:         if (($slots{$slot}->{'starttime'} > $now) &&
                   9543:             ($slots{$slot}->{'endtime'} > $now)) {
                   9544:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   9545:                 my $userallowed = 0;
                   9546:                 if ($slots{$slot}->{'allowedsections'}) {
                   9547:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   9548:                     if (!defined($env{'request.role.sec'})
                   9549:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   9550:                         $userallowed=1;
                   9551:                     } else {
                   9552:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   9553:                             $userallowed=1;
                   9554:                         }
                   9555:                     }
                   9556:                     unless ($userallowed) {
                   9557:                         if (defined($env{'request.course.groups'})) {
                   9558:                             my @groups = split(/:/,$env{'request.course.groups'});
                   9559:                             foreach my $group (@groups) {
                   9560:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   9561:                                     $userallowed=1;
                   9562:                                     last;
                   9563:                                 }
                   9564:                             }
                   9565:                         }
                   9566:                     }
                   9567:                 }
                   9568:                 if ($slots{$slot}->{'allowedusers'}) {
                   9569:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   9570:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   9571:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   9572:                         $userallowed = 1;
                   9573:                     }
                   9574:                 }
                   9575:                 next unless($userallowed);
                   9576:             }
                   9577:             my $startreserve = $slots{$slot}->{'startreserve'};
                   9578:             my $endreserve = $slots{$slot}->{'endreserve'};
                   9579:             my $symb = $slots{$slot}->{'symb'};
                   9580:             if (($startreserve < $now) &&
                   9581:                 (!$endreserve || $endreserve > $now)) {
                   9582:                 my $lastres = $endreserve;
                   9583:                 if (!$lastres) {
                   9584:                     $lastres = $slots{$slot}->{'starttime'};
                   9585:                 }
                   9586:                 $reservable_now{$slot} = {
                   9587:                                            symb       => $symb,
                   9588:                                            endreserve => $lastres
                   9589:                                          };
                   9590:             } elsif (($startreserve > $now) &&
                   9591:                      (!$endreserve || $endreserve > $startreserve)) {
                   9592:                 $future_reservable{$slot} = {
                   9593:                                               symb         => $symb,
                   9594:                                               startreserve => $startreserve
                   9595:                                             };
                   9596:             }
                   9597:         }
                   9598:     }
                   9599:     my @unsorted_reservable = keys(%reservable_now);
                   9600:     if (@unsorted_reservable > 0) {
                   9601:         @sorted_reservable = 
                   9602:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   9603:     }
                   9604:     my @unsorted_future = keys(%future_reservable);
                   9605:     if (@unsorted_future > 0) {
                   9606:         @sorted_future =
                   9607:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   9608:     }
                   9609:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   9610: }
1.780     raeburn  9611: 
                   9612: =pod
                   9613: 
1.1057    foxr     9614: =back
                   9615: 
1.549     albertel 9616: =head1 HTTP Helpers
                   9617: 
                   9618: =over 4
                   9619: 
1.648     raeburn  9620: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 9621: 
1.258     albertel 9622: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 9623: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 9624: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 9625: 
                   9626: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   9627: $possible_names is an ref to an array of form element names.  As an example:
                   9628: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 9629: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 9630: 
                   9631: =cut
1.1       albertel 9632: 
1.6       albertel 9633: sub get_unprocessed_cgi {
1.25      albertel 9634:   my ($query,$possible_names)= @_;
1.26      matthew  9635:   # $Apache::lonxml::debug=1;
1.356     albertel 9636:   foreach my $pair (split(/&/,$query)) {
                   9637:     my ($name, $value) = split(/=/,$pair);
1.369     www      9638:     $name = &unescape($name);
1.25      albertel 9639:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   9640:       $value =~ tr/+/ /;
                   9641:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 9642:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 9643:     }
1.16      harris41 9644:   }
1.6       albertel 9645: }
                   9646: 
1.112     bowersj2 9647: =pod
                   9648: 
1.648     raeburn  9649: =item * &cacheheader() 
1.112     bowersj2 9650: 
                   9651: returns cache-controlling header code
                   9652: 
                   9653: =cut
                   9654: 
1.7       albertel 9655: sub cacheheader {
1.258     albertel 9656:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 9657:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   9658:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 9659:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   9660:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 9661:     return $output;
1.7       albertel 9662: }
                   9663: 
1.112     bowersj2 9664: =pod
                   9665: 
1.648     raeburn  9666: =item * &no_cache($r) 
1.112     bowersj2 9667: 
                   9668: specifies header code to not have cache
                   9669: 
                   9670: =cut
                   9671: 
1.9       albertel 9672: sub no_cache {
1.216     albertel 9673:     my ($r) = @_;
                   9674:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 9675: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 9676:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   9677:     $r->no_cache(1);
                   9678:     $r->header_out("Expires" => $date);
                   9679:     $r->header_out("Pragma" => "no-cache");
1.123     www      9680: }
                   9681: 
                   9682: sub content_type {
1.181     albertel 9683:     my ($r,$type,$charset) = @_;
1.299     foxr     9684:     if ($r) {
                   9685: 	#  Note that printout.pl calls this with undef for $r.
                   9686: 	&no_cache($r);
                   9687:     }
1.258     albertel 9688:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 9689:     unless ($charset) {
                   9690: 	$charset=&Apache::lonlocal::current_encoding;
                   9691:     }
                   9692:     if ($charset) { $type.='; charset='.$charset; }
                   9693:     if ($r) {
                   9694: 	$r->content_type($type);
                   9695:     } else {
                   9696: 	print("Content-type: $type\n\n");
                   9697:     }
1.9       albertel 9698: }
1.25      albertel 9699: 
1.112     bowersj2 9700: =pod
                   9701: 
1.648     raeburn  9702: =item * &add_to_env($name,$value) 
1.112     bowersj2 9703: 
1.258     albertel 9704: adds $name to the %env hash with value
1.112     bowersj2 9705: $value, if $name already exists, the entry is converted to an array
                   9706: reference and $value is added to the array.
                   9707: 
                   9708: =cut
                   9709: 
1.25      albertel 9710: sub add_to_env {
                   9711:   my ($name,$value)=@_;
1.258     albertel 9712:   if (defined($env{$name})) {
                   9713:     if (ref($env{$name})) {
1.25      albertel 9714:       #already have multiple values
1.258     albertel 9715:       push(@{ $env{$name} },$value);
1.25      albertel 9716:     } else {
                   9717:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 9718:       my $first=$env{$name};
                   9719:       undef($env{$name});
                   9720:       push(@{ $env{$name} },$first,$value);
1.25      albertel 9721:     }
                   9722:   } else {
1.258     albertel 9723:     $env{$name}=$value;
1.25      albertel 9724:   }
1.31      albertel 9725: }
1.149     albertel 9726: 
                   9727: =pod
                   9728: 
1.648     raeburn  9729: =item * &get_env_multiple($name) 
1.149     albertel 9730: 
1.258     albertel 9731: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 9732: values may be defined and end up as an array ref.
                   9733: 
                   9734: returns an array of values
                   9735: 
                   9736: =cut
                   9737: 
                   9738: sub get_env_multiple {
                   9739:     my ($name) = @_;
                   9740:     my @values;
1.258     albertel 9741:     if (defined($env{$name})) {
1.149     albertel 9742:         # exists is it an array
1.258     albertel 9743:         if (ref($env{$name})) {
                   9744:             @values=@{ $env{$name} };
1.149     albertel 9745:         } else {
1.258     albertel 9746:             $values[0]=$env{$name};
1.149     albertel 9747:         }
                   9748:     }
                   9749:     return(@values);
                   9750: }
                   9751: 
1.660     raeburn  9752: sub ask_for_embedded_content {
                   9753:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  9754:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11  raeburn  9755:         %currsubfile,%unused,$rem);
1.1071    raeburn  9756:     my $counter = 0;
                   9757:     my $numnew = 0;
1.987     raeburn  9758:     my $numremref = 0;
                   9759:     my $numinvalid = 0;
                   9760:     my $numpathchg = 0;
                   9761:     my $numexisting = 0;
1.1071    raeburn  9762:     my $numunused = 0;
                   9763:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
                   9764:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path);
                   9765:     my $heading = &mt('Upload embedded files');
                   9766:     my $buttontext = &mt('Upload');
                   9767: 
1.1075.2.35  raeburn  9768:     my ($navmap,$cdom,$cnum);
1.1075.2.11  raeburn  9769:     if ($env{'request.course.id'}) {
1.1075.2.35  raeburn  9770:         if ($actionurl eq '/adm/dependencies') {
                   9771:             $navmap = Apache::lonnavmaps::navmap->new();
                   9772:         }
                   9773:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9774:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11  raeburn  9775:     }
1.1075.2.35  raeburn  9776:     if (($actionurl eq '/adm/portfolio') ||
                   9777:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  9778:         my $current_path='/';
                   9779:         if ($env{'form.currentpath'}) {
                   9780:             $current_path = $env{'form.currentpath'};
                   9781:         }
                   9782:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35  raeburn  9783:             $udom = $cdom;
                   9784:             $uname = $cnum;
1.984     raeburn  9785:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   9786:         } else {
                   9787:             $udom = $env{'user.domain'};
                   9788:             $uname = $env{'user.name'};
                   9789:             $url = '/userfiles/portfolio';
                   9790:         }
1.987     raeburn  9791:         $toplevel = $url.'/';
1.984     raeburn  9792:         $url .= $current_path;
                   9793:         $getpropath = 1;
1.987     raeburn  9794:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   9795:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      9796:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  9797:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  9798:         $toplevel = $url;
1.984     raeburn  9799:         if ($rest ne '') {
1.987     raeburn  9800:             $url .= $rest;
                   9801:         }
                   9802:     } elsif ($actionurl eq '/adm/coursedocs') {
                   9803:         if (ref($args) eq 'HASH') {
1.1071    raeburn  9804:             $url = $args->{'docs_url'};
                   9805:             $toplevel = $url;
1.1075.2.11  raeburn  9806:             if ($args->{'context'} eq 'paste') {
                   9807:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   9808:                 ($path) =
                   9809:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9810:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9811:                 $fileloc =~ s{^/}{};
                   9812:             }
1.1071    raeburn  9813:         }
                   9814:     } elsif ($actionurl eq '/adm/dependencies') {
                   9815:         if ($env{'request.course.id'} ne '') {
                   9816:             if (ref($args) eq 'HASH') {
                   9817:                 $url = $args->{'docs_url'};
                   9818:                 $title = $args->{'docs_title'};
1.1075.2.35  raeburn  9819:                 $toplevel = $url;
                   9820:                 unless ($toplevel =~ m{^/}) {
                   9821:                     $toplevel = "/$url";
                   9822:                 }
1.1075.2.11  raeburn  9823:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35  raeburn  9824:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   9825:                     $path = $1;
                   9826:                 } else {
                   9827:                     ($path) =
                   9828:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9829:                 }
1.1071    raeburn  9830:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9831:                 $fileloc =~ s{^/}{};
                   9832:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   9833:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   9834:             }
1.987     raeburn  9835:         }
1.1075.2.35  raeburn  9836:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9837:         $udom = $cdom;
                   9838:         $uname = $cnum;
                   9839:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   9840:         $toplevel = $url;
                   9841:         $path = $url;
                   9842:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   9843:         $fileloc =~ s{^/}{};
                   9844:     }
                   9845:     foreach my $file (keys(%{$allfiles})) {
                   9846:         my $embed_file;
                   9847:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   9848:             $embed_file = $1;
                   9849:         } else {
                   9850:             $embed_file = $file;
                   9851:         }
1.987     raeburn  9852:         my $absolutepath;
1.1075.2.47! raeburn  9853:         my $cleaned_file = &clean_path($embed_file);
        !          9854:         if ($cleaned_file =~ m{^\w+://}) {
        !          9855:             $newfiles{$cleaned_file} = 1;
        !          9856:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  9857:         } else {
                   9858:             if ($embed_file =~ m{^/}) {
                   9859:                 $absolutepath = $embed_file;
                   9860:             }
1.1075.2.47! raeburn  9861:             if ($cleaned_file =~ m{/}) {
        !          9862:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  9863:                 $path = &check_for_traversal($path,$url,$toplevel);
                   9864:                 my $item = $fname;
                   9865:                 if ($path ne '') {
                   9866:                     $item = $path.'/'.$fname;
                   9867:                     $subdependencies{$path}{$fname} = 1;
                   9868:                 } else {
                   9869:                     $dependencies{$item} = 1;
                   9870:                 }
                   9871:                 if ($absolutepath) {
                   9872:                     $mapping{$item} = $absolutepath;
                   9873:                 } else {
                   9874:                     $mapping{$item} = $embed_file;
                   9875:                 }
                   9876:             } else {
                   9877:                 $dependencies{$embed_file} = 1;
                   9878:                 if ($absolutepath) {
1.1075.2.47! raeburn  9879:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  9880:                 } else {
1.1075.2.47! raeburn  9881:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  9882:                 }
                   9883:             }
1.984     raeburn  9884:         }
                   9885:     }
1.1071    raeburn  9886:     my $dirptr = 16384;
1.984     raeburn  9887:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  9888:         $currsubfile{$path} = {};
1.1075.2.35  raeburn  9889:         if (($actionurl eq '/adm/portfolio') ||
                   9890:             ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  9891:             my ($sublistref,$listerror) =
                   9892:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   9893:             if (ref($sublistref) eq 'ARRAY') {
                   9894:                 foreach my $line (@{$sublistref}) {
                   9895:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  9896:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  9897:                 }
1.984     raeburn  9898:             }
1.987     raeburn  9899:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9900:             if (opendir(my $dir,$url.'/'.$path)) {
                   9901:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  9902:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   9903:             }
1.1075.2.11  raeburn  9904:         } elsif (($actionurl eq '/adm/dependencies') ||
                   9905:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  9906:                   ($args->{'context'} eq 'paste')) ||
                   9907:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  9908:             if ($env{'request.course.id'} ne '') {
1.1075.2.35  raeburn  9909:                 my $dir;
                   9910:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9911:                     $dir = $fileloc;
                   9912:                 } else {
                   9913:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9914:                 }
1.1071    raeburn  9915:                 if ($dir ne '') {
                   9916:                     my ($sublistref,$listerror) =
                   9917:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   9918:                     if (ref($sublistref) eq 'ARRAY') {
                   9919:                         foreach my $line (@{$sublistref}) {
                   9920:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   9921:                                 undef,$mtime)=split(/\&/,$line,12);
                   9922:                             unless (($testdir&$dirptr) ||
                   9923:                                     ($file_name =~ /^\.\.?$/)) {
                   9924:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   9925:                             }
                   9926:                         }
                   9927:                     }
                   9928:                 }
1.984     raeburn  9929:             }
                   9930:         }
                   9931:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  9932:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  9933:                 my $item = $path.'/'.$file;
                   9934:                 unless ($mapping{$item} eq $item) {
                   9935:                     $pathchanges{$item} = 1;
                   9936:                 }
                   9937:                 $existing{$item} = 1;
                   9938:                 $numexisting ++;
                   9939:             } else {
                   9940:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  9941:             }
                   9942:         }
1.1071    raeburn  9943:         if ($actionurl eq '/adm/dependencies') {
                   9944:             foreach my $path (keys(%currsubfile)) {
                   9945:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   9946:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   9947:                          unless ($subdependencies{$path}{$file}) {
1.1075.2.11  raeburn  9948:                              next if (($rem ne '') &&
                   9949:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   9950:                                        (ref($navmap) &&
                   9951:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   9952:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   9953:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  9954:                              $unused{$path.'/'.$file} = 1; 
                   9955:                          }
                   9956:                     }
                   9957:                 }
                   9958:             }
                   9959:         }
1.984     raeburn  9960:     }
1.987     raeburn  9961:     my %currfile;
1.1075.2.35  raeburn  9962:     if (($actionurl eq '/adm/portfolio') ||
                   9963:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  9964:         my ($dirlistref,$listerror) =
                   9965:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   9966:         if (ref($dirlistref) eq 'ARRAY') {
                   9967:             foreach my $line (@{$dirlistref}) {
                   9968:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   9969:                 $currfile{$file_name} = 1;
                   9970:             }
1.984     raeburn  9971:         }
1.987     raeburn  9972:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9973:         if (opendir(my $dir,$url)) {
1.987     raeburn  9974:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  9975:             map {$currfile{$_} = 1;} @dir_list;
                   9976:         }
1.1075.2.11  raeburn  9977:     } elsif (($actionurl eq '/adm/dependencies') ||
                   9978:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  9979:               ($args->{'context'} eq 'paste')) ||
                   9980:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  9981:         if ($env{'request.course.id'} ne '') {
                   9982:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9983:             if ($dir ne '') {
                   9984:                 my ($dirlistref,$listerror) =
                   9985:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   9986:                 if (ref($dirlistref) eq 'ARRAY') {
                   9987:                     foreach my $line (@{$dirlistref}) {
                   9988:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   9989:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   9990:                         unless (($testdir&$dirptr) ||
                   9991:                                 ($file_name =~ /^\.\.?$/)) {
                   9992:                             $currfile{$file_name} = [$size,$mtime];
                   9993:                         }
                   9994:                     }
                   9995:                 }
                   9996:             }
                   9997:         }
1.984     raeburn  9998:     }
                   9999:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  10000:         if (exists($currfile{$file})) {
1.987     raeburn  10001:             unless ($mapping{$file} eq $file) {
                   10002:                 $pathchanges{$file} = 1;
                   10003:             }
                   10004:             $existing{$file} = 1;
                   10005:             $numexisting ++;
                   10006:         } else {
1.984     raeburn  10007:             $newfiles{$file} = 1;
                   10008:         }
                   10009:     }
1.1071    raeburn  10010:     foreach my $file (keys(%currfile)) {
                   10011:         unless (($file eq $filename) ||
                   10012:                 ($file eq $filename.'.bak') ||
                   10013:                 ($dependencies{$file})) {
1.1075.2.11  raeburn  10014:             if ($actionurl eq '/adm/dependencies') {
1.1075.2.35  raeburn  10015:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   10016:                     next if (($rem ne '') &&
                   10017:                              (($env{"httpref.$rem".$file} ne '') ||
                   10018:                               (ref($navmap) &&
                   10019:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   10020:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10021:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   10022:                 }
1.1075.2.11  raeburn  10023:             }
1.1071    raeburn  10024:             $unused{$file} = 1;
                   10025:         }
                   10026:     }
1.1075.2.11  raeburn  10027:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   10028:         ($args->{'context'} eq 'paste')) {
                   10029:         $counter = scalar(keys(%existing));
                   10030:         $numpathchg = scalar(keys(%pathchanges));
                   10031:         return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35  raeburn  10032:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
                   10033:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   10034:         $counter = scalar(keys(%existing));
                   10035:         $numpathchg = scalar(keys(%pathchanges));
                   10036:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11  raeburn  10037:     }
1.984     raeburn  10038:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  10039:         if ($actionurl eq '/adm/dependencies') {
                   10040:             next if ($embed_file =~ m{^\w+://});
                   10041:         }
1.660     raeburn  10042:         $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  10043:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  10044:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  10045:         unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35  raeburn  10046:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   10047:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  10048:         }
1.1075.2.35  raeburn  10049:         $upload_output .= '</td>';
1.1071    raeburn  10050:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1075.2.35  raeburn  10051:             $upload_output.='<td align="right">'.
                   10052:                             '<span class="LC_info LC_fontsize_medium">'.
                   10053:                             &mt("URL points to web address").'</span>';
1.987     raeburn  10054:             $numremref++;
1.660     raeburn  10055:         } elsif ($args->{'error_on_invalid_names'}
                   10056:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35  raeburn  10057:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   10058:                             &mt('Invalid characters').'</span>';
1.987     raeburn  10059:             $numinvalid++;
1.660     raeburn  10060:         } else {
1.1075.2.35  raeburn  10061:             $upload_output .= '<td>'.
                   10062:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  10063:                                                      $embed_file,\%mapping,
1.1071    raeburn  10064:                                                      $allfiles,$codebase,'upload');
                   10065:             $counter ++;
                   10066:             $numnew ++;
1.987     raeburn  10067:         }
                   10068:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   10069:     }
                   10070:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  10071:         if ($actionurl eq '/adm/dependencies') {
                   10072:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   10073:             $modify_output .= &start_data_table_row().
                   10074:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   10075:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   10076:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   10077:                               '<td>'.$size.'</td>'.
                   10078:                               '<td>'.$mtime.'</td>'.
                   10079:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   10080:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   10081:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   10082:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   10083:                               &embedded_file_element('upload_embedded',$counter,
                   10084:                                                      $embed_file,\%mapping,
                   10085:                                                      $allfiles,$codebase,'modify').
                   10086:                               '</div></td>'.
                   10087:                               &end_data_table_row()."\n";
                   10088:             $counter ++;
                   10089:         } else {
                   10090:             $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  10091:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   10092:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   10093:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  10094:                               &Apache::loncommon::end_data_table_row()."\n";
                   10095:         }
                   10096:     }
                   10097:     my $delidx = $counter;
                   10098:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   10099:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   10100:         $delete_output .= &start_data_table_row().
                   10101:                           '<td><img src="'.&icon($oldfile).'" />'.
                   10102:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   10103:                           '<td>'.$size.'</td>'.
                   10104:                           '<td>'.$mtime.'</td>'.
                   10105:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   10106:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   10107:                           &embedded_file_element('upload_embedded',$delidx,
                   10108:                                                  $oldfile,\%mapping,$allfiles,
                   10109:                                                  $codebase,'delete').'</td>'.
                   10110:                           &end_data_table_row()."\n"; 
                   10111:         $numunused ++;
                   10112:         $delidx ++;
1.987     raeburn  10113:     }
                   10114:     if ($upload_output) {
                   10115:         $upload_output = &start_data_table().
                   10116:                          $upload_output.
                   10117:                          &end_data_table()."\n";
                   10118:     }
1.1071    raeburn  10119:     if ($modify_output) {
                   10120:         $modify_output = &start_data_table().
                   10121:                          &start_data_table_header_row().
                   10122:                          '<th>'.&mt('File').'</th>'.
                   10123:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10124:                          '<th>'.&mt('Modified').'</th>'.
                   10125:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   10126:                          &end_data_table_header_row().
                   10127:                          $modify_output.
                   10128:                          &end_data_table()."\n";
                   10129:     }
                   10130:     if ($delete_output) {
                   10131:         $delete_output = &start_data_table().
                   10132:                          &start_data_table_header_row().
                   10133:                          '<th>'.&mt('File').'</th>'.
                   10134:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10135:                          '<th>'.&mt('Modified').'</th>'.
                   10136:                          '<th>'.&mt('Delete?').'</th>'.
                   10137:                          &end_data_table_header_row().
                   10138:                          $delete_output.
                   10139:                          &end_data_table()."\n";
                   10140:     }
1.987     raeburn  10141:     my $applies = 0;
                   10142:     if ($numremref) {
                   10143:         $applies ++;
                   10144:     }
                   10145:     if ($numinvalid) {
                   10146:         $applies ++;
                   10147:     }
                   10148:     if ($numexisting) {
                   10149:         $applies ++;
                   10150:     }
1.1071    raeburn  10151:     if ($counter || $numunused) {
1.987     raeburn  10152:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   10153:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  10154:                   $state.'<h3>'.$heading.'</h3>'; 
                   10155:         if ($actionurl eq '/adm/dependencies') {
                   10156:             if ($numnew) {
                   10157:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   10158:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   10159:                            $upload_output.'<br />'."\n";
                   10160:             }
                   10161:             if ($numexisting) {
                   10162:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   10163:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   10164:                            $modify_output.'<br />'."\n";
                   10165:                            $buttontext = &mt('Save changes');
                   10166:             }
                   10167:             if ($numunused) {
                   10168:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   10169:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   10170:                            $delete_output.'<br />'."\n";
                   10171:                            $buttontext = &mt('Save changes');
                   10172:             }
                   10173:         } else {
                   10174:             $output .= $upload_output.'<br />'."\n";
                   10175:         }
                   10176:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   10177:                    $counter.'" />'."\n";
                   10178:         if ($actionurl eq '/adm/dependencies') { 
                   10179:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   10180:                        $numnew.'" />'."\n";
                   10181:         } elsif ($actionurl eq '') {
1.987     raeburn  10182:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   10183:         }
                   10184:     } elsif ($applies) {
                   10185:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   10186:         if ($applies > 1) {
                   10187:             $output .=  
1.1075.2.35  raeburn  10188:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  10189:             if ($numremref) {
                   10190:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   10191:             }
                   10192:             if ($numinvalid) {
                   10193:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   10194:             }
                   10195:             if ($numexisting) {
                   10196:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   10197:             }
                   10198:             $output .= '</ul><br />';
                   10199:         } elsif ($numremref) {
                   10200:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   10201:         } elsif ($numinvalid) {
                   10202:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   10203:         } elsif ($numexisting) {
                   10204:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   10205:         }
                   10206:         $output .= $upload_output.'<br />';
                   10207:     }
                   10208:     my ($pathchange_output,$chgcount);
1.1071    raeburn  10209:     $chgcount = $counter;
1.987     raeburn  10210:     if (keys(%pathchanges) > 0) {
                   10211:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  10212:             if ($counter) {
1.987     raeburn  10213:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   10214:                                                   $embed_file,\%mapping,
1.1071    raeburn  10215:                                                   $allfiles,$codebase,'change');
1.987     raeburn  10216:             } else {
                   10217:                 $pathchange_output .= 
                   10218:                     &start_data_table_row().
                   10219:                     '<td><input type ="checkbox" name="namechange" value="'.
                   10220:                     $chgcount.'" checked="checked" /></td>'.
                   10221:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   10222:                     '<td>'.$embed_file.
                   10223:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  10224:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  10225:                     '</td>'.&end_data_table_row();
1.660     raeburn  10226:             }
1.987     raeburn  10227:             $numpathchg ++;
                   10228:             $chgcount ++;
1.660     raeburn  10229:         }
                   10230:     }
1.1075.2.35  raeburn  10231:     if (($counter) || ($numunused)) {
1.987     raeburn  10232:         if ($numpathchg) {
                   10233:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   10234:                        $numpathchg.'" />'."\n";
                   10235:         }
                   10236:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   10237:             ($actionurl eq '/adm/imsimport')) {
                   10238:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   10239:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   10240:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  10241:         } elsif ($actionurl eq '/adm/dependencies') {
                   10242:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  10243:         }
1.1075.2.35  raeburn  10244:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  10245:     } elsif ($numpathchg) {
                   10246:         my %pathchange = ();
                   10247:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   10248:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10249:             $output .= '<p>'.&mt('or').'</p>'; 
1.1075.2.35  raeburn  10250:         }
1.987     raeburn  10251:     }
1.1071    raeburn  10252:     return ($output,$counter,$numpathchg);
1.987     raeburn  10253: }
                   10254: 
1.1075.2.47! raeburn  10255: 
        !          10256: =pod
        !          10257: 
        !          10258: =item * clean_path($name)
        !          10259: 
        !          10260: Performs clean-up of directories, subdirectories and filename in an
        !          10261: embedded object, referenced in an HTML file which is being uploaded
        !          10262: to a course or portfolio, where
        !          10263: "Upload embedded images/multimedia files if HTML file" checkbox was
        !          10264: checked.
        !          10265: 
        !          10266: Clean-up is similar to replacements in lonnet::clean_filename()
        !          10267: except each / between sub-directory and next level is preserved.
        !          10268: 
        !          10269: =cut
        !          10270: 
        !          10271: sub clean_path {
        !          10272:     my ($embed_file) = @_;
        !          10273:     $embed_file =~s{^/+}{};
        !          10274:     my @contents;
        !          10275:     if ($embed_file =~ m{/}) {
        !          10276:         @contents = split(/\//,$embed_file);
        !          10277:     } else {
        !          10278:         @contents = ($embed_file);
        !          10279:     }
        !          10280:     my $lastidx = scalar(@contents)-1;
        !          10281:     for (my $i=0; $i<=$lastidx; $i++) {
        !          10282:         $contents[$i]=~s{\\}{/}g;
        !          10283:         $contents[$i]=~s/\s+/\_/g;
        !          10284:         $contents[$i]=~s{[^/\w\.\-]}{}g;
        !          10285:         if ($i == $lastidx) {
        !          10286:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
        !          10287:         }
        !          10288:     }
        !          10289:     if ($lastidx > 0) {
        !          10290:         return join('/',@contents);
        !          10291:     } else {
        !          10292:         return $contents[0];
        !          10293:     }
        !          10294: }
        !          10295: 
1.987     raeburn  10296: sub embedded_file_element {
1.1071    raeburn  10297:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  10298:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   10299:                    (ref($codebase) eq 'HASH'));
                   10300:     my $output;
1.1071    raeburn  10301:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  10302:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   10303:     }
                   10304:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   10305:                &escape($embed_file).'" />';
                   10306:     unless (($context eq 'upload_embedded') && 
                   10307:             ($mapping->{$embed_file} eq $embed_file)) {
                   10308:         $output .='
                   10309:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   10310:     }
                   10311:     my $attrib;
                   10312:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   10313:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   10314:     }
                   10315:     $output .=
                   10316:         "\n\t\t".
                   10317:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   10318:         $attrib.'" />';
                   10319:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   10320:         $output .=
                   10321:             "\n\t\t".
                   10322:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   10323:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  10324:     }
1.987     raeburn  10325:     return $output;
1.660     raeburn  10326: }
                   10327: 
1.1071    raeburn  10328: sub get_dependency_details {
                   10329:     my ($currfile,$currsubfile,$embed_file) = @_;
                   10330:     my ($size,$mtime,$showsize,$showmtime);
                   10331:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   10332:         if ($embed_file =~ m{/}) {
                   10333:             my ($path,$fname) = split(/\//,$embed_file);
                   10334:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   10335:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   10336:             }
                   10337:         } else {
                   10338:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   10339:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   10340:             }
                   10341:         }
                   10342:         $showsize = $size/1024.0;
                   10343:         $showsize = sprintf("%.1f",$showsize);
                   10344:         if ($mtime > 0) {
                   10345:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   10346:         }
                   10347:     }
                   10348:     return ($showsize,$showmtime);
                   10349: }
                   10350: 
                   10351: sub ask_embedded_js {
                   10352:     return <<"END";
                   10353: <script type="text/javascript"">
                   10354: // <![CDATA[
                   10355: function toggleBrowse(counter) {
                   10356:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   10357:     var fileid = document.getElementById('embedded_item_'+counter);
                   10358:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   10359:     if (chkboxid.checked == true) {
                   10360:         uploaddivid.style.display='block';
                   10361:     } else {
                   10362:         uploaddivid.style.display='none';
                   10363:         fileid.value = '';
                   10364:     }
                   10365: }
                   10366: // ]]>
                   10367: </script>
                   10368: 
                   10369: END
                   10370: }
                   10371: 
1.661     raeburn  10372: sub upload_embedded {
                   10373:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  10374:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   10375:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  10376:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   10377:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   10378:         my $orig_uploaded_filename =
                   10379:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  10380:         foreach my $type ('orig','ref','attrib','codebase') {
                   10381:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   10382:                 $env{'form.embedded_'.$type.'_'.$i} =
                   10383:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   10384:             }
                   10385:         }
1.661     raeburn  10386:         my ($path,$fname) =
                   10387:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   10388:         # no path, whole string is fname
                   10389:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   10390:         $fname = &Apache::lonnet::clean_filename($fname);
                   10391:         # See if there is anything left
                   10392:         next if ($fname eq '');
                   10393: 
                   10394:         # Check if file already exists as a file or directory.
                   10395:         my ($state,$msg);
                   10396:         if ($context eq 'portfolio') {
                   10397:             my $port_path = $dirpath;
                   10398:             if ($group ne '') {
                   10399:                 $port_path = "groups/$group/$port_path";
                   10400:             }
1.987     raeburn  10401:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   10402:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  10403:                                               $dir_root,$port_path,$disk_quota,
                   10404:                                               $current_disk_usage,$uname,$udom);
                   10405:             if ($state eq 'will_exceed_quota'
1.984     raeburn  10406:                 || $state eq 'file_locked') {
1.661     raeburn  10407:                 $output .= $msg;
                   10408:                 next;
                   10409:             }
                   10410:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   10411:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   10412:             if ($state eq 'exists') {
                   10413:                 $output .= $msg;
                   10414:                 next;
                   10415:             }
                   10416:         }
                   10417:         # Check if extension is valid
                   10418:         if (($fname =~ /\.(\w+)$/) &&
                   10419:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.987     raeburn  10420:             $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1).'<br />';
1.661     raeburn  10421:             next;
                   10422:         } elsif (($fname =~ /\.(\w+)$/) &&
                   10423:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  10424:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  10425:             next;
                   10426:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34  raeburn  10427:             $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  10428:             next;
                   10429:         }
                   10430:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35  raeburn  10431:         my $subdir = $path;
                   10432:         $subdir =~ s{/+$}{};
1.661     raeburn  10433:         if ($context eq 'portfolio') {
1.984     raeburn  10434:             my $result;
                   10435:             if ($state eq 'existingfile') {
                   10436:                 $result=
                   10437:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35  raeburn  10438:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  10439:             } else {
1.984     raeburn  10440:                 $result=
                   10441:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  10442:                                                     $dirpath.
1.1075.2.35  raeburn  10443:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  10444:                 if ($result !~ m|^/uploaded/|) {
                   10445:                     $output .= '<span class="LC_error">'
                   10446:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10447:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10448:                                .'</span><br />';
                   10449:                     next;
                   10450:                 } else {
1.987     raeburn  10451:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10452:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  10453:                 }
1.661     raeburn  10454:             }
1.1075.2.35  raeburn  10455:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
                   10456:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   10457:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  10458:             my $result =
1.1075.2.35  raeburn  10459:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  10460:             if ($result !~ m|^/uploaded/|) {
                   10461:                 $output .= '<span class="LC_error">'
                   10462:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10463:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10464:                            .'</span><br />';
                   10465:                     next;
                   10466:             } else {
                   10467:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10468:                            $path.$fname.'</span>').'<br />';
1.1075.2.35  raeburn  10469:                 if ($context eq 'syllabus') {
                   10470:                     &Apache::lonnet::make_public_indefinitely($result);
                   10471:                 }
1.987     raeburn  10472:             }
1.661     raeburn  10473:         } else {
                   10474: # Save the file
                   10475:             my $target = $env{'form.embedded_item_'.$i};
                   10476:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   10477:             my $dest = $fullpath.$fname;
                   10478:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  10479:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  10480:             my $count;
                   10481:             my $filepath = $dir_root;
1.1027    raeburn  10482:             foreach my $subdir (@parts) {
                   10483:                 $filepath .= "/$subdir";
                   10484:                 if (!-e $filepath) {
1.661     raeburn  10485:                     mkdir($filepath,0770);
                   10486:                 }
                   10487:             }
                   10488:             my $fh;
                   10489:             if (!open($fh,'>'.$dest)) {
                   10490:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   10491:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  10492:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   10493:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10494:                            '</span><br />';
                   10495:             } else {
                   10496:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   10497:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   10498:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  10499:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   10500:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10501:                               '</span><br />';
                   10502:                 } else {
1.987     raeburn  10503:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10504:                                $url.'</span>').'<br />';
                   10505:                     unless ($context eq 'testbank') {
                   10506:                         $footer .= &mt('View embedded file: [_1]',
                   10507:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   10508:                     }
                   10509:                 }
                   10510:                 close($fh);
                   10511:             }
                   10512:         }
                   10513:         if ($env{'form.embedded_ref_'.$i}) {
                   10514:             $pathchange{$i} = 1;
                   10515:         }
                   10516:     }
                   10517:     if ($output) {
                   10518:         $output = '<p>'.$output.'</p>';
                   10519:     }
                   10520:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   10521:     $returnflag = 'ok';
1.1071    raeburn  10522:     my $numpathchgs = scalar(keys(%pathchange));
                   10523:     if ($numpathchgs > 0) {
1.987     raeburn  10524:         if ($context eq 'portfolio') {
                   10525:             $output .= '<p>'.&mt('or').'</p>';
                   10526:         } elsif ($context eq 'testbank') {
1.1071    raeburn  10527:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   10528:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  10529:             $returnflag = 'modify_orightml';
                   10530:         }
                   10531:     }
1.1071    raeburn  10532:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  10533: }
                   10534: 
                   10535: sub modify_html_form {
                   10536:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   10537:     my $end = 0;
                   10538:     my $modifyform;
                   10539:     if ($context eq 'upload_embedded') {
                   10540:         return unless (ref($pathchange) eq 'HASH');
                   10541:         if ($env{'form.number_embedded_items'}) {
                   10542:             $end += $env{'form.number_embedded_items'};
                   10543:         }
                   10544:         if ($env{'form.number_pathchange_items'}) {
                   10545:             $end += $env{'form.number_pathchange_items'};
                   10546:         }
                   10547:         if ($end) {
                   10548:             for (my $i=0; $i<$end; $i++) {
                   10549:                 if ($i < $env{'form.number_embedded_items'}) {
                   10550:                     next unless($pathchange->{$i});
                   10551:                 }
                   10552:                 $modifyform .=
                   10553:                     &start_data_table_row().
                   10554:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   10555:                     'checked="checked" /></td>'.
                   10556:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   10557:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   10558:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   10559:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   10560:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   10561:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   10562:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   10563:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   10564:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   10565:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   10566:                     &end_data_table_row();
1.1071    raeburn  10567:             }
1.987     raeburn  10568:         }
                   10569:     } else {
                   10570:         $modifyform = $pathchgtable;
                   10571:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   10572:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   10573:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10574:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   10575:         }
                   10576:     }
                   10577:     if ($modifyform) {
1.1071    raeburn  10578:         if ($actionurl eq '/adm/dependencies') {
                   10579:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   10580:         }
1.987     raeburn  10581:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   10582:                '<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".
                   10583:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   10584:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   10585:                '</ol></p>'."\n".'<p>'.
                   10586:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   10587:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   10588:                &start_data_table()."\n".
                   10589:                &start_data_table_header_row().
                   10590:                '<th>'.&mt('Change?').'</th>'.
                   10591:                '<th>'.&mt('Current reference').'</th>'.
                   10592:                '<th>'.&mt('Required reference').'</th>'.
                   10593:                &end_data_table_header_row()."\n".
                   10594:                $modifyform.
                   10595:                &end_data_table().'<br />'."\n".$hiddenstate.
                   10596:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   10597:                '</form>'."\n";
                   10598:     }
                   10599:     return;
                   10600: }
                   10601: 
                   10602: sub modify_html_refs {
1.1075.2.35  raeburn  10603:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  10604:     my $container;
                   10605:     if ($context eq 'portfolio') {
                   10606:         $container = $env{'form.container'};
                   10607:     } elsif ($context eq 'coursedoc') {
                   10608:         $container = $env{'form.primaryurl'};
1.1071    raeburn  10609:     } elsif ($context eq 'manage_dependencies') {
                   10610:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   10611:         $container = "/$container";
1.1075.2.35  raeburn  10612:     } elsif ($context eq 'syllabus') {
                   10613:         $container = $url;
1.987     raeburn  10614:     } else {
1.1027    raeburn  10615:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  10616:     }
                   10617:     my (%allfiles,%codebase,$output,$content);
                   10618:     my @changes = &get_env_multiple('form.namechange');
1.1075.2.35  raeburn  10619:     unless ((@changes > 0)  || ($context eq 'syllabus')) {
1.1071    raeburn  10620:         if (wantarray) {
                   10621:             return ('',0,0); 
                   10622:         } else {
                   10623:             return;
                   10624:         }
                   10625:     }
                   10626:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  10627:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  10628:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   10629:             if (wantarray) {
                   10630:                 return ('',0,0);
                   10631:             } else {
                   10632:                 return;
                   10633:             }
                   10634:         } 
1.987     raeburn  10635:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  10636:         if ($content eq '-1') {
                   10637:             if (wantarray) {
                   10638:                 return ('',0,0);
                   10639:             } else {
                   10640:                 return;
                   10641:             }
                   10642:         }
1.987     raeburn  10643:     } else {
1.1071    raeburn  10644:         unless ($container =~ /^\Q$dir_root\E/) {
                   10645:             if (wantarray) {
                   10646:                 return ('',0,0);
                   10647:             } else {
                   10648:                 return;
                   10649:             }
                   10650:         } 
1.987     raeburn  10651:         if (open(my $fh,"<$container")) {
                   10652:             $content = join('', <$fh>);
                   10653:             close($fh);
                   10654:         } else {
1.1071    raeburn  10655:             if (wantarray) {
                   10656:                 return ('',0,0);
                   10657:             } else {
                   10658:                 return;
                   10659:             }
1.987     raeburn  10660:         }
                   10661:     }
                   10662:     my ($count,$codebasecount) = (0,0);
                   10663:     my $mm = new File::MMagic;
                   10664:     my $mime_type = $mm->checktype_contents($content);
                   10665:     if ($mime_type eq 'text/html') {
                   10666:         my $parse_result = 
                   10667:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   10668:                                                     \%codebase,\$content);
                   10669:         if ($parse_result eq 'ok') {
                   10670:             foreach my $i (@changes) {
                   10671:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   10672:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   10673:                 if ($allfiles{$ref}) {
                   10674:                     my $newname =  $orig;
                   10675:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  10676:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  10677:                     if ($attrib_regexp =~ /:/) {
                   10678:                         $attrib_regexp =~ s/\:/|/g;
                   10679:                     }
                   10680:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10681:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10682:                         $count += $numchg;
1.1075.2.35  raeburn  10683:                         $allfiles{$newname} = $allfiles{$ref};
1.987     raeburn  10684:                     }
                   10685:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  10686:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  10687:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   10688:                         $codebasecount ++;
                   10689:                     }
                   10690:                 }
                   10691:             }
1.1075.2.35  raeburn  10692:             my $skiprewrites;
1.987     raeburn  10693:             if ($count || $codebasecount) {
                   10694:                 my $saveresult;
1.1071    raeburn  10695:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  10696:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  10697:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10698:                     if ($url eq $container) {
                   10699:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   10700:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10701:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  10702:                                             $fname.'</span>').'</p>';
1.987     raeburn  10703:                     } else {
                   10704:                          $output = '<p class="LC_error">'.
                   10705:                                    &mt('Error: update failed for: [_1].',
                   10706:                                    '<span class="LC_filename">'.
                   10707:                                    $container.'</span>').'</p>';
                   10708:                     }
1.1075.2.35  raeburn  10709:                     if ($context eq 'syllabus') {
                   10710:                         unless ($saveresult eq 'ok') {
                   10711:                             $skiprewrites = 1;
                   10712:                         }
                   10713:                     }
1.987     raeburn  10714:                 } else {
                   10715:                     if (open(my $fh,">$container")) {
                   10716:                         print $fh $content;
                   10717:                         close($fh);
                   10718:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10719:                                   $count,'<span class="LC_filename">'.
                   10720:                                   $container.'</span>').'</p>';
1.661     raeburn  10721:                     } else {
1.987     raeburn  10722:                          $output = '<p class="LC_error">'.
                   10723:                                    &mt('Error: could not update [_1].',
                   10724:                                    '<span class="LC_filename">'.
                   10725:                                    $container.'</span>').'</p>';
1.661     raeburn  10726:                     }
                   10727:                 }
                   10728:             }
1.1075.2.35  raeburn  10729:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   10730:                 my ($actionurl,$state);
                   10731:                 $actionurl = "/public/$udom/$uname/syllabus";
                   10732:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   10733:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   10734:                                               \%codebase,
                   10735:                                               {'context' => 'rewrites',
                   10736:                                                'ignore_remote_references' => 1,});
                   10737:                 if (ref($mapping) eq 'HASH') {
                   10738:                     my $rewrites = 0;
                   10739:                     foreach my $key (keys(%{$mapping})) {
                   10740:                         next if ($key =~ m{^https?://});
                   10741:                         my $ref = $mapping->{$key};
                   10742:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   10743:                         my $attrib;
                   10744:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   10745:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   10746:                         }
                   10747:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10748:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10749:                             $rewrites += $numchg;
                   10750:                         }
                   10751:                     }
                   10752:                     if ($rewrites) {
                   10753:                         my $saveresult;
                   10754:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10755:                         if ($url eq $container) {
                   10756:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   10757:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   10758:                                             $count,'<span class="LC_filename">'.
                   10759:                                             $fname.'</span>').'</p>';
                   10760:                         } else {
                   10761:                             $output .= '<p class="LC_error">'.
                   10762:                                        &mt('Error: could not update links in [_1].',
                   10763:                                        '<span class="LC_filename">'.
                   10764:                                        $container.'</span>').'</p>';
                   10765: 
                   10766:                         }
                   10767:                     }
                   10768:                 }
                   10769:             }
1.987     raeburn  10770:         } else {
                   10771:             &logthis('Failed to parse '.$container.
                   10772:                      ' to modify references: '.$parse_result);
1.661     raeburn  10773:         }
                   10774:     }
1.1071    raeburn  10775:     if (wantarray) {
                   10776:         return ($output,$count,$codebasecount);
                   10777:     } else {
                   10778:         return $output;
                   10779:     }
1.661     raeburn  10780: }
                   10781: 
                   10782: sub check_for_existing {
                   10783:     my ($path,$fname,$element) = @_;
                   10784:     my ($state,$msg);
                   10785:     if (-d $path.'/'.$fname) {
                   10786:         $state = 'exists';
                   10787:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10788:     } elsif (-e $path.'/'.$fname) {
                   10789:         $state = 'exists';
                   10790:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10791:     }
                   10792:     if ($state eq 'exists') {
                   10793:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   10794:     }
                   10795:     return ($state,$msg);
                   10796: }
                   10797: 
                   10798: sub check_for_upload {
                   10799:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   10800:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  10801:     my $filesize = length($env{'form.'.$element});
                   10802:     if (!$filesize) {
                   10803:         my $msg = '<span class="LC_error">'.
                   10804:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   10805:                       '<span class="LC_filename">'.$fname.'</span>',
                   10806:                       $filesize).'<br />'.
1.1007    raeburn  10807:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  10808:                   '</span>';
                   10809:         return ('zero_bytes',$msg);
                   10810:     }
                   10811:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  10812:     my $getpropath = 1;
1.1021    raeburn  10813:     my ($dirlistref,$listerror) =
                   10814:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  10815:     my $found_file = 0;
                   10816:     my $locked_file = 0;
1.991     raeburn  10817:     my @lockers;
                   10818:     my $navmap;
                   10819:     if ($env{'request.course.id'}) {
                   10820:         $navmap = Apache::lonnavmaps::navmap->new();
                   10821:     }
1.1021    raeburn  10822:     if (ref($dirlistref) eq 'ARRAY') {
                   10823:         foreach my $line (@{$dirlistref}) {
                   10824:             my ($file_name,$rest)=split(/\&/,$line,2);
                   10825:             if ($file_name eq $fname){
                   10826:                 $file_name = $path.$file_name;
                   10827:                 if ($group ne '') {
                   10828:                     $file_name = $group.$file_name;
                   10829:                 }
                   10830:                 $found_file = 1;
                   10831:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   10832:                     foreach my $lock (@lockers) {
                   10833:                         if (ref($lock) eq 'ARRAY') {
                   10834:                             my ($symb,$crsid) = @{$lock};
                   10835:                             if ($crsid eq $env{'request.course.id'}) {
                   10836:                                 if (ref($navmap)) {
                   10837:                                     my $res = $navmap->getBySymb($symb);
                   10838:                                     foreach my $part (@{$res->parts()}) { 
                   10839:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   10840:                                         unless (($slot_status == $res->RESERVED) ||
                   10841:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   10842:                                             $locked_file = 1;
                   10843:                                         }
1.991     raeburn  10844:                                     }
1.1021    raeburn  10845:                                 } else {
                   10846:                                     $locked_file = 1;
1.991     raeburn  10847:                                 }
                   10848:                             } else {
                   10849:                                 $locked_file = 1;
                   10850:                             }
                   10851:                         }
1.1021    raeburn  10852:                    }
                   10853:                 } else {
                   10854:                     my @info = split(/\&/,$rest);
                   10855:                     my $currsize = $info[6]/1000;
                   10856:                     if ($currsize < $filesize) {
                   10857:                         my $extra = $filesize - $currsize;
                   10858:                         if (($current_disk_usage + $extra) > $disk_quota) {
                   10859:                             my $msg = '<span class="LC_error">'.
                   10860:                                       &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.',
                   10861:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
                   10862:                                       '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   10863:                                                    $disk_quota,$current_disk_usage);
                   10864:                             return ('will_exceed_quota',$msg);
                   10865:                         }
1.984     raeburn  10866:                     }
                   10867:                 }
1.661     raeburn  10868:             }
                   10869:         }
                   10870:     }
                   10871:     if (($current_disk_usage + $filesize) > $disk_quota){
                   10872:         my $msg = '<span class="LC_error">'.
                   10873:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   10874:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   10875:         return ('will_exceed_quota',$msg);
                   10876:     } elsif ($found_file) {
                   10877:         if ($locked_file) {
                   10878:             my $msg = '<span class="LC_error">';
                   10879:             $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>');
                   10880:             $msg .= '</span><br />';
                   10881:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   10882:             return ('file_locked',$msg);
                   10883:         } else {
                   10884:             my $msg = '<span class="LC_error">';
1.984     raeburn  10885:             $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.661     raeburn  10886:             $msg .= '</span>';
1.984     raeburn  10887:             return ('existingfile',$msg);
1.661     raeburn  10888:         }
                   10889:     }
                   10890: }
                   10891: 
1.987     raeburn  10892: sub check_for_traversal {
                   10893:     my ($path,$url,$toplevel) = @_;
                   10894:     my @parts=split(/\//,$path);
                   10895:     my $cleanpath;
                   10896:     my $fullpath = $url;
                   10897:     for (my $i=0;$i<@parts;$i++) {
                   10898:         next if ($parts[$i] eq '.');
                   10899:         if ($parts[$i] eq '..') {
                   10900:             $fullpath =~ s{([^/]+/)$}{};
                   10901:         } else {
                   10902:             $fullpath .= $parts[$i].'/';
                   10903:         }
                   10904:     }
                   10905:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   10906:         $cleanpath = $1;
                   10907:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   10908:         my $curr_toprel = $1;
                   10909:         my @parts = split(/\//,$curr_toprel);
                   10910:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   10911:         my @urlparts = split(/\//,$url_toprel);
                   10912:         my $doubledots;
                   10913:         my $startdiff = -1;
                   10914:         for (my $i=0; $i<@urlparts; $i++) {
                   10915:             if ($startdiff == -1) {
                   10916:                 unless ($urlparts[$i] eq $parts[$i]) {
                   10917:                     $startdiff = $i;
                   10918:                     $doubledots .= '../';
                   10919:                 }
                   10920:             } else {
                   10921:                 $doubledots .= '../';
                   10922:             }
                   10923:         }
                   10924:         if ($startdiff > -1) {
                   10925:             $cleanpath = $doubledots;
                   10926:             for (my $i=$startdiff; $i<@parts; $i++) {
                   10927:                 $cleanpath .= $parts[$i].'/';
                   10928:             }
                   10929:         }
                   10930:     }
                   10931:     $cleanpath =~ s{(/)$}{};
                   10932:     return $cleanpath;
                   10933: }
1.31      albertel 10934: 
1.1053    raeburn  10935: sub is_archive_file {
                   10936:     my ($mimetype) = @_;
                   10937:     if (($mimetype eq 'application/octet-stream') ||
                   10938:         ($mimetype eq 'application/x-stuffit') ||
                   10939:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   10940:         return 1;
                   10941:     }
                   10942:     return;
                   10943: }
                   10944: 
                   10945: sub decompress_form {
1.1065    raeburn  10946:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  10947:     my %lt = &Apache::lonlocal::texthash (
                   10948:         this => 'This file is an archive file.',
1.1067    raeburn  10949:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  10950:         itsc => 'Its contents are as follows:',
1.1053    raeburn  10951:         youm => 'You may wish to extract its contents.',
                   10952:         extr => 'Extract contents',
1.1067    raeburn  10953:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   10954:         proa => 'Process automatically?',
1.1053    raeburn  10955:         yes  => 'Yes',
                   10956:         no   => 'No',
1.1067    raeburn  10957:         fold => 'Title for folder containing movie',
                   10958:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  10959:     );
1.1065    raeburn  10960:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  10961:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  10962:     my $info = &list_archive_contents($fileloc,\@paths);
                   10963:     if (@paths) {
                   10964:         foreach my $path (@paths) {
                   10965:             $path =~ s{^/}{};
1.1067    raeburn  10966:             if ($path =~ m{^([^/]+)/$}) {
                   10967:                 $topdir = $1;
                   10968:             }
1.1065    raeburn  10969:             if ($path =~ m{^([^/]+)/}) {
                   10970:                 $toplevel{$1} = $path;
                   10971:             } else {
                   10972:                 $toplevel{$path} = $path;
                   10973:             }
                   10974:         }
                   10975:     }
1.1067    raeburn  10976:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
                   10977:         my @camtasia = ("$topdir/","$topdir/index.html",
                   10978:                         "$topdir/media/",
                   10979:                         "$topdir/media/$topdir.mp4",
                   10980:                         "$topdir/media/FirstFrame.png",
                   10981:                         "$topdir/media/player.swf",
                   10982:                         "$topdir/media/swfobject.js",
                   10983:                         "$topdir/media/expressInstall.swf");
                   10984:         my @diffs = &compare_arrays(\@paths,\@camtasia);
                   10985:         if (@diffs == 0) {
                   10986:             $is_camtasia = 1;
                   10987:         }
                   10988:     }
                   10989:     my $output;
                   10990:     if ($is_camtasia) {
                   10991:         $output = <<"ENDCAM";
                   10992: <script type="text/javascript" language="Javascript">
                   10993: // <![CDATA[
                   10994: 
                   10995: function camtasiaToggle() {
                   10996:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   10997:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
                   10998:             if (document.uploaded_decompress.autoextract_camtasia[i].value == 1) {
                   10999: 
                   11000:                 document.getElementById('camtasia_titles').style.display='block';
                   11001:             } else {
                   11002:                 document.getElementById('camtasia_titles').style.display='none';
                   11003:             }
                   11004:         }
                   11005:     }
                   11006:     return;
                   11007: }
                   11008: 
                   11009: // ]]>
                   11010: </script>
                   11011: <p>$lt{'camt'}</p>
                   11012: ENDCAM
1.1065    raeburn  11013:     } else {
1.1067    raeburn  11014:         $output = '<p>'.$lt{'this'};
                   11015:         if ($info eq '') {
                   11016:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   11017:         } else {
                   11018:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   11019:                        '<div><pre>'.$info.'</pre></div>';
                   11020:         }
1.1065    raeburn  11021:     }
1.1067    raeburn  11022:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  11023:     my $duplicates;
                   11024:     my $num = 0;
                   11025:     if (ref($dirlist) eq 'ARRAY') {
                   11026:         foreach my $item (@{$dirlist}) {
                   11027:             if (ref($item) eq 'ARRAY') {
                   11028:                 if (exists($toplevel{$item->[0]})) {
                   11029:                     $duplicates .= 
                   11030:                         &start_data_table_row().
                   11031:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11032:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   11033:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11034:                         'value="1" />'.&mt('Yes').'</label>'.
                   11035:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   11036:                         '<td>'.$item->[0].'</td>';
                   11037:                     if ($item->[2]) {
                   11038:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   11039:                     } else {
                   11040:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   11041:                     }
                   11042:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   11043:                                    '<td>'.
                   11044:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   11045:                                    '</td>'.
                   11046:                                    &end_data_table_row();
                   11047:                     $num ++;
                   11048:                 }
                   11049:             }
                   11050:         }
                   11051:     }
                   11052:     my $itemcount;
                   11053:     if (@paths > 0) {
                   11054:         $itemcount = scalar(@paths);
                   11055:     } else {
                   11056:         $itemcount = 1;
                   11057:     }
1.1067    raeburn  11058:     if ($is_camtasia) {
                   11059:         $output .= $lt{'auto'}.'<br />'.
                   11060:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
                   11061:                    '<input type="radio" name="autoextract_camtasia" value="1" onclick="javascript:camtasiaToggle();" checked="checked" />'.
                   11062:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   11063:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   11064:                    $lt{'no'}.'</label></span><br />'.
                   11065:                    '<div id="camtasia_titles" style="display:block">'.
                   11066:                    &Apache::lonhtmlcommon::start_pick_box().
                   11067:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   11068:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   11069:                    &Apache::lonhtmlcommon::row_closure().
                   11070:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   11071:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   11072:                    &Apache::lonhtmlcommon::row_closure(1).
                   11073:                    &Apache::lonhtmlcommon::end_pick_box().
                   11074:                    '</div>';
                   11075:     }
1.1065    raeburn  11076:     $output .= 
                   11077:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  11078:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   11079:         "\n";
1.1065    raeburn  11080:     if ($duplicates ne '') {
                   11081:         $output .= '<p><span class="LC_warning">'.
                   11082:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   11083:                    &start_data_table().
                   11084:                    &start_data_table_header_row().
                   11085:                    '<th>'.&mt('Overwrite?').'</th>'.
                   11086:                    '<th>'.&mt('Name').'</th>'.
                   11087:                    '<th>'.&mt('Type').'</th>'.
                   11088:                    '<th>'.&mt('Size').'</th>'.
                   11089:                    '<th>'.&mt('Last modified').'</th>'.
                   11090:                    &end_data_table_header_row().
                   11091:                    $duplicates.
                   11092:                    &end_data_table().
                   11093:                    '</p>';
                   11094:     }
1.1067    raeburn  11095:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  11096:     if (ref($hiddenelements) eq 'HASH') {
                   11097:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   11098:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   11099:         }
                   11100:     }
                   11101:     $output .= <<"END";
1.1067    raeburn  11102: <br />
1.1053    raeburn  11103: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   11104: </form>
                   11105: $noextract
                   11106: END
                   11107:     return $output;
                   11108: }
                   11109: 
1.1065    raeburn  11110: sub decompression_utility {
                   11111:     my ($program) = @_;
                   11112:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   11113:     my $location;
                   11114:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   11115:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   11116:                          '/usr/sbin/') {
                   11117:             if (-x $dir.$program) {
                   11118:                 $location = $dir.$program;
                   11119:                 last;
                   11120:             }
                   11121:         }
                   11122:     }
                   11123:     return $location;
                   11124: }
                   11125: 
                   11126: sub list_archive_contents {
                   11127:     my ($file,$pathsref) = @_;
                   11128:     my (@cmd,$output);
                   11129:     my $needsregexp;
                   11130:     if ($file =~ /\.zip$/) {
                   11131:         @cmd = (&decompression_utility('unzip'),"-l");
                   11132:         $needsregexp = 1;
                   11133:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   11134:              ($file =~ /\.tgz$/)) {
                   11135:         @cmd = (&decompression_utility('tar'),"-ztf");
                   11136:     } elsif ($file =~ /\.tar\.bz2$/) {
                   11137:         @cmd = (&decompression_utility('tar'),"-jtf");
                   11138:     } elsif ($file =~ m|\.tar$|) {
                   11139:         @cmd = (&decompression_utility('tar'),"-tf");
                   11140:     }
                   11141:     if (@cmd) {
                   11142:         undef($!);
                   11143:         undef($@);
                   11144:         if (open(my $fh,"-|", @cmd, $file)) {
                   11145:             while (my $line = <$fh>) {
                   11146:                 $output .= $line;
                   11147:                 chomp($line);
                   11148:                 my $item;
                   11149:                 if ($needsregexp) {
                   11150:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   11151:                 } else {
                   11152:                     $item = $line;
                   11153:                 }
                   11154:                 if ($item ne '') {
                   11155:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   11156:                         push(@{$pathsref},$item);
                   11157:                     } 
                   11158:                 }
                   11159:             }
                   11160:             close($fh);
                   11161:         }
                   11162:     }
                   11163:     return $output;
                   11164: }
                   11165: 
1.1053    raeburn  11166: sub decompress_uploaded_file {
                   11167:     my ($file,$dir) = @_;
                   11168:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   11169:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   11170:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   11171:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   11172:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   11173:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   11174:     my $decompressed = $env{'cgi.decompressed'};
                   11175:     &Apache::lonnet::delenv('cgi.file');
                   11176:     &Apache::lonnet::delenv('cgi.dir');
                   11177:     &Apache::lonnet::delenv('cgi.decompressed');
                   11178:     return ($decompressed,$result);
                   11179: }
                   11180: 
1.1055    raeburn  11181: sub process_decompression {
                   11182:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   11183:     my ($dir,$error,$warning,$output);
                   11184:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {
1.1075.2.34  raeburn  11185:         $error = &mt('Filename not a supported archive file type.').
                   11186:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  11187:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   11188:     } else {
                   11189:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11190:         if ($docuhome eq 'no_host') {
                   11191:             $error = &mt('Could not determine home server for course.');
                   11192:         } else {
                   11193:             my @ids=&Apache::lonnet::current_machine_ids();
                   11194:             my $currdir = "$dir_root/$destination";
                   11195:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11196:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   11197:                        "$dir_root/$destination";
                   11198:             } else {
                   11199:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   11200:                        "$dir_root/$docudom/$docuname/$destination";
                   11201:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   11202:                     $error = &mt('Archive file not found.');
                   11203:                 }
                   11204:             }
1.1065    raeburn  11205:             my (@to_overwrite,@to_skip);
                   11206:             if ($env{'form.archive_overwrite_total'} > 0) {
                   11207:                 my $total = $env{'form.archive_overwrite_total'};
                   11208:                 for (my $i=0; $i<$total; $i++) {
                   11209:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   11210:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   11211:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   11212:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   11213:                     }
                   11214:                 }
                   11215:             }
                   11216:             my $numskip = scalar(@to_skip);
                   11217:             if (($numskip > 0) && 
                   11218:                 ($numskip == $env{'form.archive_itemcount'})) {
                   11219:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   11220:             } elsif ($dir eq '') {
1.1055    raeburn  11221:                 $error = &mt('Directory containing archive file unavailable.');
                   11222:             } elsif (!$error) {
1.1065    raeburn  11223:                 my ($decompressed,$display);
                   11224:                 if ($numskip > 0) {
                   11225:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   11226:                     mkdir("$dir/$tempdir",0755);
                   11227:                     system("mv $dir/$file $dir/$tempdir/$file");
                   11228:                     ($decompressed,$display) = 
                   11229:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   11230:                     foreach my $item (@to_skip) {
                   11231:                         if (($item ne '') && ($item !~ /\.\./)) {
                   11232:                             if (-f "$dir/$tempdir/$item") { 
                   11233:                                 unlink("$dir/$tempdir/$item");
                   11234:                             } elsif (-d "$dir/$tempdir/$item") {
                   11235:                                 system("rm -rf $dir/$tempdir/$item");
                   11236:                             }
                   11237:                         }
                   11238:                     }
                   11239:                     system("mv $dir/$tempdir/* $dir");
                   11240:                     rmdir("$dir/$tempdir");   
                   11241:                 } else {
                   11242:                     ($decompressed,$display) = 
                   11243:                         &decompress_uploaded_file($file,$dir);
                   11244:                 }
1.1055    raeburn  11245:                 if ($decompressed eq 'ok') {
1.1065    raeburn  11246:                     $output = '<p class="LC_info">'.
                   11247:                               &mt('Files extracted successfully from archive.').
                   11248:                               '</p>'."\n";
1.1055    raeburn  11249:                     my ($warning,$result,@contents);
                   11250:                     my ($newdirlistref,$newlisterror) =
                   11251:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   11252:                                                  $docuname,1);
                   11253:                     my (%is_dir,%changes,@newitems);
                   11254:                     my $dirptr = 16384;
1.1065    raeburn  11255:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  11256:                         foreach my $dir_line (@{$newdirlistref}) {
                   11257:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  11258:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   11259:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  11260:                                 push(@newitems,$item);
                   11261:                                 if ($dirptr&$testdir) {
                   11262:                                     $is_dir{$item} = 1;
                   11263:                                 }
                   11264:                                 $changes{$item} = 1;
                   11265:                             }
                   11266:                         }
                   11267:                     }
                   11268:                     if (keys(%changes) > 0) {
                   11269:                         foreach my $item (sort(@newitems)) {
                   11270:                             if ($changes{$item}) {
                   11271:                                 push(@contents,$item);
                   11272:                             }
                   11273:                         }
                   11274:                     }
                   11275:                     if (@contents > 0) {
1.1067    raeburn  11276:                         my $wantform;
                   11277:                         unless ($env{'form.autoextract_camtasia'}) {
                   11278:                             $wantform = 1;
                   11279:                         }
1.1056    raeburn  11280:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  11281:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   11282:                                                                 $currdir,\%is_dir,
                   11283:                                                                 \%children,\%parent,
1.1056    raeburn  11284:                                                                 \@contents,\%dirorder,
                   11285:                                                                 \%titles,$wantform);
1.1055    raeburn  11286:                         if ($datatable ne '') {
                   11287:                             $output .= &archive_options_form('decompressed',$datatable,
                   11288:                                                              $count,$hiddenelem);
1.1065    raeburn  11289:                             my $startcount = 6;
1.1055    raeburn  11290:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  11291:                                                            \%titles,\%children);
1.1055    raeburn  11292:                         }
1.1067    raeburn  11293:                         if ($env{'form.autoextract_camtasia'}) {
                   11294:                             my %displayed;
                   11295:                             my $total = 1;
                   11296:                             $env{'form.archive_directory'} = [];
                   11297:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   11298:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   11299:                                 $path =~ s{/$}{};
                   11300:                                 my $item;
                   11301:                                 if ($path ne '') {
                   11302:                                     $item = "$path/$titles{$i}";
                   11303:                                 } else {
                   11304:                                     $item = $titles{$i};
                   11305:                                 }
                   11306:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   11307:                                 if ($item eq $contents[0]) {
                   11308:                                     push(@{$env{'form.archive_directory'}},$i);
                   11309:                                     $env{'form.archive_'.$i} = 'display';
                   11310:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   11311:                                     $displayed{'folder'} = $i;
                   11312:                                 } elsif ($item eq "$contents[0]/index.html") {
                   11313:                                     $env{'form.archive_'.$i} = 'display';
                   11314:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   11315:                                     $displayed{'web'} = $i;
                   11316:                                 } else {
                   11317:                                     if ($item eq "$contents[0]/media") {
                   11318:                                         push(@{$env{'form.archive_directory'}},$i);
                   11319:                                     }
                   11320:                                     $env{'form.archive_'.$i} = 'dependency';
                   11321:                                 }
                   11322:                                 $total ++;
                   11323:                             }
                   11324:                             for (my $i=1; $i<$total; $i++) {
                   11325:                                 next if ($i == $displayed{'web'});
                   11326:                                 next if ($i == $displayed{'folder'});
                   11327:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   11328:                             }
                   11329:                             $env{'form.phase'} = 'decompress_cleanup';
                   11330:                             $env{'form.archivedelete'} = 1;
                   11331:                             $env{'form.archive_count'} = $total-1;
                   11332:                             $output .=
                   11333:                                 &process_extracted_files('coursedocs',$docudom,
                   11334:                                                          $docuname,$destination,
                   11335:                                                          $dir_root,$hiddenelem);
                   11336:                         }
1.1055    raeburn  11337:                     } else {
                   11338:                         $warning = &mt('No new items extracted from archive file.');
                   11339:                     }
                   11340:                 } else {
                   11341:                     $output = $display;
                   11342:                     $error = &mt('An error occurred during extraction from the archive file.');
                   11343:                 }
                   11344:             }
                   11345:         }
                   11346:     }
                   11347:     if ($error) {
                   11348:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11349:                    $error.'</p>'."\n";
                   11350:     }
                   11351:     if ($warning) {
                   11352:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11353:     }
                   11354:     return $output;
                   11355: }
                   11356: 
                   11357: sub get_extracted {
1.1056    raeburn  11358:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   11359:         $titles,$wantform) = @_;
1.1055    raeburn  11360:     my $count = 0;
                   11361:     my $depth = 0;
                   11362:     my $datatable;
1.1056    raeburn  11363:     my @hierarchy;
1.1055    raeburn  11364:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  11365:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   11366:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  11367:     foreach my $item (@{$contents}) {
                   11368:         $count ++;
1.1056    raeburn  11369:         @{$dirorder->{$count}} = @hierarchy;
                   11370:         $titles->{$count} = $item;
1.1055    raeburn  11371:         &archive_hierarchy($depth,$count,$parent,$children);
                   11372:         if ($wantform) {
                   11373:             $datatable .= &archive_row($is_dir->{$item},$item,
                   11374:                                        $currdir,$depth,$count);
                   11375:         }
                   11376:         if ($is_dir->{$item}) {
                   11377:             $depth ++;
1.1056    raeburn  11378:             push(@hierarchy,$count);
                   11379:             $parent->{$depth} = $count;
1.1055    raeburn  11380:             $datatable .=
                   11381:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  11382:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   11383:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  11384:             $depth --;
1.1056    raeburn  11385:             pop(@hierarchy);
1.1055    raeburn  11386:         }
                   11387:     }
                   11388:     return ($count,$datatable);
                   11389: }
                   11390: 
                   11391: sub recurse_extracted_archive {
1.1056    raeburn  11392:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   11393:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  11394:     my $result='';
1.1056    raeburn  11395:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   11396:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   11397:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  11398:         return $result;
                   11399:     }
                   11400:     my $dirptr = 16384;
                   11401:     my ($newdirlistref,$newlisterror) =
                   11402:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   11403:     if (ref($newdirlistref) eq 'ARRAY') {
                   11404:         foreach my $dir_line (@{$newdirlistref}) {
                   11405:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   11406:             unless ($item =~ /^\.+$/) {
                   11407:                 $$count ++;
1.1056    raeburn  11408:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   11409:                 $titles->{$$count} = $item;
1.1055    raeburn  11410:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  11411: 
1.1055    raeburn  11412:                 my $is_dir;
                   11413:                 if ($dirptr&$testdir) {
                   11414:                     $is_dir = 1;
                   11415:                 }
                   11416:                 if ($wantform) {
                   11417:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   11418:                 }
                   11419:                 if ($is_dir) {
                   11420:                     $$depth ++;
1.1056    raeburn  11421:                     push(@{$hierarchy},$$count);
                   11422:                     $parent->{$$depth} = $$count;
1.1055    raeburn  11423:                     $result .=
                   11424:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   11425:                                                    $docuname,$depth,$count,
1.1056    raeburn  11426:                                                    $hierarchy,$dirorder,$children,
                   11427:                                                    $parent,$titles,$wantform);
1.1055    raeburn  11428:                     $$depth --;
1.1056    raeburn  11429:                     pop(@{$hierarchy});
1.1055    raeburn  11430:                 }
                   11431:             }
                   11432:         }
                   11433:     }
                   11434:     return $result;
                   11435: }
                   11436: 
                   11437: sub archive_hierarchy {
                   11438:     my ($depth,$count,$parent,$children) =@_;
                   11439:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   11440:         if (exists($parent->{$depth})) {
                   11441:              $children->{$parent->{$depth}} .= $count.':';
                   11442:         }
                   11443:     }
                   11444:     return;
                   11445: }
                   11446: 
                   11447: sub archive_row {
                   11448:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   11449:     my ($name) = ($item =~ m{([^/]+)$});
                   11450:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  11451:                                        'display'    => 'Add as file',
1.1055    raeburn  11452:                                        'dependency' => 'Include as dependency',
                   11453:                                        'discard'    => 'Discard',
                   11454:                                       );
                   11455:     if ($is_dir) {
1.1059    raeburn  11456:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  11457:     }
1.1056    raeburn  11458:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   11459:     my $offset = 0;
1.1055    raeburn  11460:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  11461:         $offset ++;
1.1065    raeburn  11462:         if ($action ne 'display') {
                   11463:             $offset ++;
                   11464:         }  
1.1055    raeburn  11465:         $output .= '<td><span class="LC_nobreak">'.
                   11466:                    '<label><input type="radio" name="archive_'.$count.
                   11467:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   11468:         my $text = $choices{$action};
                   11469:         if ($is_dir) {
                   11470:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   11471:             if ($action eq 'display') {
1.1059    raeburn  11472:                 $text = &mt('Add as folder');
1.1055    raeburn  11473:             }
1.1056    raeburn  11474:         } else {
                   11475:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   11476: 
                   11477:         }
                   11478:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   11479:         if ($action eq 'dependency') {
                   11480:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   11481:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   11482:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   11483:                        '<option value=""></option>'."\n".
                   11484:                        '</select>'."\n".
                   11485:                        '</div>';
1.1059    raeburn  11486:         } elsif ($action eq 'display') {
                   11487:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   11488:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   11489:                        '</div>';
1.1055    raeburn  11490:         }
1.1056    raeburn  11491:         $output .= '</td>';
1.1055    raeburn  11492:     }
                   11493:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   11494:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   11495:     for (my $i=0; $i<$depth; $i++) {
                   11496:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   11497:     }
                   11498:     if ($is_dir) {
                   11499:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   11500:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   11501:     } else {
                   11502:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   11503:     }
                   11504:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   11505:                &end_data_table_row();
                   11506:     return $output;
                   11507: }
                   11508: 
                   11509: sub archive_options_form {
1.1065    raeburn  11510:     my ($form,$display,$count,$hiddenelem) = @_;
                   11511:     my %lt = &Apache::lonlocal::texthash(
                   11512:                perm => 'Permanently remove archive file?',
                   11513:                hows => 'How should each extracted item be incorporated in the course?',
                   11514:                cont => 'Content actions for all',
                   11515:                addf => 'Add as folder/file',
                   11516:                incd => 'Include as dependency for a displayed file',
                   11517:                disc => 'Discard',
                   11518:                no   => 'No',
                   11519:                yes  => 'Yes',
                   11520:                save => 'Save',
                   11521:     );
                   11522:     my $output = <<"END";
                   11523: <form name="$form" method="post" action="">
                   11524: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   11525: <label>
                   11526:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   11527: </label>
                   11528: &nbsp;
                   11529: <label>
                   11530:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   11531: </span>
                   11532: </p>
                   11533: <input type="hidden" name="phase" value="decompress_cleanup" />
                   11534: <br />$lt{'hows'}
                   11535: <div class="LC_columnSection">
                   11536:   <fieldset>
                   11537:     <legend>$lt{'cont'}</legend>
                   11538:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   11539:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   11540:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   11541:   </fieldset>
                   11542: </div>
                   11543: END
                   11544:     return $output.
1.1055    raeburn  11545:            &start_data_table()."\n".
1.1065    raeburn  11546:            $display."\n".
1.1055    raeburn  11547:            &end_data_table()."\n".
                   11548:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   11549:            $hiddenelem.
1.1065    raeburn  11550:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  11551:            '</form>';
                   11552: }
                   11553: 
                   11554: sub archive_javascript {
1.1056    raeburn  11555:     my ($startcount,$numitems,$titles,$children) = @_;
                   11556:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  11557:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  11558:     my $scripttag = <<START;
                   11559: <script type="text/javascript">
                   11560: // <![CDATA[
                   11561: 
                   11562: function checkAll(form,prefix) {
                   11563:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   11564:     for (var i=0; i < form.elements.length; i++) {
                   11565:         var id = form.elements[i].id;
                   11566:         if ((id != '') && (id != undefined)) {
                   11567:             if (idstr.test(id)) {
                   11568:                 if (form.elements[i].type == 'radio') {
                   11569:                     form.elements[i].checked = true;
1.1056    raeburn  11570:                     var nostart = i-$startcount;
1.1059    raeburn  11571:                     var offset = nostart%7;
                   11572:                     var count = (nostart-offset)/7;    
1.1056    raeburn  11573:                     dependencyCheck(form,count,offset);
1.1055    raeburn  11574:                 }
                   11575:             }
                   11576:         }
                   11577:     }
                   11578: }
                   11579: 
                   11580: function propagateCheck(form,count) {
                   11581:     if (count > 0) {
1.1059    raeburn  11582:         var startelement = $startcount + ((count-1) * 7);
                   11583:         for (var j=1; j<6; j++) {
                   11584:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  11585:                 var item = startelement + j; 
                   11586:                 if (form.elements[item].type == 'radio') {
                   11587:                     if (form.elements[item].checked) {
                   11588:                         containerCheck(form,count,j);
                   11589:                         break;
                   11590:                     }
1.1055    raeburn  11591:                 }
                   11592:             }
                   11593:         }
                   11594:     }
                   11595: }
                   11596: 
                   11597: numitems = $numitems
1.1056    raeburn  11598: var titles = new Array(numitems);
                   11599: var parents = new Array(numitems);
1.1055    raeburn  11600: for (var i=0; i<numitems; i++) {
1.1056    raeburn  11601:     parents[i] = new Array;
1.1055    raeburn  11602: }
1.1059    raeburn  11603: var maintitle = '$maintitle';
1.1055    raeburn  11604: 
                   11605: START
                   11606: 
1.1056    raeburn  11607:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   11608:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  11609:         for (my $i=0; $i<@contents; $i ++) {
                   11610:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   11611:         }
                   11612:     }
                   11613: 
1.1056    raeburn  11614:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   11615:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   11616:     }
                   11617: 
1.1055    raeburn  11618:     $scripttag .= <<END;
                   11619: 
                   11620: function containerCheck(form,count,offset) {
                   11621:     if (count > 0) {
1.1056    raeburn  11622:         dependencyCheck(form,count,offset);
1.1059    raeburn  11623:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  11624:         form.elements[item].checked = true;
                   11625:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11626:             if (parents[count].length > 0) {
                   11627:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  11628:                     containerCheck(form,parents[count][j],offset);
                   11629:                 }
                   11630:             }
                   11631:         }
                   11632:     }
                   11633: }
                   11634: 
                   11635: function dependencyCheck(form,count,offset) {
                   11636:     if (count > 0) {
1.1059    raeburn  11637:         var chosen = (offset+$startcount)+7*(count-1);
                   11638:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  11639:         var currtype = form.elements[depitem].type;
                   11640:         if (form.elements[chosen].value == 'dependency') {
                   11641:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   11642:             form.elements[depitem].options.length = 0;
                   11643:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11  raeburn  11644:             for (var i=1; i<=numitems; i++) {
                   11645:                 if (i == count) {
                   11646:                     continue;
                   11647:                 }
1.1059    raeburn  11648:                 var startelement = $startcount + (i-1) * 7;
                   11649:                 for (var j=1; j<6; j++) {
                   11650:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  11651:                         var item = startelement + j;
                   11652:                         if (form.elements[item].type == 'radio') {
                   11653:                             if (form.elements[item].checked) {
                   11654:                                 if (form.elements[item].value == 'display') {
                   11655:                                     var n = form.elements[depitem].options.length;
                   11656:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   11657:                                 }
                   11658:                             }
                   11659:                         }
                   11660:                     }
                   11661:                 }
                   11662:             }
                   11663:         } else {
                   11664:             document.getElementById('arc_depon_'+count).style.display='none';
                   11665:             form.elements[depitem].options.length = 0;
                   11666:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   11667:         }
1.1059    raeburn  11668:         titleCheck(form,count,offset);
1.1056    raeburn  11669:     }
                   11670: }
                   11671: 
                   11672: function propagateSelect(form,count,offset) {
                   11673:     if (count > 0) {
1.1065    raeburn  11674:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  11675:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   11676:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11677:             if (parents[count].length > 0) {
                   11678:                 for (var j=0; j<parents[count].length; j++) {
                   11679:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  11680:                 }
                   11681:             }
                   11682:         }
                   11683:     }
                   11684: }
1.1056    raeburn  11685: 
                   11686: function containerSelect(form,count,offset,picked) {
                   11687:     if (count > 0) {
1.1065    raeburn  11688:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  11689:         if (form.elements[item].type == 'radio') {
                   11690:             if (form.elements[item].value == 'dependency') {
                   11691:                 if (form.elements[item+1].type == 'select-one') {
                   11692:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   11693:                         if (form.elements[item+1].options[i].value == picked) {
                   11694:                             form.elements[item+1].selectedIndex = i;
                   11695:                             break;
                   11696:                         }
                   11697:                     }
                   11698:                 }
                   11699:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11700:                     if (parents[count].length > 0) {
                   11701:                         for (var j=0; j<parents[count].length; j++) {
                   11702:                             containerSelect(form,parents[count][j],offset,picked);
                   11703:                         }
                   11704:                     }
                   11705:                 }
                   11706:             }
                   11707:         }
                   11708:     }
                   11709: }
                   11710: 
1.1059    raeburn  11711: function titleCheck(form,count,offset) {
                   11712:     if (count > 0) {
                   11713:         var chosen = (offset+$startcount)+7*(count-1);
                   11714:         var depitem = $startcount + ((count-1) * 7) + 2;
                   11715:         var currtype = form.elements[depitem].type;
                   11716:         if (form.elements[chosen].value == 'display') {
                   11717:             document.getElementById('arc_title_'+count).style.display='block';
                   11718:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   11719:                 document.getElementById('archive_title_'+count).value=maintitle;
                   11720:             }
                   11721:         } else {
                   11722:             document.getElementById('arc_title_'+count).style.display='none';
                   11723:             if (currtype == 'text') { 
                   11724:                 document.getElementById('archive_title_'+count).value='';
                   11725:             }
                   11726:         }
                   11727:     }
                   11728:     return;
                   11729: }
                   11730: 
1.1055    raeburn  11731: // ]]>
                   11732: </script>
                   11733: END
                   11734:     return $scripttag;
                   11735: }
                   11736: 
                   11737: sub process_extracted_files {
1.1067    raeburn  11738:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  11739:     my $numitems = $env{'form.archive_count'};
                   11740:     return unless ($numitems);
                   11741:     my @ids=&Apache::lonnet::current_machine_ids();
                   11742:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  11743:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  11744:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11745:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11746:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   11747:         $pathtocheck = "$dir_root/$destination";
                   11748:         $dir = $dir_root;
                   11749:         $ishome = 1;
                   11750:     } else {
                   11751:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   11752:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   11753:         $dir = "$dir_root/$docudom/$docuname";    
                   11754:     }
                   11755:     my $currdir = "$dir_root/$destination";
                   11756:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   11757:     if ($env{'form.folderpath'}) {
                   11758:         my @items = split('&',$env{'form.folderpath'});
                   11759:         $folders{'0'} = $items[-2];
1.1075.2.17  raeburn  11760:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   11761:             $containers{'0'}='page';
                   11762:         } else {
                   11763:             $containers{'0'}='sequence';
                   11764:         }
1.1055    raeburn  11765:     }
                   11766:     my @archdirs = &get_env_multiple('form.archive_directory');
                   11767:     if ($numitems) {
                   11768:         for (my $i=1; $i<=$numitems; $i++) {
                   11769:             my $path = $env{'form.archive_content_'.$i};
                   11770:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   11771:                 my $item = $1;
                   11772:                 $toplevelitems{$item} = $i;
                   11773:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   11774:                     $is_dir{$item} = 1;
                   11775:                 }
                   11776:             }
                   11777:         }
                   11778:     }
1.1067    raeburn  11779:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  11780:     if (keys(%toplevelitems) > 0) {
                   11781:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  11782:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   11783:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  11784:     }
1.1066    raeburn  11785:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  11786:     if ($numitems) {
                   11787:         for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11  raeburn  11788:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  11789:             my $path = $env{'form.archive_content_'.$i};
                   11790:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11791:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   11792:                     if ($prefix ne '' && $path ne '') {
                   11793:                         if (-e $prefix.$path) {
1.1066    raeburn  11794:                             if ((@archdirs > 0) && 
                   11795:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   11796:                                 $todeletedir{$prefix.$path} = 1;
                   11797:                             } else {
                   11798:                                 $todelete{$prefix.$path} = 1;
                   11799:                             }
1.1055    raeburn  11800:                         }
                   11801:                     }
                   11802:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  11803:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  11804:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  11805:                     $docstitle = $env{'form.archive_title_'.$i};
                   11806:                     if ($docstitle eq '') {
                   11807:                         $docstitle = $title;
                   11808:                     }
1.1055    raeburn  11809:                     $outer = 0;
1.1056    raeburn  11810:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11811:                         if (@{$dirorder{$i}} > 0) {
                   11812:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  11813:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   11814:                                     $outer = $item;
                   11815:                                     last;
                   11816:                                 }
                   11817:                             }
                   11818:                         }
                   11819:                     }
                   11820:                     my ($errtext,$fatal) = 
                   11821:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   11822:                                                '/'.$folders{$outer}.'.'.
                   11823:                                                $containers{$outer});
                   11824:                     next if ($fatal);
                   11825:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   11826:                         if ($context eq 'coursedocs') {
1.1056    raeburn  11827:                             $mapinner{$i} = time;
1.1055    raeburn  11828:                             $folders{$i} = 'default_'.$mapinner{$i};
                   11829:                             $containers{$i} = 'sequence';
                   11830:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11831:                                       $folders{$i}.'.'.$containers{$i};
                   11832:                             my $newidx = &LONCAPA::map::getresidx();
                   11833:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11834:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11835:                             push(@LONCAPA::map::order,$newidx);
                   11836:                             my ($outtext,$errtext) =
                   11837:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11838:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  11839:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  11840:                             $newseqid{$i} = $newidx;
1.1067    raeburn  11841:                             unless ($errtext) {
                   11842:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   11843:                             }
1.1055    raeburn  11844:                         }
                   11845:                     } else {
                   11846:                         if ($context eq 'coursedocs') {
                   11847:                             my $newidx=&LONCAPA::map::getresidx();
                   11848:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11849:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   11850:                                       $title;
                   11851:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   11852:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   11853:                             }
                   11854:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11855:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   11856:                             }
                   11857:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11858:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  11859:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  11860:                                 unless ($ishome) {
                   11861:                                     my $fetch = "$newdest{$i}/$title";
                   11862:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   11863:                                     $prompttofetch{$fetch} = 1;
                   11864:                                 }
1.1055    raeburn  11865:                             }
                   11866:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11867:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11868:                             push(@LONCAPA::map::order, $newidx);
                   11869:                             my ($outtext,$errtext)=
                   11870:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11871:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  11872:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  11873:                             unless ($errtext) {
                   11874:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   11875:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   11876:                                 }
                   11877:                             }
1.1055    raeburn  11878:                         }
                   11879:                     }
1.1075.2.11  raeburn  11880:                 }
                   11881:             } else {
                   11882:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
                   11883:             }
                   11884:         }
                   11885:         for (my $i=1; $i<=$numitems; $i++) {
                   11886:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   11887:             my $path = $env{'form.archive_content_'.$i};
                   11888:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11889:                 my ($title) = ($path =~ m{/([^/]+)$});
                   11890:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   11891:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   11892:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11893:                         my ($itemidx,$fullpath,$relpath);
                   11894:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   11895:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  11896:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11  raeburn  11897:                                 if ($dirorder{$i}->[$j] eq $container) {
                   11898:                                     $itemidx = $j;
1.1056    raeburn  11899:                                 }
                   11900:                             }
1.1075.2.11  raeburn  11901:                         }
                   11902:                         if ($itemidx eq '') {
                   11903:                             $itemidx =  0;
                   11904:                         }
                   11905:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   11906:                             if ($mapinner{$referrer{$i}}) {
                   11907:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   11908:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11909:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11910:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11911:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11912:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11913:                                             if (!-e $fullpath) {
                   11914:                                                 mkdir($fullpath,0755);
1.1056    raeburn  11915:                                             }
                   11916:                                         }
1.1075.2.11  raeburn  11917:                                     } else {
                   11918:                                         last;
1.1056    raeburn  11919:                                     }
1.1075.2.11  raeburn  11920:                                 }
                   11921:                             }
                   11922:                         } elsif ($newdest{$referrer{$i}}) {
                   11923:                             $fullpath = $newdest{$referrer{$i}};
                   11924:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11925:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   11926:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   11927:                                     last;
                   11928:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11929:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11930:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11931:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11932:                                         if (!-e $fullpath) {
                   11933:                                             mkdir($fullpath,0755);
1.1056    raeburn  11934:                                         }
                   11935:                                     }
1.1075.2.11  raeburn  11936:                                 } else {
                   11937:                                     last;
1.1056    raeburn  11938:                                 }
1.1075.2.11  raeburn  11939:                             }
                   11940:                         }
                   11941:                         if ($fullpath ne '') {
                   11942:                             if (-e "$prefix$path") {
                   11943:                                 system("mv $prefix$path $fullpath/$title");
                   11944:                             }
                   11945:                             if (-e "$fullpath/$title") {
                   11946:                                 my $showpath;
                   11947:                                 if ($relpath ne '') {
                   11948:                                     $showpath = "$relpath/$title";
                   11949:                                 } else {
                   11950:                                     $showpath = "/$title";
1.1056    raeburn  11951:                                 }
1.1075.2.11  raeburn  11952:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   11953:                             }
                   11954:                             unless ($ishome) {
                   11955:                                 my $fetch = "$fullpath/$title";
                   11956:                                 $fetch =~ s/^\Q$prefix$dir\E//;
                   11957:                                 $prompttofetch{$fetch} = 1;
1.1055    raeburn  11958:                             }
                   11959:                         }
                   11960:                     }
1.1075.2.11  raeburn  11961:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   11962:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   11963:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  11964:                 }
                   11965:             } else {
1.1075.2.11  raeburn  11966:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055    raeburn  11967:             }
                   11968:         }
                   11969:         if (keys(%todelete)) {
                   11970:             foreach my $key (keys(%todelete)) {
                   11971:                 unlink($key);
1.1066    raeburn  11972:             }
                   11973:         }
                   11974:         if (keys(%todeletedir)) {
                   11975:             foreach my $key (keys(%todeletedir)) {
                   11976:                 rmdir($key);
                   11977:             }
                   11978:         }
                   11979:         foreach my $dir (sort(keys(%is_dir))) {
                   11980:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   11981:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  11982:             }
                   11983:         }
1.1067    raeburn  11984:         if ($result ne '') {
                   11985:             $output .= '<ul>'."\n".
                   11986:                        $result."\n".
                   11987:                        '</ul>';
                   11988:         }
                   11989:         unless ($ishome) {
                   11990:             my $replicationfail;
                   11991:             foreach my $item (keys(%prompttofetch)) {
                   11992:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   11993:                 unless ($fetchresult eq 'ok') {
                   11994:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   11995:                 }
                   11996:             }
                   11997:             if ($replicationfail) {
                   11998:                 $output .= '<p class="LC_error">'.
                   11999:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   12000:                            $replicationfail.
                   12001:                            '</ul></p>';
                   12002:             }
                   12003:         }
1.1055    raeburn  12004:     } else {
                   12005:         $warning = &mt('No items found in archive.');
                   12006:     }
                   12007:     if ($error) {
                   12008:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12009:                    $error.'</p>'."\n";
                   12010:     }
                   12011:     if ($warning) {
                   12012:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12013:     }
                   12014:     return $output;
                   12015: }
                   12016: 
1.1066    raeburn  12017: sub cleanup_empty_dirs {
                   12018:     my ($path) = @_;
                   12019:     if (($path ne '') && (-d $path)) {
                   12020:         if (opendir(my $dirh,$path)) {
                   12021:             my @dircontents = grep(!/^\./,readdir($dirh));
                   12022:             my $numitems = 0;
                   12023:             foreach my $item (@dircontents) {
                   12024:                 if (-d "$path/$item") {
1.1075.2.28  raeburn  12025:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  12026:                     if (-e "$path/$item") {
                   12027:                         $numitems ++;
                   12028:                     }
                   12029:                 } else {
                   12030:                     $numitems ++;
                   12031:                 }
                   12032:             }
                   12033:             if ($numitems == 0) {
                   12034:                 rmdir($path);
                   12035:             }
                   12036:             closedir($dirh);
                   12037:         }
                   12038:     }
                   12039:     return;
                   12040: }
                   12041: 
1.41      ng       12042: =pod
1.45      matthew  12043: 
1.1068    raeburn  12044: =item &get_folder_hierarchy()
                   12045: 
                   12046: Provides hierarchy of names of folders/sub-folders containing the current
                   12047: item,
                   12048: 
                   12049: Inputs: 3
                   12050:      - $navmap - navmaps object
                   12051: 
                   12052:      - $map - url for map (either the trigger itself, or map containing
                   12053:                            the resource, which is the trigger).
                   12054: 
                   12055:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   12056: 
                   12057: Outputs: 1 @pathitems - array of folder/subfolder names.
                   12058: 
                   12059: =cut
                   12060: 
                   12061: sub get_folder_hierarchy {
                   12062:     my ($navmap,$map,$showitem) = @_;
                   12063:     my @pathitems;
                   12064:     if (ref($navmap)) {
                   12065:         my $mapres = $navmap->getResourceByUrl($map);
                   12066:         if (ref($mapres)) {
                   12067:             my $pcslist = $mapres->map_hierarchy();
                   12068:             if ($pcslist ne '') {
                   12069:                 my @pcs = split(/,/,$pcslist);
                   12070:                 foreach my $pc (@pcs) {
                   12071:                     if ($pc == 1) {
1.1075.2.38  raeburn  12072:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  12073:                     } else {
                   12074:                         my $res = $navmap->getByMapPc($pc);
                   12075:                         if (ref($res)) {
                   12076:                             my $title = $res->compTitle();
                   12077:                             $title =~ s/\W+/_/g;
                   12078:                             if ($title ne '') {
                   12079:                                 push(@pathitems,$title);
                   12080:                             }
                   12081:                         }
                   12082:                     }
                   12083:                 }
                   12084:             }
1.1071    raeburn  12085:             if ($showitem) {
                   12086:                 if ($mapres->{ID} eq '0.0') {
1.1075.2.38  raeburn  12087:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  12088:                 } else {
                   12089:                     my $maptitle = $mapres->compTitle();
                   12090:                     $maptitle =~ s/\W+/_/g;
                   12091:                     if ($maptitle ne '') {
                   12092:                         push(@pathitems,$maptitle);
                   12093:                     }
1.1068    raeburn  12094:                 }
                   12095:             }
                   12096:         }
                   12097:     }
                   12098:     return @pathitems;
                   12099: }
                   12100: 
                   12101: =pod
                   12102: 
1.1015    raeburn  12103: =item * &get_turnedin_filepath()
                   12104: 
                   12105: Determines path in a user's portfolio file for storage of files uploaded
                   12106: to a specific essayresponse or dropbox item.
                   12107: 
                   12108: Inputs: 3 required + 1 optional.
                   12109: $symb is symb for resource, $uname and $udom are for current user (required).
                   12110: $caller is optional (can be "submission", if routine is called when storing
                   12111: an upoaded file when "Submit Answer" button was pressed).
                   12112: 
                   12113: Returns array containing $path and $multiresp. 
                   12114: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   12115: than one file upload item.  Callers of routine should append partid as a 
                   12116: subdirectory to $path in cases where $multiresp is 1.
                   12117: 
                   12118: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   12119: 
                   12120: =cut
                   12121: 
                   12122: sub get_turnedin_filepath {
                   12123:     my ($symb,$uname,$udom,$caller) = @_;
                   12124:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   12125:     my $turnindir;
                   12126:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   12127:     $turnindir = $userhash{'turnindir'};
                   12128:     my ($path,$multiresp);
                   12129:     if ($turnindir eq '') {
                   12130:         if ($caller eq 'submission') {
                   12131:             $turnindir = &mt('turned in');
                   12132:             $turnindir =~ s/\W+/_/g;
                   12133:             my %newhash = (
                   12134:                             'turnindir' => $turnindir,
                   12135:                           );
                   12136:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   12137:         }
                   12138:     }
                   12139:     if ($turnindir ne '') {
                   12140:         $path = '/'.$turnindir.'/';
                   12141:         my ($multipart,$turnin,@pathitems);
                   12142:         my $navmap = Apache::lonnavmaps::navmap->new();
                   12143:         if (defined($navmap)) {
                   12144:             my $mapres = $navmap->getResourceByUrl($map);
                   12145:             if (ref($mapres)) {
                   12146:                 my $pcslist = $mapres->map_hierarchy();
                   12147:                 if ($pcslist ne '') {
                   12148:                     foreach my $pc (split(/,/,$pcslist)) {
                   12149:                         my $res = $navmap->getByMapPc($pc);
                   12150:                         if (ref($res)) {
                   12151:                             my $title = $res->compTitle();
                   12152:                             $title =~ s/\W+/_/g;
                   12153:                             if ($title ne '') {
                   12154:                                 push(@pathitems,$title);
                   12155:                             }
                   12156:                         }
                   12157:                     }
                   12158:                 }
                   12159:                 my $maptitle = $mapres->compTitle();
                   12160:                 $maptitle =~ s/\W+/_/g;
                   12161:                 if ($maptitle ne '') {
                   12162:                     push(@pathitems,$maptitle);
                   12163:                 }
                   12164:                 unless ($env{'request.state'} eq 'construct') {
                   12165:                     my $res = $navmap->getBySymb($symb);
                   12166:                     if (ref($res)) {
                   12167:                         my $partlist = $res->parts();
                   12168:                         my $totaluploads = 0;
                   12169:                         if (ref($partlist) eq 'ARRAY') {
                   12170:                             foreach my $part (@{$partlist}) {
                   12171:                                 my @types = $res->responseType($part);
                   12172:                                 my @ids = $res->responseIds($part);
                   12173:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   12174:                                     if ($types[$i] eq 'essay') {
                   12175:                                         my $partid = $part.'_'.$ids[$i];
                   12176:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   12177:                                             $totaluploads ++;
                   12178:                                         }
                   12179:                                     }
                   12180:                                 }
                   12181:                             }
                   12182:                             if ($totaluploads > 1) {
                   12183:                                 $multiresp = 1;
                   12184:                             }
                   12185:                         }
                   12186:                     }
                   12187:                 }
                   12188:             } else {
                   12189:                 return;
                   12190:             }
                   12191:         } else {
                   12192:             return;
                   12193:         }
                   12194:         my $restitle=&Apache::lonnet::gettitle($symb);
                   12195:         $restitle =~ s/\W+/_/g;
                   12196:         if ($restitle eq '') {
                   12197:             $restitle = ($resurl =~ m{/[^/]+$});
                   12198:             if ($restitle eq '') {
                   12199:                 $restitle = time;
                   12200:             }
                   12201:         }
                   12202:         push(@pathitems,$restitle);
                   12203:         $path .= join('/',@pathitems);
                   12204:     }
                   12205:     return ($path,$multiresp);
                   12206: }
                   12207: 
                   12208: =pod
                   12209: 
1.464     albertel 12210: =back
1.41      ng       12211: 
1.112     bowersj2 12212: =head1 CSV Upload/Handling functions
1.38      albertel 12213: 
1.41      ng       12214: =over 4
                   12215: 
1.648     raeburn  12216: =item * &upfile_store($r)
1.41      ng       12217: 
                   12218: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 12219: needs $env{'form.upfile'}
1.41      ng       12220: returns $datatoken to be put into hidden field
                   12221: 
                   12222: =cut
1.31      albertel 12223: 
                   12224: sub upfile_store {
                   12225:     my $r=shift;
1.258     albertel 12226:     $env{'form.upfile'}=~s/\r/\n/gs;
                   12227:     $env{'form.upfile'}=~s/\f/\n/gs;
                   12228:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   12229:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 12230: 
1.258     albertel 12231:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   12232: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 12233:     {
1.158     raeburn  12234:         my $datafile = $r->dir_config('lonDaemons').
                   12235:                            '/tmp/'.$datatoken.'.tmp';
                   12236:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 12237:             print $fh $env{'form.upfile'};
1.158     raeburn  12238:             close($fh);
                   12239:         }
1.31      albertel 12240:     }
                   12241:     return $datatoken;
                   12242: }
                   12243: 
1.56      matthew  12244: =pod
                   12245: 
1.648     raeburn  12246: =item * &load_tmp_file($r)
1.41      ng       12247: 
                   12248: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 12249: needs $env{'form.datatoken'},
                   12250: sets $env{'form.upfile'} to the contents of the file
1.41      ng       12251: 
                   12252: =cut
1.31      albertel 12253: 
                   12254: sub load_tmp_file {
                   12255:     my $r=shift;
                   12256:     my @studentdata=();
                   12257:     {
1.158     raeburn  12258:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 12259:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  12260:         if ( open(my $fh,"<$studentfile") ) {
                   12261:             @studentdata=<$fh>;
                   12262:             close($fh);
                   12263:         }
1.31      albertel 12264:     }
1.258     albertel 12265:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 12266: }
                   12267: 
1.56      matthew  12268: =pod
                   12269: 
1.648     raeburn  12270: =item * &upfile_record_sep()
1.41      ng       12271: 
                   12272: Separate uploaded file into records
                   12273: returns array of records,
1.258     albertel 12274: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       12275: 
                   12276: =cut
1.31      albertel 12277: 
                   12278: sub upfile_record_sep {
1.258     albertel 12279:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 12280:     } else {
1.248     albertel 12281: 	my @records;
1.258     albertel 12282: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 12283: 	    if ($line=~/^\s*$/) { next; }
                   12284: 	    push(@records,$line);
                   12285: 	}
                   12286: 	return @records;
1.31      albertel 12287:     }
                   12288: }
                   12289: 
1.56      matthew  12290: =pod
                   12291: 
1.648     raeburn  12292: =item * &record_sep($record)
1.41      ng       12293: 
1.258     albertel 12294: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       12295: 
                   12296: =cut
                   12297: 
1.263     www      12298: sub takeleft {
                   12299:     my $index=shift;
                   12300:     return substr('0000'.$index,-4,4);
                   12301: }
                   12302: 
1.31      albertel 12303: sub record_sep {
                   12304:     my $record=shift;
                   12305:     my %components=();
1.258     albertel 12306:     if ($env{'form.upfiletype'} eq 'xml') {
                   12307:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 12308:         my $i=0;
1.356     albertel 12309:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 12310:             $field=~s/^(\"|\')//;
                   12311:             $field=~s/(\"|\')$//;
1.263     www      12312:             $components{&takeleft($i)}=$field;
1.31      albertel 12313:             $i++;
                   12314:         }
1.258     albertel 12315:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 12316:         my $i=0;
1.356     albertel 12317:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 12318:             $field=~s/^(\"|\')//;
                   12319:             $field=~s/(\"|\')$//;
1.263     www      12320:             $components{&takeleft($i)}=$field;
1.31      albertel 12321:             $i++;
                   12322:         }
                   12323:     } else {
1.561     www      12324:         my $separator=',';
1.480     banghart 12325:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      12326:             $separator=';';
1.480     banghart 12327:         }
1.31      albertel 12328:         my $i=0;
1.561     www      12329: # the character we are looking for to indicate the end of a quote or a record 
                   12330:         my $looking_for=$separator;
                   12331: # do not add the characters to the fields
                   12332:         my $ignore=0;
                   12333: # we just encountered a separator (or the beginning of the record)
                   12334:         my $just_found_separator=1;
                   12335: # store the field we are working on here
                   12336:         my $field='';
                   12337: # work our way through all characters in record
                   12338:         foreach my $character ($record=~/(.)/g) {
                   12339:             if ($character eq $looking_for) {
                   12340:                if ($character ne $separator) {
                   12341: # Found the end of a quote, again looking for separator
                   12342:                   $looking_for=$separator;
                   12343:                   $ignore=1;
                   12344:                } else {
                   12345: # Found a separator, store away what we got
                   12346:                   $components{&takeleft($i)}=$field;
                   12347: 	          $i++;
                   12348:                   $just_found_separator=1;
                   12349:                   $ignore=0;
                   12350:                   $field='';
                   12351:                }
                   12352:                next;
                   12353:             }
                   12354: # single or double quotation marks after a separator indicate beginning of a quote
                   12355: # we are now looking for the end of the quote and need to ignore separators
                   12356:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   12357:                $looking_for=$character;
                   12358:                next;
                   12359:             }
                   12360: # ignore would be true after we reached the end of a quote
                   12361:             if ($ignore) { next; }
                   12362:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   12363:             $field.=$character;
                   12364:             $just_found_separator=0; 
1.31      albertel 12365:         }
1.561     www      12366: # catch the very last entry, since we never encountered the separator
                   12367:         $components{&takeleft($i)}=$field;
1.31      albertel 12368:     }
                   12369:     return %components;
                   12370: }
                   12371: 
1.144     matthew  12372: ######################################################
                   12373: ######################################################
                   12374: 
1.56      matthew  12375: =pod
                   12376: 
1.648     raeburn  12377: =item * &upfile_select_html()
1.41      ng       12378: 
1.144     matthew  12379: Return HTML code to select a file from the users machine and specify 
                   12380: the file type.
1.41      ng       12381: 
                   12382: =cut
                   12383: 
1.144     matthew  12384: ######################################################
                   12385: ######################################################
1.31      albertel 12386: sub upfile_select_html {
1.144     matthew  12387:     my %Types = (
                   12388:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 12389:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  12390:                  space => &mt('Space separated'),
                   12391:                  tab   => &mt('Tabulator separated'),
                   12392: #                 xml   => &mt('HTML/XML'),
                   12393:                  );
                   12394:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  12395:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  12396:     foreach my $type (sort(keys(%Types))) {
                   12397:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   12398:     }
                   12399:     $Str .= "</select>\n";
                   12400:     return $Str;
1.31      albertel 12401: }
                   12402: 
1.301     albertel 12403: sub get_samples {
                   12404:     my ($records,$toget) = @_;
                   12405:     my @samples=({});
                   12406:     my $got=0;
                   12407:     foreach my $rec (@$records) {
                   12408: 	my %temp = &record_sep($rec);
                   12409: 	if (! grep(/\S/, values(%temp))) { next; }
                   12410: 	if (%temp) {
                   12411: 	    $samples[$got]=\%temp;
                   12412: 	    $got++;
                   12413: 	    if ($got == $toget) { last; }
                   12414: 	}
                   12415:     }
                   12416:     return \@samples;
                   12417: }
                   12418: 
1.144     matthew  12419: ######################################################
                   12420: ######################################################
                   12421: 
1.56      matthew  12422: =pod
                   12423: 
1.648     raeburn  12424: =item * &csv_print_samples($r,$records)
1.41      ng       12425: 
                   12426: Prints a table of sample values from each column uploaded $r is an
                   12427: Apache Request ref, $records is an arrayref from
                   12428: &Apache::loncommon::upfile_record_sep
                   12429: 
                   12430: =cut
                   12431: 
1.144     matthew  12432: ######################################################
                   12433: ######################################################
1.31      albertel 12434: sub csv_print_samples {
                   12435:     my ($r,$records) = @_;
1.662     bisitz   12436:     my $samples = &get_samples($records,5);
1.301     albertel 12437: 
1.594     raeburn  12438:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   12439:               &start_data_table_header_row());
1.356     albertel 12440:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   12441:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  12442:     $r->print(&end_data_table_header_row());
1.301     albertel 12443:     foreach my $hash (@$samples) {
1.594     raeburn  12444: 	$r->print(&start_data_table_row());
1.356     albertel 12445: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 12446: 	    $r->print('<td>');
1.356     albertel 12447: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 12448: 	    $r->print('</td>');
                   12449: 	}
1.594     raeburn  12450: 	$r->print(&end_data_table_row());
1.31      albertel 12451:     }
1.594     raeburn  12452:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 12453: }
                   12454: 
1.144     matthew  12455: ######################################################
                   12456: ######################################################
                   12457: 
1.56      matthew  12458: =pod
                   12459: 
1.648     raeburn  12460: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       12461: 
                   12462: Prints a table to create associations between values and table columns.
1.144     matthew  12463: 
1.41      ng       12464: $r is an Apache Request ref,
                   12465: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  12466: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       12467: 
                   12468: =cut
                   12469: 
1.144     matthew  12470: ######################################################
                   12471: ######################################################
1.31      albertel 12472: sub csv_print_select_table {
                   12473:     my ($r,$records,$d) = @_;
1.301     albertel 12474:     my $i=0;
                   12475:     my $samples = &get_samples($records,1);
1.144     matthew  12476:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  12477: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  12478:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  12479:               '<th>'.&mt('Column').'</th>'.
                   12480:               &end_data_table_header_row()."\n");
1.356     albertel 12481:     foreach my $array_ref (@$d) {
                   12482: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  12483: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 12484: 
1.875     bisitz   12485: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  12486: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 12487: 	$r->print('<option value="none"></option>');
1.356     albertel 12488: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   12489: 	    $r->print('<option value="'.$sample.'"'.
                   12490:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   12491:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 12492: 	}
1.594     raeburn  12493: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 12494: 	$i++;
                   12495:     }
1.594     raeburn  12496:     $r->print(&end_data_table());
1.31      albertel 12497:     $i--;
                   12498:     return $i;
                   12499: }
1.56      matthew  12500: 
1.144     matthew  12501: ######################################################
                   12502: ######################################################
                   12503: 
1.56      matthew  12504: =pod
1.31      albertel 12505: 
1.648     raeburn  12506: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       12507: 
                   12508: Prints a table of sample values from the upload and can make associate samples to internal names.
                   12509: 
                   12510: $r is an Apache Request ref,
                   12511: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   12512: $d is an array of 2 element arrays (internal name, displayed name)
                   12513: 
                   12514: =cut
                   12515: 
1.144     matthew  12516: ######################################################
                   12517: ######################################################
1.31      albertel 12518: sub csv_samples_select_table {
                   12519:     my ($r,$records,$d) = @_;
                   12520:     my $i=0;
1.144     matthew  12521:     #
1.662     bisitz   12522:     my $max_samples = 5;
                   12523:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  12524:     $r->print(&start_data_table().
                   12525:               &start_data_table_header_row().'<th>'.
                   12526:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   12527:               &end_data_table_header_row());
1.301     albertel 12528: 
                   12529:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  12530: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  12531: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 12532: 	foreach my $option (@$d) {
                   12533: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  12534: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 12535:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  12536:                       $display.'</option>');
1.31      albertel 12537: 	}
                   12538: 	$r->print('</select></td><td>');
1.662     bisitz   12539: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 12540: 	    if (defined($samples->[$line]{$key})) { 
                   12541: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   12542: 	    }
                   12543: 	}
1.594     raeburn  12544: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 12545: 	$i++;
                   12546:     }
1.594     raeburn  12547:     $r->print(&end_data_table());
1.31      albertel 12548:     $i--;
                   12549:     return($i);
1.115     matthew  12550: }
                   12551: 
1.144     matthew  12552: ######################################################
                   12553: ######################################################
                   12554: 
1.115     matthew  12555: =pod
                   12556: 
1.648     raeburn  12557: =item * &clean_excel_name($name)
1.115     matthew  12558: 
                   12559: Returns a replacement for $name which does not contain any illegal characters.
                   12560: 
                   12561: =cut
                   12562: 
1.144     matthew  12563: ######################################################
                   12564: ######################################################
1.115     matthew  12565: sub clean_excel_name {
                   12566:     my ($name) = @_;
                   12567:     $name =~ s/[:\*\?\/\\]//g;
                   12568:     if (length($name) > 31) {
                   12569:         $name = substr($name,0,31);
                   12570:     }
                   12571:     return $name;
1.25      albertel 12572: }
1.84      albertel 12573: 
1.85      albertel 12574: =pod
                   12575: 
1.648     raeburn  12576: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 12577: 
                   12578: Returns either 1 or undef
                   12579: 
                   12580: 1 if the part is to be hidden, undef if it is to be shown
                   12581: 
                   12582: Arguments are:
                   12583: 
                   12584: $id the id of the part to be checked
                   12585: $symb, optional the symb of the resource to check
                   12586: $udom, optional the domain of the user to check for
                   12587: $uname, optional the username of the user to check for
                   12588: 
                   12589: =cut
1.84      albertel 12590: 
                   12591: sub check_if_partid_hidden {
                   12592:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 12593:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 12594: 					 $symb,$udom,$uname);
1.141     albertel 12595:     my $truth=1;
                   12596:     #if the string starts with !, then the list is the list to show not hide
                   12597:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 12598:     my @hiddenlist=split(/,/,$hiddenparts);
                   12599:     foreach my $checkid (@hiddenlist) {
1.141     albertel 12600: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 12601:     }
1.141     albertel 12602:     return !$truth;
1.84      albertel 12603: }
1.127     matthew  12604: 
1.138     matthew  12605: 
                   12606: ############################################################
                   12607: ############################################################
                   12608: 
                   12609: =pod
                   12610: 
1.157     matthew  12611: =back 
                   12612: 
1.138     matthew  12613: =head1 cgi-bin script and graphing routines
                   12614: 
1.157     matthew  12615: =over 4
                   12616: 
1.648     raeburn  12617: =item * &get_cgi_id()
1.138     matthew  12618: 
                   12619: Inputs: none
                   12620: 
                   12621: Returns an id which can be used to pass environment variables
                   12622: to various cgi-bin scripts.  These environment variables will
                   12623: be removed from the users environment after a given time by
                   12624: the routine &Apache::lonnet::transfer_profile_to_env.
                   12625: 
                   12626: =cut
                   12627: 
                   12628: ############################################################
                   12629: ############################################################
1.152     albertel 12630: my $uniq=0;
1.136     matthew  12631: sub get_cgi_id {
1.154     albertel 12632:     $uniq=($uniq+1)%100000;
1.280     albertel 12633:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  12634: }
                   12635: 
1.127     matthew  12636: ############################################################
                   12637: ############################################################
                   12638: 
                   12639: =pod
                   12640: 
1.648     raeburn  12641: =item * &DrawBarGraph()
1.127     matthew  12642: 
1.138     matthew  12643: Facilitates the plotting of data in a (stacked) bar graph.
                   12644: Puts plot definition data into the users environment in order for 
                   12645: graph.png to plot it.  Returns an <img> tag for the plot.
                   12646: The bars on the plot are labeled '1','2',...,'n'.
                   12647: 
                   12648: Inputs:
                   12649: 
                   12650: =over 4
                   12651: 
                   12652: =item $Title: string, the title of the plot
                   12653: 
                   12654: =item $xlabel: string, text describing the X-axis of the plot
                   12655: 
                   12656: =item $ylabel: string, text describing the Y-axis of the plot
                   12657: 
                   12658: =item $Max: scalar, the maximum Y value to use in the plot
                   12659: If $Max is < any data point, the graph will not be rendered.
                   12660: 
1.140     matthew  12661: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  12662: they are plotted.  If undefined, default values will be used.
                   12663: 
1.178     matthew  12664: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   12665: 
1.138     matthew  12666: =item @Values: An array of array references.  Each array reference holds data
                   12667: to be plotted in a stacked bar chart.
                   12668: 
1.239     matthew  12669: =item If the final element of @Values is a hash reference the key/value
                   12670: pairs will be added to the graph definition.
                   12671: 
1.138     matthew  12672: =back
                   12673: 
                   12674: Returns:
                   12675: 
                   12676: An <img> tag which references graph.png and the appropriate identifying
                   12677: information for the plot.
                   12678: 
1.127     matthew  12679: =cut
                   12680: 
                   12681: ############################################################
                   12682: ############################################################
1.134     matthew  12683: sub DrawBarGraph {
1.178     matthew  12684:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  12685:     #
                   12686:     if (! defined($colors)) {
                   12687:         $colors = ['#33ff00', 
                   12688:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   12689:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   12690:                   ]; 
                   12691:     }
1.228     matthew  12692:     my $extra_settings = {};
                   12693:     if (ref($Values[-1]) eq 'HASH') {
                   12694:         $extra_settings = pop(@Values);
                   12695:     }
1.127     matthew  12696:     #
1.136     matthew  12697:     my $identifier = &get_cgi_id();
                   12698:     my $id = 'cgi.'.$identifier;        
1.129     matthew  12699:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  12700:         return '';
                   12701:     }
1.225     matthew  12702:     #
                   12703:     my @Labels;
                   12704:     if (defined($labels)) {
                   12705:         @Labels = @$labels;
                   12706:     } else {
                   12707:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   12708:             push (@Labels,$i+1);
                   12709:         }
                   12710:     }
                   12711:     #
1.129     matthew  12712:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  12713:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  12714:     my %ValuesHash;
                   12715:     my $NumSets=1;
                   12716:     foreach my $array (@Values) {
                   12717:         next if (! ref($array));
1.136     matthew  12718:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  12719:             join(',',@$array);
1.129     matthew  12720:     }
1.127     matthew  12721:     #
1.136     matthew  12722:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  12723:     if ($NumBars < 3) {
                   12724:         $width = 120+$NumBars*32;
1.220     matthew  12725:         $xskip = 1;
1.225     matthew  12726:         $bar_width = 30;
                   12727:     } elsif ($NumBars < 5) {
                   12728:         $width = 120+$NumBars*20;
                   12729:         $xskip = 1;
                   12730:         $bar_width = 20;
1.220     matthew  12731:     } elsif ($NumBars < 10) {
1.136     matthew  12732:         $width = 120+$NumBars*15;
                   12733:         $xskip = 1;
                   12734:         $bar_width = 15;
                   12735:     } elsif ($NumBars <= 25) {
                   12736:         $width = 120+$NumBars*11;
                   12737:         $xskip = 5;
                   12738:         $bar_width = 8;
                   12739:     } elsif ($NumBars <= 50) {
                   12740:         $width = 120+$NumBars*8;
                   12741:         $xskip = 5;
                   12742:         $bar_width = 4;
                   12743:     } else {
                   12744:         $width = 120+$NumBars*8;
                   12745:         $xskip = 5;
                   12746:         $bar_width = 4;
                   12747:     }
                   12748:     #
1.137     matthew  12749:     $Max = 1 if ($Max < 1);
                   12750:     if ( int($Max) < $Max ) {
                   12751:         $Max++;
                   12752:         $Max = int($Max);
                   12753:     }
1.127     matthew  12754:     $Title  = '' if (! defined($Title));
                   12755:     $xlabel = '' if (! defined($xlabel));
                   12756:     $ylabel = '' if (! defined($ylabel));
1.369     www      12757:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   12758:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   12759:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  12760:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  12761:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   12762:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   12763:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   12764:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12765:     $ValuesHash{$id.'.height'}   = $height;
                   12766:     $ValuesHash{$id.'.width'}    = $width;
                   12767:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   12768:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   12769:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  12770:     #
1.228     matthew  12771:     # Deal with other parameters
                   12772:     while (my ($key,$value) = each(%$extra_settings)) {
                   12773:         $ValuesHash{$id.'.'.$key} = $value;
                   12774:     }
                   12775:     #
1.646     raeburn  12776:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  12777:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12778: }
                   12779: 
                   12780: ############################################################
                   12781: ############################################################
                   12782: 
                   12783: =pod
                   12784: 
1.648     raeburn  12785: =item * &DrawXYGraph()
1.137     matthew  12786: 
1.138     matthew  12787: Facilitates the plotting of data in an XY graph.
                   12788: Puts plot definition data into the users environment in order for 
                   12789: graph.png to plot it.  Returns an <img> tag for the plot.
                   12790: 
                   12791: Inputs:
                   12792: 
                   12793: =over 4
                   12794: 
                   12795: =item $Title: string, the title of the plot
                   12796: 
                   12797: =item $xlabel: string, text describing the X-axis of the plot
                   12798: 
                   12799: =item $ylabel: string, text describing the Y-axis of the plot
                   12800: 
                   12801: =item $Max: scalar, the maximum Y value to use in the plot
                   12802: If $Max is < any data point, the graph will not be rendered.
                   12803: 
                   12804: =item $colors: Array ref containing the hex color codes for the data to be 
                   12805: plotted in.  If undefined, default values will be used.
                   12806: 
                   12807: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12808: 
                   12809: =item $Ydata: Array ref containing Array refs.  
1.185     www      12810: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  12811: 
                   12812: =item %Values: hash indicating or overriding any default values which are 
                   12813: passed to graph.png.  
                   12814: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12815: 
                   12816: =back
                   12817: 
                   12818: Returns:
                   12819: 
                   12820: An <img> tag which references graph.png and the appropriate identifying
                   12821: information for the plot.
                   12822: 
1.137     matthew  12823: =cut
                   12824: 
                   12825: ############################################################
                   12826: ############################################################
                   12827: sub DrawXYGraph {
                   12828:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   12829:     #
                   12830:     # Create the identifier for the graph
                   12831:     my $identifier = &get_cgi_id();
                   12832:     my $id = 'cgi.'.$identifier;
                   12833:     #
                   12834:     $Title  = '' if (! defined($Title));
                   12835:     $xlabel = '' if (! defined($xlabel));
                   12836:     $ylabel = '' if (! defined($ylabel));
                   12837:     my %ValuesHash = 
                   12838:         (
1.369     www      12839:          $id.'.title'  => &escape($Title),
                   12840:          $id.'.xlabel' => &escape($xlabel),
                   12841:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  12842:          $id.'.y_max_value'=> $Max,
                   12843:          $id.'.labels'     => join(',',@$Xlabels),
                   12844:          $id.'.PlotType'   => 'XY',
                   12845:          );
                   12846:     #
                   12847:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12848:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12849:     }
                   12850:     #
                   12851:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   12852:         return '';
                   12853:     }
                   12854:     my $NumSets=1;
1.138     matthew  12855:     foreach my $array (@{$Ydata}){
1.137     matthew  12856:         next if (! ref($array));
                   12857:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   12858:     }
1.138     matthew  12859:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  12860:     #
                   12861:     # Deal with other parameters
                   12862:     while (my ($key,$value) = each(%Values)) {
                   12863:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  12864:     }
                   12865:     #
1.646     raeburn  12866:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  12867:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12868: }
                   12869: 
                   12870: ############################################################
                   12871: ############################################################
                   12872: 
                   12873: =pod
                   12874: 
1.648     raeburn  12875: =item * &DrawXYYGraph()
1.138     matthew  12876: 
                   12877: Facilitates the plotting of data in an XY graph with two Y axes.
                   12878: Puts plot definition data into the users environment in order for 
                   12879: graph.png to plot it.  Returns an <img> tag for the plot.
                   12880: 
                   12881: Inputs:
                   12882: 
                   12883: =over 4
                   12884: 
                   12885: =item $Title: string, the title of the plot
                   12886: 
                   12887: =item $xlabel: string, text describing the X-axis of the plot
                   12888: 
                   12889: =item $ylabel: string, text describing the Y-axis of the plot
                   12890: 
                   12891: =item $colors: Array ref containing the hex color codes for the data to be 
                   12892: plotted in.  If undefined, default values will be used.
                   12893: 
                   12894: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12895: 
                   12896: =item $Ydata1: The first data set
                   12897: 
                   12898: =item $Min1: The minimum value of the left Y-axis
                   12899: 
                   12900: =item $Max1: The maximum value of the left Y-axis
                   12901: 
                   12902: =item $Ydata2: The second data set
                   12903: 
                   12904: =item $Min2: The minimum value of the right Y-axis
                   12905: 
                   12906: =item $Max2: The maximum value of the left Y-axis
                   12907: 
                   12908: =item %Values: hash indicating or overriding any default values which are 
                   12909: passed to graph.png.  
                   12910: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12911: 
                   12912: =back
                   12913: 
                   12914: Returns:
                   12915: 
                   12916: An <img> tag which references graph.png and the appropriate identifying
                   12917: information for the plot.
1.136     matthew  12918: 
                   12919: =cut
                   12920: 
                   12921: ############################################################
                   12922: ############################################################
1.137     matthew  12923: sub DrawXYYGraph {
                   12924:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   12925:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  12926:     #
                   12927:     # Create the identifier for the graph
                   12928:     my $identifier = &get_cgi_id();
                   12929:     my $id = 'cgi.'.$identifier;
                   12930:     #
                   12931:     $Title  = '' if (! defined($Title));
                   12932:     $xlabel = '' if (! defined($xlabel));
                   12933:     $ylabel = '' if (! defined($ylabel));
                   12934:     my %ValuesHash = 
                   12935:         (
1.369     www      12936:          $id.'.title'  => &escape($Title),
                   12937:          $id.'.xlabel' => &escape($xlabel),
                   12938:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  12939:          $id.'.labels' => join(',',@$Xlabels),
                   12940:          $id.'.PlotType' => 'XY',
                   12941:          $id.'.NumSets' => 2,
1.137     matthew  12942:          $id.'.two_axes' => 1,
                   12943:          $id.'.y1_max_value' => $Max1,
                   12944:          $id.'.y1_min_value' => $Min1,
                   12945:          $id.'.y2_max_value' => $Max2,
                   12946:          $id.'.y2_min_value' => $Min2,
1.136     matthew  12947:          );
                   12948:     #
1.137     matthew  12949:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12950:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12951:     }
                   12952:     #
                   12953:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   12954:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  12955:         return '';
                   12956:     }
                   12957:     my $NumSets=1;
1.137     matthew  12958:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  12959:         next if (! ref($array));
                   12960:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  12961:     }
                   12962:     #
                   12963:     # Deal with other parameters
                   12964:     while (my ($key,$value) = each(%Values)) {
                   12965:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  12966:     }
                   12967:     #
1.646     raeburn  12968:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 12969:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  12970: }
                   12971: 
                   12972: ############################################################
                   12973: ############################################################
                   12974: 
                   12975: =pod
                   12976: 
1.157     matthew  12977: =back 
                   12978: 
1.139     matthew  12979: =head1 Statistics helper routines?  
                   12980: 
                   12981: Bad place for them but what the hell.
                   12982: 
1.157     matthew  12983: =over 4
                   12984: 
1.648     raeburn  12985: =item * &chartlink()
1.139     matthew  12986: 
                   12987: Returns a link to the chart for a specific student.  
                   12988: 
                   12989: Inputs:
                   12990: 
                   12991: =over 4
                   12992: 
                   12993: =item $linktext: The text of the link
                   12994: 
                   12995: =item $sname: The students username
                   12996: 
                   12997: =item $sdomain: The students domain
                   12998: 
                   12999: =back
                   13000: 
1.157     matthew  13001: =back
                   13002: 
1.139     matthew  13003: =cut
                   13004: 
                   13005: ############################################################
                   13006: ############################################################
                   13007: sub chartlink {
                   13008:     my ($linktext, $sname, $sdomain) = @_;
                   13009:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      13010:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 13011:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  13012:        '">'.$linktext.'</a>';
1.153     matthew  13013: }
                   13014: 
                   13015: #######################################################
                   13016: #######################################################
                   13017: 
                   13018: =pod
                   13019: 
                   13020: =head1 Course Environment Routines
1.157     matthew  13021: 
                   13022: =over 4
1.153     matthew  13023: 
1.648     raeburn  13024: =item * &restore_course_settings()
1.153     matthew  13025: 
1.648     raeburn  13026: =item * &store_course_settings()
1.153     matthew  13027: 
                   13028: Restores/Store indicated form parameters from the course environment.
                   13029: Will not overwrite existing values of the form parameters.
                   13030: 
                   13031: Inputs: 
                   13032: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   13033: 
                   13034: a hash ref describing the data to be stored.  For example:
                   13035:    
                   13036: %Save_Parameters = ('Status' => 'scalar',
                   13037:     'chartoutputmode' => 'scalar',
                   13038:     'chartoutputdata' => 'scalar',
                   13039:     'Section' => 'array',
1.373     raeburn  13040:     'Group' => 'array',
1.153     matthew  13041:     'StudentData' => 'array',
                   13042:     'Maps' => 'array');
                   13043: 
                   13044: Returns: both routines return nothing
                   13045: 
1.631     raeburn  13046: =back
                   13047: 
1.153     matthew  13048: =cut
                   13049: 
                   13050: #######################################################
                   13051: #######################################################
                   13052: sub store_course_settings {
1.496     albertel 13053:     return &store_settings($env{'request.course.id'},@_);
                   13054: }
                   13055: 
                   13056: sub store_settings {
1.153     matthew  13057:     # save to the environment
                   13058:     # appenv the same items, just to be safe
1.300     albertel 13059:     my $udom  = $env{'user.domain'};
                   13060:     my $uname = $env{'user.name'};
1.496     albertel 13061:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13062:     my %SaveHash;
                   13063:     my %AppHash;
                   13064:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 13065:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 13066:         my $envname = 'environment.'.$basename;
1.258     albertel 13067:         if (exists($env{'form.'.$setting})) {
1.153     matthew  13068:             # Save this value away
                   13069:             if ($type eq 'scalar' &&
1.258     albertel 13070:                 (! exists($env{$envname}) || 
                   13071:                  $env{$envname} ne $env{'form.'.$setting})) {
                   13072:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   13073:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  13074:             } elsif ($type eq 'array') {
                   13075:                 my $stored_form;
1.258     albertel 13076:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  13077:                     $stored_form = join(',',
                   13078:                                         map {
1.369     www      13079:                                             &escape($_);
1.258     albertel 13080:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  13081:                 } else {
                   13082:                     $stored_form = 
1.369     www      13083:                         &escape($env{'form.'.$setting});
1.153     matthew  13084:                 }
                   13085:                 # Determine if the array contents are the same.
1.258     albertel 13086:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  13087:                     $SaveHash{$basename} = $stored_form;
                   13088:                     $AppHash{$envname}   = $stored_form;
                   13089:                 }
                   13090:             }
                   13091:         }
                   13092:     }
                   13093:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 13094:                                           $udom,$uname);
1.153     matthew  13095:     if ($put_result !~ /^(ok|delayed)/) {
                   13096:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   13097:                                  'got error:'.$put_result);
                   13098:     }
                   13099:     # Make sure these settings stick around in this session, too
1.646     raeburn  13100:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  13101:     return;
                   13102: }
                   13103: 
                   13104: sub restore_course_settings {
1.499     albertel 13105:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 13106: }
                   13107: 
                   13108: sub restore_settings {
                   13109:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13110:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 13111:         next if (exists($env{'form.'.$setting}));
1.496     albertel 13112:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  13113:             '.'.$setting;
1.258     albertel 13114:         if (exists($env{$envname})) {
1.153     matthew  13115:             if ($type eq 'scalar') {
1.258     albertel 13116:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  13117:             } elsif ($type eq 'array') {
1.258     albertel 13118:                 $env{'form.'.$setting} = [ 
1.153     matthew  13119:                                            map { 
1.369     www      13120:                                                &unescape($_); 
1.258     albertel 13121:                                            } split(',',$env{$envname})
1.153     matthew  13122:                                            ];
                   13123:             }
                   13124:         }
                   13125:     }
1.127     matthew  13126: }
                   13127: 
1.618     raeburn  13128: #######################################################
                   13129: #######################################################
                   13130: 
                   13131: =pod
                   13132: 
                   13133: =head1 Domain E-mail Routines  
                   13134: 
                   13135: =over 4
                   13136: 
1.648     raeburn  13137: =item * &build_recipient_list()
1.618     raeburn  13138: 
1.1075.2.44  raeburn  13139: Build recipient lists for following types of e-mail:
1.766     raeburn  13140: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44  raeburn  13141: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   13142: module change checking, student/employee ID conflict checks, as
                   13143: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   13144: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  13145: 
                   13146: Inputs:
1.1075.2.44  raeburn  13147: defmail (scalar - email address of default recipient),
                   13148: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   13149: requestsmail, updatesmail, or idconflictsmail).
                   13150: 
1.619     raeburn  13151: defdom (domain for which to retrieve configuration settings),
1.1075.2.44  raeburn  13152: 
                   13153: origmail (scalar - email address of recipient from loncapa.conf,
                   13154: i.e., predates configuration by DC via domainprefs.pm
1.618     raeburn  13155: 
1.655     raeburn  13156: Returns: comma separated list of addresses to which to send e-mail.
                   13157: 
                   13158: =back
1.618     raeburn  13159: 
                   13160: =cut
                   13161: 
                   13162: ############################################################
                   13163: ############################################################
                   13164: sub build_recipient_list {
1.619     raeburn  13165:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  13166:     my @recipients;
                   13167:     my $otheremails;
                   13168:     my %domconfig =
                   13169:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   13170:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  13171:         if (exists($domconfig{'contacts'}{$mailing})) {
                   13172:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   13173:                 my @contacts = ('adminemail','supportemail');
                   13174:                 foreach my $item (@contacts) {
                   13175:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   13176:                         my $addr = $domconfig{'contacts'}{$item}; 
                   13177:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13178:                             push(@recipients,$addr);
                   13179:                         }
1.619     raeburn  13180:                     }
1.766     raeburn  13181:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  13182:                 }
                   13183:             }
1.766     raeburn  13184:         } elsif ($origmail ne '') {
                   13185:             push(@recipients,$origmail);
1.618     raeburn  13186:         }
1.619     raeburn  13187:     } elsif ($origmail ne '') {
                   13188:         push(@recipients,$origmail);
1.618     raeburn  13189:     }
1.688     raeburn  13190:     if (defined($defmail)) {
                   13191:         if ($defmail ne '') {
                   13192:             push(@recipients,$defmail);
                   13193:         }
1.618     raeburn  13194:     }
                   13195:     if ($otheremails) {
1.619     raeburn  13196:         my @others;
                   13197:         if ($otheremails =~ /,/) {
                   13198:             @others = split(/,/,$otheremails);
1.618     raeburn  13199:         } else {
1.619     raeburn  13200:             push(@others,$otheremails);
                   13201:         }
                   13202:         foreach my $addr (@others) {
                   13203:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13204:                 push(@recipients,$addr);
                   13205:             }
1.618     raeburn  13206:         }
                   13207:     }
1.619     raeburn  13208:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  13209:     return $recipientlist;
                   13210: }
                   13211: 
1.127     matthew  13212: ############################################################
                   13213: ############################################################
1.154     albertel 13214: 
1.655     raeburn  13215: =pod
                   13216: 
                   13217: =head1 Course Catalog Routines
                   13218: 
                   13219: =over 4
                   13220: 
                   13221: =item * &gather_categories()
                   13222: 
                   13223: Converts category definitions - keys of categories hash stored in  
                   13224: coursecategories in configuration.db on the primary library server in a 
                   13225: domain - to an array.  Also generates javascript and idx hash used to 
                   13226: generate Domain Coordinator interface for editing Course Categories.
                   13227: 
                   13228: Inputs:
1.663     raeburn  13229: 
1.655     raeburn  13230: categories (reference to hash of category definitions).
1.663     raeburn  13231: 
1.655     raeburn  13232: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13233:       categories and subcategories).
1.663     raeburn  13234: 
1.655     raeburn  13235: idx (reference to hash of counters used in Domain Coordinator interface for 
                   13236:       editing Course Categories).
1.663     raeburn  13237: 
1.655     raeburn  13238: jsarray (reference to array of categories used to create Javascript arrays for
                   13239:          Domain Coordinator interface for editing Course Categories).
                   13240: 
                   13241: Returns: nothing
                   13242: 
                   13243: Side effects: populates cats, idx and jsarray. 
                   13244: 
                   13245: =cut
                   13246: 
                   13247: sub gather_categories {
                   13248:     my ($categories,$cats,$idx,$jsarray) = @_;
                   13249:     my %counters;
                   13250:     my $num = 0;
                   13251:     foreach my $item (keys(%{$categories})) {
                   13252:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   13253:         if ($container eq '' && $depth == 0) {
                   13254:             $cats->[$depth][$categories->{$item}] = $cat;
                   13255:         } else {
                   13256:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   13257:         }
                   13258:         my ($escitem,$tail) = split(/:/,$item,2);
                   13259:         if ($counters{$tail} eq '') {
                   13260:             $counters{$tail} = $num;
                   13261:             $num ++;
                   13262:         }
                   13263:         if (ref($idx) eq 'HASH') {
                   13264:             $idx->{$item} = $counters{$tail};
                   13265:         }
                   13266:         if (ref($jsarray) eq 'ARRAY') {
                   13267:             push(@{$jsarray->[$counters{$tail}]},$item);
                   13268:         }
                   13269:     }
                   13270:     return;
                   13271: }
                   13272: 
                   13273: =pod
                   13274: 
                   13275: =item * &extract_categories()
                   13276: 
                   13277: Used to generate breadcrumb trails for course categories.
                   13278: 
                   13279: Inputs:
1.663     raeburn  13280: 
1.655     raeburn  13281: categories (reference to hash of category definitions).
1.663     raeburn  13282: 
1.655     raeburn  13283: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13284:       categories and subcategories).
1.663     raeburn  13285: 
1.655     raeburn  13286: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  13287: 
1.655     raeburn  13288: allitems (reference to hash - key is category key 
                   13289:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13290: 
1.655     raeburn  13291: idx (reference to hash of counters used in Domain Coordinator interface for
                   13292:       editing Course Categories).
1.663     raeburn  13293: 
1.655     raeburn  13294: jsarray (reference to array of categories used to create Javascript arrays for
                   13295:          Domain Coordinator interface for editing Course Categories).
                   13296: 
1.665     raeburn  13297: subcats (reference to hash of arrays containing all subcategories within each 
                   13298:          category, -recursive)
                   13299: 
1.655     raeburn  13300: Returns: nothing
                   13301: 
                   13302: Side effects: populates trails and allitems hash references.
                   13303: 
                   13304: =cut
                   13305: 
                   13306: sub extract_categories {
1.665     raeburn  13307:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  13308:     if (ref($categories) eq 'HASH') {
                   13309:         &gather_categories($categories,$cats,$idx,$jsarray);
                   13310:         if (ref($cats->[0]) eq 'ARRAY') {
                   13311:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   13312:                 my $name = $cats->[0][$i];
                   13313:                 my $item = &escape($name).'::0';
                   13314:                 my $trailstr;
                   13315:                 if ($name eq 'instcode') {
                   13316:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  13317:                 } elsif ($name eq 'communities') {
                   13318:                     $trailstr = &mt('Communities');
1.655     raeburn  13319:                 } else {
                   13320:                     $trailstr = $name;
                   13321:                 }
                   13322:                 if ($allitems->{$item} eq '') {
                   13323:                     push(@{$trails},$trailstr);
                   13324:                     $allitems->{$item} = scalar(@{$trails})-1;
                   13325:                 }
                   13326:                 my @parents = ($name);
                   13327:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   13328:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   13329:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  13330:                         if (ref($subcats) eq 'HASH') {
                   13331:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   13332:                         }
                   13333:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   13334:                     }
                   13335:                 } else {
                   13336:                     if (ref($subcats) eq 'HASH') {
                   13337:                         $subcats->{$item} = [];
1.655     raeburn  13338:                     }
                   13339:                 }
                   13340:             }
                   13341:         }
                   13342:     }
                   13343:     return;
                   13344: }
                   13345: 
                   13346: =pod
                   13347: 
                   13348: =item *&recurse_categories()
                   13349: 
                   13350: Recursively used to generate breadcrumb trails for course categories.
                   13351: 
                   13352: Inputs:
1.663     raeburn  13353: 
1.655     raeburn  13354: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13355:       categories and subcategories).
1.663     raeburn  13356: 
1.655     raeburn  13357: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  13358: 
                   13359: category (current course category, for which breadcrumb trail is being generated).
                   13360: 
                   13361: trails (reference to array of breadcrumb trails for each category).
                   13362: 
1.655     raeburn  13363: allitems (reference to hash - key is category key
                   13364:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13365: 
1.655     raeburn  13366: parents (array containing containers directories for current category, 
                   13367:          back to top level). 
                   13368: 
                   13369: Returns: nothing
                   13370: 
                   13371: Side effects: populates trails and allitems hash references
                   13372: 
                   13373: =cut
                   13374: 
                   13375: sub recurse_categories {
1.665     raeburn  13376:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  13377:     my $shallower = $depth - 1;
                   13378:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   13379:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   13380:             my $name = $cats->[$depth]{$category}[$k];
                   13381:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13382:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13383:             if ($allitems->{$item} eq '') {
                   13384:                 push(@{$trails},$trailstr);
                   13385:                 $allitems->{$item} = scalar(@{$trails})-1;
                   13386:             }
                   13387:             my $deeper = $depth+1;
                   13388:             push(@{$parents},$category);
1.665     raeburn  13389:             if (ref($subcats) eq 'HASH') {
                   13390:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   13391:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   13392:                     my $higher;
                   13393:                     if ($j > 0) {
                   13394:                         $higher = &escape($parents->[$j]).':'.
                   13395:                                   &escape($parents->[$j-1]).':'.$j;
                   13396:                     } else {
                   13397:                         $higher = &escape($parents->[$j]).'::'.$j;
                   13398:                     }
                   13399:                     push(@{$subcats->{$higher}},$subcat);
                   13400:                 }
                   13401:             }
                   13402:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   13403:                                 $subcats);
1.655     raeburn  13404:             pop(@{$parents});
                   13405:         }
                   13406:     } else {
                   13407:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13408:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13409:         if ($allitems->{$item} eq '') {
                   13410:             push(@{$trails},$trailstr);
                   13411:             $allitems->{$item} = scalar(@{$trails})-1;
                   13412:         }
                   13413:     }
                   13414:     return;
                   13415: }
                   13416: 
1.663     raeburn  13417: =pod
                   13418: 
                   13419: =item *&assign_categories_table()
                   13420: 
                   13421: Create a datatable for display of hierarchical categories in a domain,
                   13422: with checkboxes to allow a course to be categorized. 
                   13423: 
                   13424: Inputs:
                   13425: 
                   13426: cathash - reference to hash of categories defined for the domain (from
                   13427:           configuration.db)
                   13428: 
                   13429: currcat - scalar with an & separated list of categories assigned to a course. 
                   13430: 
1.919     raeburn  13431: type    - scalar contains course type (Course or Community).
                   13432: 
1.663     raeburn  13433: Returns: $output (markup to be displayed) 
                   13434: 
                   13435: =cut
                   13436: 
                   13437: sub assign_categories_table {
1.919     raeburn  13438:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  13439:     my $output;
                   13440:     if (ref($cathash) eq 'HASH') {
                   13441:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   13442:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   13443:         $maxdepth = scalar(@cats);
                   13444:         if (@cats > 0) {
                   13445:             my $itemcount = 0;
                   13446:             if (ref($cats[0]) eq 'ARRAY') {
                   13447:                 my @currcategories;
                   13448:                 if ($currcat ne '') {
                   13449:                     @currcategories = split('&',$currcat);
                   13450:                 }
1.919     raeburn  13451:                 my $table;
1.663     raeburn  13452:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   13453:                     my $parent = $cats[0][$i];
1.919     raeburn  13454:                     next if ($parent eq 'instcode');
                   13455:                     if ($type eq 'Community') {
                   13456:                         next unless ($parent eq 'communities');
                   13457:                     } else {
                   13458:                         next if ($parent eq 'communities');
                   13459:                     }
1.663     raeburn  13460:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13461:                     my $item = &escape($parent).'::0';
                   13462:                     my $checked = '';
                   13463:                     if (@currcategories > 0) {
                   13464:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   13465:                             $checked = ' checked="checked"';
1.663     raeburn  13466:                         }
                   13467:                     }
1.919     raeburn  13468:                     my $parent_title = $parent;
                   13469:                     if ($parent eq 'communities') {
                   13470:                         $parent_title = &mt('Communities');
                   13471:                     }
                   13472:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   13473:                               '<input type="checkbox" name="usecategory" value="'.
                   13474:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   13475:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  13476:                     my $depth = 1;
                   13477:                     push(@path,$parent);
1.919     raeburn  13478:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  13479:                     pop(@path);
1.919     raeburn  13480:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  13481:                     $itemcount ++;
                   13482:                 }
1.919     raeburn  13483:                 if ($itemcount) {
                   13484:                     $output = &Apache::loncommon::start_data_table().
                   13485:                               $table.
                   13486:                               &Apache::loncommon::end_data_table();
                   13487:                 }
1.663     raeburn  13488:             }
                   13489:         }
                   13490:     }
                   13491:     return $output;
                   13492: }
                   13493: 
                   13494: =pod
                   13495: 
                   13496: =item *&assign_category_rows()
                   13497: 
                   13498: Create a datatable row for display of nested categories in a domain,
                   13499: with checkboxes to allow a course to be categorized,called recursively.
                   13500: 
                   13501: Inputs:
                   13502: 
                   13503: itemcount - track row number for alternating colors
                   13504: 
                   13505: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   13506:       categories and subcategories.
                   13507: 
                   13508: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   13509: 
                   13510: parent - parent of current category item
                   13511: 
                   13512: path - Array containing all categories back up through the hierarchy from the
                   13513:        current category to the top level.
                   13514: 
                   13515: currcategories - reference to array of current categories assigned to the course
                   13516: 
                   13517: Returns: $output (markup to be displayed).
                   13518: 
                   13519: =cut
                   13520: 
                   13521: sub assign_category_rows {
                   13522:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   13523:     my ($text,$name,$item,$chgstr);
                   13524:     if (ref($cats) eq 'ARRAY') {
                   13525:         my $maxdepth = scalar(@{$cats});
                   13526:         if (ref($cats->[$depth]) eq 'HASH') {
                   13527:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   13528:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   13529:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45  raeburn  13530:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  13531:                 for (my $j=0; $j<$numchildren; $j++) {
                   13532:                     $name = $cats->[$depth]{$parent}[$j];
                   13533:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   13534:                     my $deeper = $depth+1;
                   13535:                     my $checked = '';
                   13536:                     if (ref($currcategories) eq 'ARRAY') {
                   13537:                         if (@{$currcategories} > 0) {
                   13538:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   13539:                                 $checked = ' checked="checked"';
1.663     raeburn  13540:                             }
                   13541:                         }
                   13542:                     }
1.664     raeburn  13543:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   13544:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  13545:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   13546:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   13547:                              '</td><td>';
1.663     raeburn  13548:                     if (ref($path) eq 'ARRAY') {
                   13549:                         push(@{$path},$name);
                   13550:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   13551:                         pop(@{$path});
                   13552:                     }
                   13553:                     $text .= '</td></tr>';
                   13554:                 }
                   13555:                 $text .= '</table></td>';
                   13556:             }
                   13557:         }
                   13558:     }
                   13559:     return $text;
                   13560: }
                   13561: 
1.655     raeburn  13562: ############################################################
                   13563: ############################################################
                   13564: 
                   13565: 
1.443     albertel 13566: sub commit_customrole {
1.664     raeburn  13567:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  13568:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 13569:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   13570:                          ($end?', ending '.localtime($end):'').': <b>'.
                   13571:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  13572:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 13573:                  '</b><br />';
                   13574:     return $output;
                   13575: }
                   13576: 
                   13577: sub commit_standardrole {
1.1075.2.31  raeburn  13578:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  13579:     my ($output,$logmsg,$linefeed);
                   13580:     if ($context eq 'auto') {
                   13581:         $linefeed = "\n";
                   13582:     } else {
                   13583:         $linefeed = "<br />\n";
                   13584:     }  
1.443     albertel 13585:     if ($three eq 'st') {
1.541     raeburn  13586:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31  raeburn  13587:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  13588:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  13589:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   13590:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 13591:         } else {
1.541     raeburn  13592:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 13593:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13594:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   13595:             if ($context eq 'auto') {
                   13596:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   13597:             } else {
                   13598:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   13599:                &mt('Add to classlist').': <b>ok</b>';
                   13600:             }
                   13601:             $output .= $linefeed;
1.443     albertel 13602:         }
                   13603:     } else {
                   13604:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   13605:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13606:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  13607:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  13608:         if ($context eq 'auto') {
                   13609:             $output .= $result.$linefeed;
                   13610:         } else {
                   13611:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   13612:         }
1.443     albertel 13613:     }
                   13614:     return $output;
                   13615: }
                   13616: 
                   13617: sub commit_studentrole {
1.1075.2.31  raeburn  13618:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   13619:         $credits) = @_;
1.626     raeburn  13620:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  13621:     if ($context eq 'auto') {
                   13622:         $linefeed = "\n";
                   13623:     } else {
                   13624:         $linefeed = '<br />'."\n";
                   13625:     }
1.443     albertel 13626:     if (defined($one) && defined($two)) {
                   13627:         my $cid=$one.'_'.$two;
                   13628:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   13629:         my $secchange = 0;
                   13630:         my $expire_role_result;
                   13631:         my $modify_section_result;
1.628     raeburn  13632:         if ($oldsec ne '-1') { 
                   13633:             if ($oldsec ne $sec) {
1.443     albertel 13634:                 $secchange = 1;
1.628     raeburn  13635:                 my $now = time;
1.443     albertel 13636:                 my $uurl='/'.$cid;
                   13637:                 $uurl=~s/\_/\//g;
                   13638:                 if ($oldsec) {
                   13639:                     $uurl.='/'.$oldsec;
                   13640:                 }
1.626     raeburn  13641:                 $oldsecurl = $uurl;
1.628     raeburn  13642:                 $expire_role_result = 
1.652     raeburn  13643:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  13644:                 if ($env{'request.course.sec'} ne '') { 
                   13645:                     if ($expire_role_result eq 'refused') {
                   13646:                         my @roles = ('st');
                   13647:                         my @statuses = ('previous');
                   13648:                         my @roledoms = ($one);
                   13649:                         my $withsec = 1;
                   13650:                         my %roleshash = 
                   13651:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   13652:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   13653:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   13654:                             my ($oldstart,$oldend) = 
                   13655:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   13656:                             if ($oldend > 0 && $oldend <= $now) {
                   13657:                                 $expire_role_result = 'ok';
                   13658:                             }
                   13659:                         }
                   13660:                     }
                   13661:                 }
1.443     albertel 13662:                 $result = $expire_role_result;
                   13663:             }
                   13664:         }
                   13665:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31  raeburn  13666:             $modify_section_result = 
                   13667:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   13668:                                                            undef,undef,undef,$sec,
                   13669:                                                            $end,$start,'','',$cid,
                   13670:                                                            '',$context,$credits);
1.443     albertel 13671:             if ($modify_section_result =~ /^ok/) {
                   13672:                 if ($secchange == 1) {
1.628     raeburn  13673:                     if ($sec eq '') {
                   13674:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   13675:                     } else {
                   13676:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   13677:                     }
1.443     albertel 13678:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  13679:                     if ($sec eq '') {
                   13680:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   13681:                     } else {
                   13682:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13683:                     }
1.443     albertel 13684:                 } else {
1.628     raeburn  13685:                     if ($sec eq '') {
                   13686:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   13687:                     } else {
                   13688:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13689:                     }
1.443     albertel 13690:                 }
                   13691:             } else {
1.628     raeburn  13692:                 if ($secchange) {       
                   13693:                     $$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;
                   13694:                 } else {
                   13695:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   13696:                 }
1.443     albertel 13697:             }
                   13698:             $result = $modify_section_result;
                   13699:         } elsif ($secchange == 1) {
1.628     raeburn  13700:             if ($oldsec eq '') {
1.1075.2.20  raeburn  13701:                 $$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  13702:             } else {
                   13703:                 $$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;
                   13704:             }
1.626     raeburn  13705:             if ($expire_role_result eq 'refused') {
                   13706:                 my $newsecurl = '/'.$cid;
                   13707:                 $newsecurl =~ s/\_/\//g;
                   13708:                 if ($sec ne '') {
                   13709:                     $newsecurl.='/'.$sec;
                   13710:                 }
                   13711:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   13712:                     if ($sec eq '') {
                   13713:                         $$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;
                   13714:                     } else {
                   13715:                         $$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;
                   13716:                     }
                   13717:                 }
                   13718:             }
1.443     albertel 13719:         }
                   13720:     } else {
1.626     raeburn  13721:         $$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 13722:         $result = "error: incomplete course id\n";
                   13723:     }
                   13724:     return $result;
                   13725: }
                   13726: 
1.1075.2.25  raeburn  13727: sub show_role_extent {
                   13728:     my ($scope,$context,$role) = @_;
                   13729:     $scope =~ s{^/}{};
                   13730:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   13731:     push(@courseroles,'co');
                   13732:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   13733:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   13734:         $scope =~ s{/}{_};
                   13735:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   13736:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   13737:         my ($audom,$auname) = split(/\//,$scope);
                   13738:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   13739:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   13740:     } else {
                   13741:         $scope =~ s{/$}{};
                   13742:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   13743:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   13744:     }
                   13745: }
                   13746: 
1.443     albertel 13747: ############################################################
                   13748: ############################################################
                   13749: 
1.566     albertel 13750: sub check_clone {
1.578     raeburn  13751:     my ($args,$linefeed) = @_;
1.566     albertel 13752:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   13753:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   13754:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   13755:     my $clonemsg;
                   13756:     my $can_clone = 0;
1.944     raeburn  13757:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  13758:     if ($lctype ne 'community') {
                   13759:         $lctype = 'course';
                   13760:     }
1.566     albertel 13761:     if ($clonehome eq 'no_host') {
1.944     raeburn  13762:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13763:             $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'});
                   13764:         } else {
                   13765:             $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'});
                   13766:         }     
1.566     albertel 13767:     } else {
                   13768: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  13769:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13770:             if ($clonedesc{'type'} ne 'Community') {
                   13771:                  $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'});
                   13772:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13773:             }
                   13774:         }
1.882     raeburn  13775: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   13776:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 13777: 	    $can_clone = 1;
                   13778: 	} else {
                   13779: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   13780: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   13781: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  13782:             if (grep(/^\*$/,@cloners)) {
                   13783:                 $can_clone = 1;
                   13784:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   13785:                 $can_clone = 1;
                   13786:             } else {
1.908     raeburn  13787:                 my $ccrole = 'cc';
1.944     raeburn  13788:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13789:                     $ccrole = 'co';
                   13790:                 }
1.578     raeburn  13791: 	        my %roleshash =
                   13792: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   13793: 					 $args->{'ccdomain'},
1.908     raeburn  13794:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  13795: 					 [$args->{'clonedomain'}]);
1.908     raeburn  13796: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  13797:                     $can_clone = 1;
                   13798:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   13799:                     $can_clone = 1;
                   13800:                 } else {
1.944     raeburn  13801:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13802:                         $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'});
                   13803:                     } else {
                   13804:                         $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'});
                   13805:                     }
1.578     raeburn  13806: 	        }
1.566     albertel 13807: 	    }
1.578     raeburn  13808:         }
1.566     albertel 13809:     }
                   13810:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13811: }
                   13812: 
1.444     albertel 13813: sub construct_course {
1.885     raeburn  13814:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444     albertel 13815:     my $outcome;
1.541     raeburn  13816:     my $linefeed =  '<br />'."\n";
                   13817:     if ($context eq 'auto') {
                   13818:         $linefeed = "\n";
                   13819:     }
1.566     albertel 13820: 
                   13821: #
                   13822: # Are we cloning?
                   13823: #
                   13824:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13825:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  13826: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 13827: 	if ($context ne 'auto') {
1.578     raeburn  13828:             if ($clonemsg ne '') {
                   13829: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   13830:             }
1.566     albertel 13831: 	}
                   13832: 	$outcome .= $clonemsg.$linefeed;
                   13833: 
                   13834:         if (!$can_clone) {
                   13835: 	    return (0,$outcome);
                   13836: 	}
                   13837:     }
                   13838: 
1.444     albertel 13839: #
                   13840: # Open course
                   13841: #
                   13842:     my $crstype = lc($args->{'crstype'});
                   13843:     my %cenv=();
                   13844:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   13845:                                              $args->{'cdescr'},
                   13846:                                              $args->{'curl'},
                   13847:                                              $args->{'course_home'},
                   13848:                                              $args->{'nonstandard'},
                   13849:                                              $args->{'crscode'},
                   13850:                                              $args->{'ccuname'}.':'.
                   13851:                                              $args->{'ccdomain'},
1.882     raeburn  13852:                                              $args->{'crstype'},
1.885     raeburn  13853:                                              $cnum,$context,$category);
1.444     albertel 13854: 
                   13855:     # Note: The testing routines depend on this being output; see 
                   13856:     # Utils::Course. This needs to at least be output as a comment
                   13857:     # if anyone ever decides to not show this, and Utils::Course::new
                   13858:     # will need to be suitably modified.
1.541     raeburn  13859:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  13860:     if ($$courseid =~ /^error:/) {
                   13861:         return (0,$outcome);
                   13862:     }
                   13863: 
1.444     albertel 13864: #
                   13865: # Check if created correctly
                   13866: #
1.479     albertel 13867:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 13868:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  13869:     if ($crsuhome eq 'no_host') {
                   13870:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   13871:         return (0,$outcome);
                   13872:     }
1.541     raeburn  13873:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 13874: 
1.444     albertel 13875: #
1.566     albertel 13876: # Do the cloning
                   13877: #   
                   13878:     if ($can_clone && $cloneid) {
                   13879: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   13880: 	if ($context ne 'auto') {
                   13881: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   13882: 	}
                   13883: 	$outcome .= $clonemsg.$linefeed;
                   13884: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 13885: # Copy all files
1.637     www      13886: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 13887: # Restore URL
1.566     albertel 13888: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 13889: # Restore title
1.566     albertel 13890: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  13891: # Restore creation date, creator and creation context.
                   13892:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   13893:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   13894:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 13895: # Mark as cloned
1.566     albertel 13896: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      13897: # Need to clone grading mode
                   13898:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   13899:         $cenv{'grading'}=$newenv{'grading'};
                   13900: # Do not clone these environment entries
                   13901:         &Apache::lonnet::del('environment',
                   13902:                   ['default_enrollment_start_date',
                   13903:                    'default_enrollment_end_date',
                   13904:                    'question.email',
                   13905:                    'policy.email',
                   13906:                    'comment.email',
                   13907:                    'pch.users.denied',
1.725     raeburn  13908:                    'plc.users.denied',
                   13909:                    'hidefromcat',
1.1075.2.36  raeburn  13910:                    'checkforpriv',
1.725     raeburn  13911:                    'categories'],
1.638     www      13912:                    $$crsudom,$$crsunum);
1.444     albertel 13913:     }
1.566     albertel 13914: 
1.444     albertel 13915: #
                   13916: # Set environment (will override cloned, if existing)
                   13917: #
                   13918:     my @sections = ();
                   13919:     my @xlists = ();
                   13920:     if ($args->{'crstype'}) {
                   13921:         $cenv{'type'}=$args->{'crstype'};
                   13922:     }
                   13923:     if ($args->{'crsid'}) {
                   13924:         $cenv{'courseid'}=$args->{'crsid'};
                   13925:     }
                   13926:     if ($args->{'crscode'}) {
                   13927:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   13928:     }
                   13929:     if ($args->{'crsquota'} ne '') {
                   13930:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   13931:     } else {
                   13932:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   13933:     }
                   13934:     if ($args->{'ccuname'}) {
                   13935:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   13936:                                         ':'.$args->{'ccdomain'};
                   13937:     } else {
                   13938:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   13939:     }
1.1075.2.31  raeburn  13940:     if ($args->{'defaultcredits'}) {
                   13941:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   13942:     }
1.444     albertel 13943:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   13944:     if ($args->{'crssections'}) {
                   13945:         $cenv{'internal.sectionnums'} = '';
                   13946:         if ($args->{'crssections'} =~ m/,/) {
                   13947:             @sections = split/,/,$args->{'crssections'};
                   13948:         } else {
                   13949:             $sections[0] = $args->{'crssections'};
                   13950:         }
                   13951:         if (@sections > 0) {
                   13952:             foreach my $item (@sections) {
                   13953:                 my ($sec,$gp) = split/:/,$item;
                   13954:                 my $class = $args->{'crscode'}.$sec;
                   13955:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   13956:                 $cenv{'internal.sectionnums'} .= $item.',';
                   13957:                 unless ($addcheck eq 'ok') {
                   13958:                     push @badclasses, $class;
                   13959:                 }
                   13960:             }
                   13961:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   13962:         }
                   13963:     }
                   13964: # do not hide course coordinator from staff listing, 
                   13965: # even if privileged
                   13966:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36  raeburn  13967: # add course coordinator's domain to domains to check for privileged users
                   13968: # if different to course domain
                   13969:     if ($$crsudom ne $args->{'ccdomain'}) {
                   13970:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   13971:     }
1.444     albertel 13972: # add crosslistings
                   13973:     if ($args->{'crsxlist'}) {
                   13974:         $cenv{'internal.crosslistings'}='';
                   13975:         if ($args->{'crsxlist'} =~ m/,/) {
                   13976:             @xlists = split/,/,$args->{'crsxlist'};
                   13977:         } else {
                   13978:             $xlists[0] = $args->{'crsxlist'};
                   13979:         }
                   13980:         if (@xlists > 0) {
                   13981:             foreach my $item (@xlists) {
                   13982:                 my ($xl,$gp) = split/:/,$item;
                   13983:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   13984:                 $cenv{'internal.crosslistings'} .= $item.',';
                   13985:                 unless ($addcheck eq 'ok') {
                   13986:                     push @badclasses, $xl;
                   13987:                 }
                   13988:             }
                   13989:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   13990:         }
                   13991:     }
                   13992:     if ($args->{'autoadds'}) {
                   13993:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   13994:     }
                   13995:     if ($args->{'autodrops'}) {
                   13996:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   13997:     }
                   13998: # check for notification of enrollment changes
                   13999:     my @notified = ();
                   14000:     if ($args->{'notify_owner'}) {
                   14001:         if ($args->{'ccuname'} ne '') {
                   14002:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   14003:         }
                   14004:     }
                   14005:     if ($args->{'notify_dc'}) {
                   14006:         if ($uname ne '') { 
1.630     raeburn  14007:             push(@notified,$uname.':'.$udom);
1.444     albertel 14008:         }
                   14009:     }
                   14010:     if (@notified > 0) {
                   14011:         my $notifylist;
                   14012:         if (@notified > 1) {
                   14013:             $notifylist = join(',',@notified);
                   14014:         } else {
                   14015:             $notifylist = $notified[0];
                   14016:         }
                   14017:         $cenv{'internal.notifylist'} = $notifylist;
                   14018:     }
                   14019:     if (@badclasses > 0) {
                   14020:         my %lt=&Apache::lonlocal::texthash(
                   14021:                 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.  However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course',
                   14022:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   14023:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   14024:         );
1.541     raeburn  14025:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   14026:                            ' ('.$lt{'adby'}.')';
                   14027:         if ($context eq 'auto') {
                   14028:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 14029:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  14030:             foreach my $item (@badclasses) {
                   14031:                 if ($context eq 'auto') {
                   14032:                     $outcome .= " - $item\n";
                   14033:                 } else {
                   14034:                     $outcome .= "<li>$item</li>\n";
                   14035:                 }
                   14036:             }
                   14037:             if ($context eq 'auto') {
                   14038:                 $outcome .= $linefeed;
                   14039:             } else {
1.566     albertel 14040:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  14041:             }
                   14042:         } 
1.444     albertel 14043:     }
                   14044:     if ($args->{'no_end_date'}) {
                   14045:         $args->{'endaccess'} = 0;
                   14046:     }
                   14047:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   14048:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   14049:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   14050:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   14051:     if ($args->{'showphotos'}) {
                   14052:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   14053:     }
                   14054:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   14055:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   14056:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   14057:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  14058:             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'); 
                   14059:             if ($context eq 'auto') {
                   14060:                 $outcome .= $krb_msg;
                   14061:             } else {
1.566     albertel 14062:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  14063:             }
                   14064:             $outcome .= $linefeed;
1.444     albertel 14065:         }
                   14066:     }
                   14067:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   14068:        if ($args->{'setpolicy'}) {
                   14069:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14070:        }
                   14071:        if ($args->{'setcontent'}) {
                   14072:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14073:        }
                   14074:     }
                   14075:     if ($args->{'reshome'}) {
                   14076: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   14077: 	$cenv{'reshome'}=~s/\/+$/\//;
                   14078:     }
                   14079: #
                   14080: # course has keyed access
                   14081: #
                   14082:     if ($args->{'setkeys'}) {
                   14083:        $cenv{'keyaccess'}='yes';
                   14084:     }
                   14085: # if specified, key authority is not course, but user
                   14086: # only active if keyaccess is yes
                   14087:     if ($args->{'keyauth'}) {
1.487     albertel 14088: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   14089: 	$user = &LONCAPA::clean_username($user);
                   14090: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     14091: 	if ($user ne '' && $domain ne '') {
1.487     albertel 14092: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 14093: 	}
                   14094:     }
                   14095: 
                   14096:     if ($args->{'disresdis'}) {
                   14097:         $cenv{'pch.roles.denied'}='st';
                   14098:     }
                   14099:     if ($args->{'disablechat'}) {
                   14100:         $cenv{'plc.roles.denied'}='st';
                   14101:     }
                   14102: 
                   14103:     # Record we've not yet viewed the Course Initialization Helper for this 
                   14104:     # course
                   14105:     $cenv{'course.helper.not.run'} = 1;
                   14106:     #
                   14107:     # Use new Randomseed
                   14108:     #
                   14109:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   14110:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   14111:     #
                   14112:     # The encryption code and receipt prefix for this course
                   14113:     #
                   14114:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   14115:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   14116:     #
                   14117:     # By default, use standard grading
                   14118:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   14119: 
1.541     raeburn  14120:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   14121:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14122: #
                   14123: # Open all assignments
                   14124: #
                   14125:     if ($args->{'openall'}) {
                   14126:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   14127:        my %storecontent = ($storeunder         => time,
                   14128:                            $storeunder.'.type' => 'date_start');
                   14129:        
                   14130:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  14131:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14132:    }
                   14133: #
                   14134: # Set first page
                   14135: #
                   14136:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   14137: 	    || ($cloneid)) {
1.445     albertel 14138: 	use LONCAPA::map;
1.444     albertel 14139: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 14140: 
                   14141: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   14142:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   14143: 
1.444     albertel 14144:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   14145:         my $title; my $url;
                   14146:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   14147: 	    $title=&mt('Syllabus');
1.444     albertel 14148:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   14149:         } else {
1.963     raeburn  14150:             $title=&mt('Table of Contents');
1.444     albertel 14151:             $url='/adm/navmaps';
                   14152:         }
1.445     albertel 14153: 
                   14154:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   14155: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   14156: 
                   14157: 	if ($errtext) { $fatal=2; }
1.541     raeburn  14158:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 14159:     }
1.566     albertel 14160: 
                   14161:     return (1,$outcome);
1.444     albertel 14162: }
                   14163: 
                   14164: ############################################################
                   14165: ############################################################
                   14166: 
1.953     droeschl 14167: #SD
                   14168: # only Community and Course, or anything else?
1.378     raeburn  14169: sub course_type {
                   14170:     my ($cid) = @_;
                   14171:     if (!defined($cid)) {
                   14172:         $cid = $env{'request.course.id'};
                   14173:     }
1.404     albertel 14174:     if (defined($env{'course.'.$cid.'.type'})) {
                   14175:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  14176:     } else {
                   14177:         return 'Course';
1.377     raeburn  14178:     }
                   14179: }
1.156     albertel 14180: 
1.406     raeburn  14181: sub group_term {
                   14182:     my $crstype = &course_type();
                   14183:     my %names = (
                   14184:                   'Course' => 'group',
1.865     raeburn  14185:                   'Community' => 'group',
1.406     raeburn  14186:                 );
                   14187:     return $names{$crstype};
                   14188: }
                   14189: 
1.902     raeburn  14190: sub course_types {
                   14191:     my @types = ('official','unofficial','community');
                   14192:     my %typename = (
                   14193:                          official   => 'Official course',
                   14194:                          unofficial => 'Unofficial course',
                   14195:                          community  => 'Community',
                   14196:                    );
                   14197:     return (\@types,\%typename);
                   14198: }
                   14199: 
1.156     albertel 14200: sub icon {
                   14201:     my ($file)=@_;
1.505     albertel 14202:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 14203:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 14204:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 14205:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   14206: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   14207: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14208: 	            $curfext.".gif") {
                   14209: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14210: 		$curfext.".gif";
                   14211: 	}
                   14212:     }
1.249     albertel 14213:     return &lonhttpdurl($iconname);
1.154     albertel 14214: } 
1.84      albertel 14215: 
1.575     albertel 14216: sub lonhttpdurl {
1.692     www      14217: #
                   14218: # Had been used for "small fry" static images on separate port 8080.
                   14219: # Modify here if lightweight http functionality desired again.
                   14220: # Currently eliminated due to increasing firewall issues.
                   14221: #
1.575     albertel 14222:     my ($url)=@_;
1.692     www      14223:     return $url;
1.215     albertel 14224: }
                   14225: 
1.213     albertel 14226: sub connection_aborted {
                   14227:     my ($r)=@_;
                   14228:     $r->print(" ");$r->rflush();
                   14229:     my $c = $r->connection;
                   14230:     return $c->aborted();
                   14231: }
                   14232: 
1.221     foxr     14233: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     14234: #    strings as 'strings'.
                   14235: sub escape_single {
1.221     foxr     14236:     my ($input) = @_;
1.223     albertel 14237:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     14238:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   14239:     return $input;
                   14240: }
1.223     albertel 14241: 
1.222     foxr     14242: #  Same as escape_single, but escape's "'s  This 
                   14243: #  can be used for  "strings"
                   14244: sub escape_double {
                   14245:     my ($input) = @_;
                   14246:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   14247:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   14248:     return $input;
                   14249: }
1.223     albertel 14250:  
1.222     foxr     14251: #   Escapes the last element of a full URL.
                   14252: sub escape_url {
                   14253:     my ($url)   = @_;
1.238     raeburn  14254:     my @urlslices = split(/\//, $url,-1);
1.369     www      14255:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 14256:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     14257: }
1.462     albertel 14258: 
1.820     raeburn  14259: sub compare_arrays {
                   14260:     my ($arrayref1,$arrayref2) = @_;
                   14261:     my (@difference,%count);
                   14262:     @difference = ();
                   14263:     %count = ();
                   14264:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   14265:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   14266:         foreach my $element (keys(%count)) {
                   14267:             if ($count{$element} == 1) {
                   14268:                 push(@difference,$element);
                   14269:             }
                   14270:         }
                   14271:     }
                   14272:     return @difference;
                   14273: }
                   14274: 
1.817     bisitz   14275: # -------------------------------------------------------- Initialize user login
1.462     albertel 14276: sub init_user_environment {
1.463     albertel 14277:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 14278:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   14279: 
                   14280:     my $public=($username eq 'public' && $domain eq 'public');
                   14281: 
                   14282: # See if old ID present, if so, remove
                   14283: 
1.1062    raeburn  14284:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 14285:     my $now=time;
                   14286: 
                   14287:     if ($public) {
                   14288: 	my $max_public=100;
                   14289: 	my $oldest;
                   14290: 	my $oldest_time=0;
                   14291: 	for(my $next=1;$next<=$max_public;$next++) {
                   14292: 	    if (-e $lonids."/publicuser_$next.id") {
                   14293: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   14294: 		if ($mtime<$oldest_time || !$oldest_time) {
                   14295: 		    $oldest_time=$mtime;
                   14296: 		    $oldest=$next;
                   14297: 		}
                   14298: 	    } else {
                   14299: 		$cookie="publicuser_$next";
                   14300: 		last;
                   14301: 	    }
                   14302: 	}
                   14303: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   14304:     } else {
1.463     albertel 14305: 	# if this isn't a robot, kill any existing non-robot sessions
                   14306: 	if (!$args->{'robot'}) {
                   14307: 	    opendir(DIR,$lonids);
                   14308: 	    while ($filename=readdir(DIR)) {
                   14309: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   14310: 		    unlink($lonids.'/'.$filename);
                   14311: 		}
1.462     albertel 14312: 	    }
1.463     albertel 14313: 	    closedir(DIR);
1.462     albertel 14314: 	}
                   14315: # Give them a new cookie
1.463     albertel 14316: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      14317: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 14318: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 14319:     
                   14320: # Initialize roles
                   14321: 
1.1062    raeburn  14322: 	($userroles,$firstaccenv,$timerintenv) = 
                   14323:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 14324:     }
                   14325: # ------------------------------------ Check browser type and MathML capability
                   14326: 
                   14327:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.42  raeburn  14328:         $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r);
1.462     albertel 14329: 
                   14330: # ------------------------------------------------------------- Get environment
                   14331: 
                   14332:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   14333:     my ($tmp) = keys(%userenv);
                   14334:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   14335:     } else {
                   14336: 	undef(%userenv);
                   14337:     }
                   14338:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   14339: 	$form->{'interface'}=$userenv{'interface'};
                   14340:     }
                   14341:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   14342: 
                   14343: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   14344:     foreach my $option ('interface','localpath','localres') {
                   14345:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 14346:     }
                   14347: # --------------------------------------------------------- Write first profile
                   14348: 
                   14349:     {
                   14350: 	my %initial_env = 
                   14351: 	    ("user.name"          => $username,
                   14352: 	     "user.domain"        => $domain,
                   14353: 	     "user.home"          => $authhost,
                   14354: 	     "browser.type"       => $clientbrowser,
                   14355: 	     "browser.version"    => $clientversion,
                   14356: 	     "browser.mathml"     => $clientmathml,
                   14357: 	     "browser.unicode"    => $clientunicode,
                   14358: 	     "browser.os"         => $clientos,
1.1075.2.42  raeburn  14359:              "browser.mobile"     => $clientmobile,
                   14360:              "browser.info"       => $clientinfo,
1.462     albertel 14361: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   14362: 	     "request.course.fn"  => '',
                   14363: 	     "request.course.uri" => '',
                   14364: 	     "request.course.sec" => '',
                   14365: 	     "request.role"       => 'cm',
                   14366: 	     "request.role.adv"   => $env{'user.adv'},
                   14367: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   14368: 
                   14369:         if ($form->{'localpath'}) {
                   14370: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   14371: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   14372:         }
                   14373: 	
                   14374: 	if ($form->{'interface'}) {
                   14375: 	    $form->{'interface'}=~s/\W//gs;
                   14376: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   14377: 	    $env{'browser.interface'}=$form->{'interface'};
                   14378: 	}
                   14379: 
1.981     raeburn  14380:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  14381:         my %domdef;
                   14382:         unless ($domain eq 'public') {
                   14383:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   14384:         }
1.980     raeburn  14385: 
1.1075.2.7  raeburn  14386:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  14387:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  14388:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   14389:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  14390:         }
                   14391: 
1.864     raeburn  14392:         foreach my $crstype ('official','unofficial','community') {
1.765     raeburn  14393:             $userenv{'canrequest.'.$crstype} =
                   14394:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  14395:                                                   'reload','requestcourses',
                   14396:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  14397:         }
                   14398: 
1.1075.2.14  raeburn  14399:         $userenv{'canrequest.author'} =
                   14400:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   14401:                                         'reload','requestauthor',
                   14402:                                         \%userenv,\%domdef,\%is_adv);
                   14403:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   14404:                                              $domain,$username);
                   14405:         my $reqstatus = $reqauthor{'author_status'};
                   14406:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
                   14407:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   14408:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   14409:                                                   $reqauthor{'author'}{'timestamp'};
                   14410:             }
                   14411:         }
                   14412: 
1.462     albertel 14413: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  14414: 
1.462     albertel 14415: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   14416: 		 &GDBM_WRCREAT(),0640)) {
                   14417: 	    &_add_to_env(\%disk_env,\%initial_env);
                   14418: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   14419: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  14420:             if (ref($firstaccenv) eq 'HASH') {
                   14421:                 &_add_to_env(\%disk_env,$firstaccenv);
                   14422:             }
                   14423:             if (ref($timerintenv) eq 'HASH') {
                   14424:                 &_add_to_env(\%disk_env,$timerintenv);
                   14425:             }
1.463     albertel 14426: 	    if (ref($args->{'extra_env'})) {
                   14427: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   14428: 	    }
1.462     albertel 14429: 	    untie(%disk_env);
                   14430: 	} else {
1.705     tempelho 14431: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   14432: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 14433: 	    return 'error: '.$!;
                   14434: 	}
                   14435:     }
                   14436:     $env{'request.role'}='cm';
                   14437:     $env{'request.role.adv'}=$env{'user.adv'};
                   14438:     $env{'browser.type'}=$clientbrowser;
                   14439: 
                   14440:     return $cookie;
                   14441: 
                   14442: }
                   14443: 
                   14444: sub _add_to_env {
                   14445:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  14446:     if (ref($env_data) eq 'HASH') {
                   14447:         while (my ($key,$value) = each(%$env_data)) {
                   14448: 	    $idf->{$prefix.$key} = $value;
                   14449: 	    $env{$prefix.$key}   = $value;
                   14450:         }
1.462     albertel 14451:     }
                   14452: }
                   14453: 
1.685     tempelho 14454: # --- Get the symbolic name of a problem and the url
                   14455: sub get_symb {
                   14456:     my ($request,$silent) = @_;
1.726     raeburn  14457:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 14458:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   14459:     if ($symb eq '') {
                   14460:         if (!$silent) {
1.1071    raeburn  14461:             if (ref($request)) { 
                   14462:                 $request->print("Unable to handle ambiguous references:$url:.");
                   14463:             }
1.685     tempelho 14464:             return ();
                   14465:         }
                   14466:     }
                   14467:     &Apache::lonenc::check_decrypt(\$symb);
                   14468:     return ($symb);
                   14469: }
                   14470: 
                   14471: # --------------------------------------------------------------Get annotation
                   14472: 
                   14473: sub get_annotation {
                   14474:     my ($symb,$enc) = @_;
                   14475: 
                   14476:     my $key = $symb;
                   14477:     if (!$enc) {
                   14478:         $key =
                   14479:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   14480:     }
                   14481:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   14482:     return $annotation{$key};
                   14483: }
                   14484: 
                   14485: sub clean_symb {
1.731     raeburn  14486:     my ($symb,$delete_enc) = @_;
1.685     tempelho 14487: 
                   14488:     &Apache::lonenc::check_decrypt(\$symb);
                   14489:     my $enc = $env{'request.enc'};
1.731     raeburn  14490:     if ($delete_enc) {
1.730     raeburn  14491:         delete($env{'request.enc'});
                   14492:     }
1.685     tempelho 14493: 
                   14494:     return ($symb,$enc);
                   14495: }
1.462     albertel 14496: 
1.990     raeburn  14497: sub build_release_hashes {
                   14498:     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
                   14499:     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
                   14500:                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                   14501:                   (ref($randomizetry) eq 'HASH'));
                   14502:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   14503:         my ($item,$name,$value) = split(/:/,$key);
                   14504:         if ($item eq 'parameter') {
                   14505:             if (ref($checkparms->{$name}) eq 'ARRAY') {
                   14506:                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
                   14507:                     push(@{$checkparms->{$name}},$value);
                   14508:                 }
                   14509:             } else {
                   14510:                 push(@{$checkparms->{$name}},$value);
                   14511:             }
                   14512:         } elsif ($item eq 'resourcetag') {
                   14513:             if ($name eq 'responsetype') {
                   14514:                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
                   14515:             }
                   14516:         } elsif ($item eq 'course') {
                   14517:             if ($name eq 'crstype') {
                   14518:                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
                   14519:             }
                   14520:         }
                   14521:     }
                   14522:     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
                   14523:     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
                   14524:     return;
                   14525: }
                   14526: 
1.1075.2.11  raeburn  14527: sub update_content_constraints {
                   14528:     my ($cdom,$cnum,$chome,$cid) = @_;
                   14529:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   14530:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   14531:     my %checkresponsetypes;
                   14532:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   14533:         my ($item,$name,$value) = split(/:/,$key);
                   14534:         if ($item eq 'resourcetag') {
                   14535:             if ($name eq 'responsetype') {
                   14536:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   14537:             }
                   14538:         }
                   14539:     }
                   14540:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14541:     if (defined($navmap)) {
                   14542:         my %allresponses;
                   14543:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   14544:             my %responses = $res->responseTypes();
                   14545:             foreach my $key (keys(%responses)) {
                   14546:                 next unless(exists($checkresponsetypes{$key}));
                   14547:                 $allresponses{$key} += $responses{$key};
                   14548:             }
                   14549:         }
                   14550:         foreach my $key (keys(%allresponses)) {
                   14551:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   14552:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   14553:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   14554:             }
                   14555:         }
                   14556:         undef($navmap);
                   14557:     }
                   14558:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   14559:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   14560:     }
                   14561:     return;
                   14562: }
                   14563: 
1.1075.2.27  raeburn  14564: sub allmaps_incourse {
                   14565:     my ($cdom,$cnum,$chome,$cid) = @_;
                   14566:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   14567:         $cid = $env{'request.course.id'};
                   14568:         $cdom = $env{'course.'.$cid.'.domain'};
                   14569:         $cnum = $env{'course.'.$cid.'.num'};
                   14570:         $chome = $env{'course.'.$cid.'.home'};
                   14571:     }
                   14572:     my %allmaps = ();
                   14573:     my $lastchange =
                   14574:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   14575:     if ($lastchange > $env{'request.course.tied'}) {
                   14576:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   14577:         unless ($ferr) {
                   14578:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   14579:         }
                   14580:     }
                   14581:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14582:     if (defined($navmap)) {
                   14583:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   14584:             $allmaps{$res->src()} = 1;
                   14585:         }
                   14586:     }
                   14587:     return \%allmaps;
                   14588: }
                   14589: 
1.1075.2.11  raeburn  14590: sub parse_supplemental_title {
                   14591:     my ($title) = @_;
                   14592: 
                   14593:     my ($foldertitle,$renametitle);
                   14594:     if ($title =~ /&amp;&amp;&amp;/) {
                   14595:         $title = &HTML::Entites::decode($title);
                   14596:     }
                   14597:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   14598:         $renametitle=$4;
                   14599:         my ($time,$uname,$udom) = ($1,$2,$3);
                   14600:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   14601:         my $name =  &plainname($uname,$udom);
                   14602:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   14603:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   14604:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   14605:             $name.': <br />'.$foldertitle;
                   14606:     }
                   14607:     if (wantarray) {
                   14608:         return ($title,$foldertitle,$renametitle);
                   14609:     }
                   14610:     return $title;
                   14611: }
                   14612: 
1.1075.2.43  raeburn  14613: sub recurse_supplemental {
                   14614:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
                   14615:     if ($suppmap) {
                   14616:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   14617:         if ($fatal) {
                   14618:             $errors ++;
                   14619:         } else {
                   14620:             if ($#LONCAPA::map::resources > 0) {
                   14621:                 foreach my $res (@LONCAPA::map::resources) {
                   14622:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                   14623:                     if (($src ne '') && ($status eq 'res')) {
1.1075.2.46  raeburn  14624:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                   14625:                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43  raeburn  14626:                         } else {
                   14627:                             $numfiles ++;
                   14628:                         }
                   14629:                     }
                   14630:                 }
                   14631:             }
                   14632:         }
                   14633:     }
                   14634:     return ($numfiles,$errors);
                   14635: }
                   14636: 
1.1075.2.18  raeburn  14637: sub symb_to_docspath {
                   14638:     my ($symb) = @_;
                   14639:     return unless ($symb);
                   14640:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   14641:     if ($resurl=~/\.(sequence|page)$/) {
                   14642:         $mapurl=$resurl;
                   14643:     } elsif ($resurl eq 'adm/navmaps') {
                   14644:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   14645:     }
                   14646:     my $mapresobj;
                   14647:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14648:     if (ref($navmap)) {
                   14649:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   14650:     }
                   14651:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   14652:     my $type=$2;
                   14653:     my $path;
                   14654:     if (ref($mapresobj)) {
                   14655:         my $pcslist = $mapresobj->map_hierarchy();
                   14656:         if ($pcslist ne '') {
                   14657:             foreach my $pc (split(/,/,$pcslist)) {
                   14658:                 next if ($pc <= 1);
                   14659:                 my $res = $navmap->getByMapPc($pc);
                   14660:                 if (ref($res)) {
                   14661:                     my $thisurl = $res->src();
                   14662:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   14663:                     my $thistitle = $res->title();
                   14664:                     $path .= '&'.
                   14665:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46  raeburn  14666:                              &escape($thistitle).
1.1075.2.18  raeburn  14667:                              ':'.$res->randompick().
                   14668:                              ':'.$res->randomout().
                   14669:                              ':'.$res->encrypted().
                   14670:                              ':'.$res->randomorder().
                   14671:                              ':'.$res->is_page();
                   14672:                 }
                   14673:             }
                   14674:         }
                   14675:         $path =~ s/^\&//;
                   14676:         my $maptitle = $mapresobj->title();
                   14677:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  14678:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  14679:         }
                   14680:         $path .= (($path ne '')? '&' : '').
                   14681:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  14682:                  &escape($maptitle).
1.1075.2.18  raeburn  14683:                  ':'.$mapresobj->randompick().
                   14684:                  ':'.$mapresobj->randomout().
                   14685:                  ':'.$mapresobj->encrypted().
                   14686:                  ':'.$mapresobj->randomorder().
                   14687:                  ':'.$mapresobj->is_page();
                   14688:     } else {
                   14689:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   14690:         my $ispage = (($type eq 'page')? 1 : '');
                   14691:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  14692:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  14693:         }
                   14694:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  14695:                 &escape($maptitle).':::::'.$ispage;
1.1075.2.18  raeburn  14696:     }
                   14697:     unless ($mapurl eq 'default') {
                   14698:         $path = 'default&'.
1.1075.2.46  raeburn  14699:                 &escape('Main Content').
1.1075.2.18  raeburn  14700:                 ':::::&'.$path;
                   14701:     }
                   14702:     return $path;
                   14703: }
                   14704: 
1.1075.2.14  raeburn  14705: sub captcha_display {
                   14706:     my ($context,$lonhost) = @_;
                   14707:     my ($output,$error);
                   14708:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   14709:     if ($captcha eq 'original') {
                   14710:         $output = &create_captcha();
                   14711:         unless ($output) {
                   14712:             $error = 'captcha';
                   14713:         }
                   14714:     } elsif ($captcha eq 'recaptcha') {
                   14715:         $output = &create_recaptcha($pubkey);
                   14716:         unless ($output) {
                   14717:             $error = 'recaptcha';
                   14718:         }
                   14719:     }
                   14720:     return ($output,$error);
                   14721: }
                   14722: 
                   14723: sub captcha_response {
                   14724:     my ($context,$lonhost) = @_;
                   14725:     my ($captcha_chk,$captcha_error);
                   14726:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   14727:     if ($captcha eq 'original') {
                   14728:         ($captcha_chk,$captcha_error) = &check_captcha();
                   14729:     } elsif ($captcha eq 'recaptcha') {
                   14730:         $captcha_chk = &check_recaptcha($privkey);
                   14731:     } else {
                   14732:         $captcha_chk = 1;
                   14733:     }
                   14734:     return ($captcha_chk,$captcha_error);
                   14735: }
                   14736: 
                   14737: sub get_captcha_config {
                   14738:     my ($context,$lonhost) = @_;
                   14739:     my ($captcha,$pubkey,$privkey,$hashtocheck);
                   14740:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   14741:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   14742:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   14743:     if ($context eq 'usercreation') {
                   14744:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   14745:         if (ref($domconfig{$context}) eq 'HASH') {
                   14746:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   14747:             if (ref($hashtocheck) eq 'HASH') {
                   14748:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   14749:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   14750:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   14751:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   14752:                     }
                   14753:                     if ($privkey && $pubkey) {
                   14754:                         $captcha = 'recaptcha';
                   14755:                     } else {
                   14756:                         $captcha = 'original';
                   14757:                     }
                   14758:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   14759:                     $captcha = 'original';
                   14760:                 }
                   14761:             }
                   14762:         } else {
                   14763:             $captcha = 'captcha';
                   14764:         }
                   14765:     } elsif ($context eq 'login') {
                   14766:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   14767:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   14768:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   14769:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
                   14770:             if ($privkey && $pubkey) {
                   14771:                 $captcha = 'recaptcha';
                   14772:             } else {
                   14773:                 $captcha = 'original';
                   14774:             }
                   14775:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   14776:             $captcha = 'original';
                   14777:         }
                   14778:     }
                   14779:     return ($captcha,$pubkey,$privkey);
                   14780: }
                   14781: 
                   14782: sub create_captcha {
                   14783:     my %captcha_params = &captcha_settings();
                   14784:     my ($output,$maxtries,$tries) = ('',10,0);
                   14785:     while ($tries < $maxtries) {
                   14786:         $tries ++;
                   14787:         my $captcha = Authen::Captcha->new (
                   14788:                                            output_folder => $captcha_params{'output_dir'},
                   14789:                                            data_folder   => $captcha_params{'db_dir'},
                   14790:                                           );
                   14791:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   14792: 
                   14793:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   14794:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   14795:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
                   14796:                      '<input type="text" size="5" name="code" value="" /><br />'.
                   14797:                      '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" />';
                   14798:             last;
                   14799:         }
                   14800:     }
                   14801:     return $output;
                   14802: }
                   14803: 
                   14804: sub captcha_settings {
                   14805:     my %captcha_params = (
                   14806:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   14807:                            www_output_dir => "/captchaspool",
                   14808:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   14809:                            numchars       => '5',
                   14810:                          );
                   14811:     return %captcha_params;
                   14812: }
                   14813: 
                   14814: sub check_captcha {
                   14815:     my ($captcha_chk,$captcha_error);
                   14816:     my $code = $env{'form.code'};
                   14817:     my $md5sum = $env{'form.crypt'};
                   14818:     my %captcha_params = &captcha_settings();
                   14819:     my $captcha = Authen::Captcha->new(
                   14820:                       output_folder => $captcha_params{'output_dir'},
                   14821:                       data_folder   => $captcha_params{'db_dir'},
                   14822:                   );
1.1075.2.26  raeburn  14823:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14  raeburn  14824:     my %captcha_hash = (
                   14825:                         0       => 'Code not checked (file error)',
                   14826:                        -1      => 'Failed: code expired',
                   14827:                        -2      => 'Failed: invalid code (not in database)',
                   14828:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   14829:     );
                   14830:     if ($captcha_chk != 1) {
                   14831:         $captcha_error = $captcha_hash{$captcha_chk}
                   14832:     }
                   14833:     return ($captcha_chk,$captcha_error);
                   14834: }
                   14835: 
                   14836: sub create_recaptcha {
                   14837:     my ($pubkey) = @_;
                   14838:     my $captcha = Captcha::reCAPTCHA->new;
                   14839:     return $captcha->get_options_setter({theme => 'white'})."\n".
                   14840:            $captcha->get_html($pubkey).
                   14841:            &mt('If either word is hard to read, [_1] will replace them.',
1.1075.2.39  raeburn  14842:                '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1075.2.14  raeburn  14843:            '<br /><br />';
                   14844: }
                   14845: 
                   14846: sub check_recaptcha {
                   14847:     my ($privkey) = @_;
                   14848:     my $captcha_chk;
                   14849:     my $captcha = Captcha::reCAPTCHA->new;
                   14850:     my $captcha_result =
                   14851:         $captcha->check_answer(
                   14852:                                 $privkey,
                   14853:                                 $ENV{'REMOTE_ADDR'},
                   14854:                                 $env{'form.recaptcha_challenge_field'},
                   14855:                                 $env{'form.recaptcha_response_field'},
                   14856:                               );
                   14857:     if ($captcha_result->{is_valid}) {
                   14858:         $captcha_chk = 1;
                   14859:     }
                   14860:     return $captcha_chk;
                   14861: }
                   14862: 
1.41      ng       14863: =pod
                   14864: 
                   14865: =back
                   14866: 
1.112     bowersj2 14867: =cut
1.41      ng       14868: 
1.112     bowersj2 14869: 1;
                   14870: __END__;
1.41      ng       14871: 

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