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

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.27! raeburn     4: # $Id: loncommon.pm,v 1.1075.2.26 2013/01/03 20:10:02 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.909     raeburn   531:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype) = @_;
1.932     raeburn   532:     my $wintitle = 'Course_Browser';
1.931     raeburn   533:     if ($crstype eq 'Community') {
1.932     raeburn   534:         $wintitle = 'Community_Browser';
1.909     raeburn   535:     }
1.876     raeburn   536:     my $id_functions = &javascript_index_functions();
                    537:     my $output = '
1.776     bisitz    538: <script type="text/javascript" language="JavaScript">
1.824     bisitz    539: // <![CDATA[
1.468     raeburn   540:     var stdeditbrowser;'."\n";
1.876     raeburn   541: 
                    542:     $output .= <<"ENDSTDBRW";
1.909     raeburn   543:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       544:         var url = '/adm/pickcourse?';
1.895     raeburn   545:         var formid = getFormIdByName(formname);
1.876     raeburn   546:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  547:         if (domainfilter != null) {
                    548:            if (domainfilter != '') {
                    549:                url += 'domainfilter='+domainfilter+'&';
                    550: 	   }
                    551:         }
1.91      www       552:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  553: 	                            '&cdomelement='+udom+
                    554:                                     '&cnameelement='+desc;
1.468     raeburn   555:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   556:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   557:                 url += '&roleelement='+extra_element;
                    558:                 if (domainfilter == null || domainfilter == '') {
                    559:                     url += '&domainfilter='+extra_element;
                    560:                 }
1.234     raeburn   561:             }
1.468     raeburn   562:             else {
                    563:                 if (formname == 'portform') {
                    564:                     url += '&setroles='+extra_element;
1.800     raeburn   565:                 } else {
                    566:                     if (formname == 'rules') {
                    567:                         url += '&fixeddom='+extra_element; 
                    568:                     }
1.468     raeburn   569:                 }
                    570:             }     
1.230     raeburn   571:         }
1.909     raeburn   572:         if (type != null && type != '') {
                    573:             url += '&type='+type;
                    574:         }
                    575:         if (type_elem != null && type_elem != '') {
                    576:             url += '&typeelement='+type_elem;
                    577:         }
1.872     raeburn   578:         if (formname == 'ccrs') {
                    579:             var ownername = document.forms[formid].ccuname.value;
                    580:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
                    581:             url += '&cloner='+ownername+':'+ownerdom;
                    582:         }
1.293     raeburn   583:         if (multflag !=null && multflag != '') {
                    584:             url += '&multiple='+multflag;
                    585:         }
1.909     raeburn   586:         var title = '$wintitle';
1.91      www       587:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    588:         options += ',width=700,height=600';
                    589:         stdeditbrowser = open(url,title,options,'1');
                    590:         stdeditbrowser.focus();
                    591:     }
1.876     raeburn   592: $id_functions
                    593: ENDSTDBRW
1.905     raeburn   594:     if (($sec_element ne '') || ($role_element ne '')) {
                    595:         $output .= &setsec_javascript($sec_element,$formname,$role_element);
1.876     raeburn   596:     }
                    597:     $output .= '
                    598: // ]]>
                    599: </script>';
                    600:     return $output;
                    601: }
                    602: 
                    603: sub javascript_index_functions {
                    604:     return <<"ENDJS";
                    605: 
                    606: function getFormIdByName(formname) {
                    607:     for (var i=0;i<document.forms.length;i++) {
                    608:         if (document.forms[i].name == formname) {
                    609:             return i;
                    610:         }
                    611:     }
                    612:     return -1;
                    613: }
                    614: 
                    615: function getIndexByName(formid,item) {
                    616:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    617:         if (document.forms[formid].elements[i].name == item) {
                    618:             return i;
                    619:         }
                    620:     }
                    621:     return -1;
                    622: }
1.468     raeburn   623: 
1.876     raeburn   624: function getDomainFromSelectbox(formname,udom) {
                    625:     var userdom;
                    626:     var formid = getFormIdByName(formname);
                    627:     if (formid > -1) {
                    628:         var domid = getIndexByName(formid,udom);
                    629:         if (domid > -1) {
                    630:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    631:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    632:             }
                    633:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    634:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   635:             }
                    636:         }
                    637:     }
1.876     raeburn   638:     return userdom;
                    639: }
                    640: 
                    641: ENDJS
1.468     raeburn   642: 
1.876     raeburn   643: }
                    644: 
1.1017    raeburn   645: sub javascript_array_indexof {
1.1018    raeburn   646:     return <<ENDJS;
1.1017    raeburn   647: <script type="text/javascript" language="JavaScript">
                    648: // <![CDATA[
                    649: 
                    650: if (!Array.prototype.indexOf) {
                    651:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    652:         "use strict";
                    653:         if (this === void 0 || this === null) {
                    654:             throw new TypeError();
                    655:         }
                    656:         var t = Object(this);
                    657:         var len = t.length >>> 0;
                    658:         if (len === 0) {
                    659:             return -1;
                    660:         }
                    661:         var n = 0;
                    662:         if (arguments.length > 0) {
                    663:             n = Number(arguments[1]);
                    664:             if (n !== n) { // shortcut for verifying if it's NaN
                    665:                 n = 0;
                    666:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    667:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    668:             }
                    669:         }
                    670:         if (n >= len) {
                    671:             return -1;
                    672:         }
                    673:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    674:         for (; k < len; k++) {
                    675:             if (k in t && t[k] === searchElement) {
                    676:                 return k;
                    677:             }
                    678:         }
                    679:         return -1;
                    680:     }
                    681: }
                    682: 
                    683: // ]]>
                    684: </script>
                    685: 
                    686: ENDJS
                    687: 
                    688: }
                    689: 
1.876     raeburn   690: sub userbrowser_javascript {
                    691:     my $id_functions = &javascript_index_functions();
                    692:     return <<"ENDUSERBRW";
                    693: 
1.888     raeburn   694: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   695:     var url = '/adm/pickuser?';
                    696:     var userdom = getDomainFromSelectbox(formname,udom);
                    697:     if (userdom != null) {
                    698:        if (userdom != '') {
                    699:            url += 'srchdom='+userdom+'&';
                    700:        }
                    701:     }
                    702:     url += 'form=' + formname + '&unameelement='+uname+
                    703:                                 '&udomelement='+udom+
                    704:                                 '&ulastelement='+ulast+
                    705:                                 '&ufirstelement='+ufirst+
                    706:                                 '&uemailelement='+uemail+
1.881     raeburn   707:                                 '&hideudomelement='+hideudom+
                    708:                                 '&coursedom='+crsdom;
1.888     raeburn   709:     if ((caller != null) && (caller != undefined)) {
                    710:         url += '&caller='+caller;
                    711:     }
1.876     raeburn   712:     var title = 'User_Browser';
                    713:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    714:     options += ',width=700,height=600';
                    715:     var stdeditbrowser = open(url,title,options,'1');
                    716:     stdeditbrowser.focus();
                    717: }
                    718: 
1.888     raeburn   719: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   720:     var formid = getFormIdByName(formname);
                    721:     if (formid > -1) {
1.888     raeburn   722:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   723:         var domid = getIndexByName(formid,udom);
                    724:         var hidedomid = getIndexByName(formid,origdom);
                    725:         if (hidedomid > -1) {
                    726:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   727:             var unameval = document.forms[formid].elements[unameid].value;
                    728:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    729:                 if (domid > -1) {
                    730:                     var slct = document.forms[formid].elements[domid];
                    731:                     if (slct.type == 'select-one') {
                    732:                         var i;
                    733:                         for (i=0;i<slct.length;i++) {
                    734:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    735:                         }
                    736:                     }
                    737:                     if (slct.type == 'hidden') {
                    738:                         slct.value = fixeddom;
1.876     raeburn   739:                     }
                    740:                 }
1.468     raeburn   741:             }
                    742:         }
                    743:     }
1.876     raeburn   744:     return;
                    745: }
                    746: 
                    747: $id_functions
                    748: ENDUSERBRW
1.468     raeburn   749: }
                    750: 
                    751: sub setsec_javascript {
1.905     raeburn   752:     my ($sec_element,$formname,$role_element) = @_;
                    753:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    754:         $communityrolestr);
                    755:     if ($role_element ne '') {
                    756:         my @allroles = ('st','ta','ep','in','ad');
                    757:         foreach my $crstype ('Course','Community') {
                    758:             if ($crstype eq 'Community') {
                    759:                 foreach my $role (@allroles) {
                    760:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    761:                 }
                    762:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    763:             } else {
                    764:                 foreach my $role (@allroles) {
                    765:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    766:                 }
                    767:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    768:             }
                    769:         }
                    770:         $rolestr = '"'.join('","',@allroles).'"';
                    771:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    772:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    773:     }
1.468     raeburn   774:     my $setsections = qq|
                    775: function setSect(sectionlist) {
1.629     raeburn   776:     var sectionsArray = new Array();
                    777:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    778:         sectionsArray = sectionlist.split(",");
                    779:     }
1.468     raeburn   780:     var numSections = sectionsArray.length;
                    781:     document.$formname.$sec_element.length = 0;
                    782:     if (numSections == 0) {
                    783:         document.$formname.$sec_element.multiple=false;
                    784:         document.$formname.$sec_element.size=1;
                    785:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    786:     } else {
                    787:         if (numSections == 1) {
                    788:             document.$formname.$sec_element.multiple=false;
                    789:             document.$formname.$sec_element.size=1;
                    790:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    791:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    792:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    793:         } else {
                    794:             for (var i=0; i<numSections; i++) {
                    795:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    796:             }
                    797:             document.$formname.$sec_element.multiple=true
                    798:             if (numSections < 3) {
                    799:                 document.$formname.$sec_element.size=numSections;
                    800:             } else {
                    801:                 document.$formname.$sec_element.size=3;
                    802:             }
                    803:             document.$formname.$sec_element.options[0].selected = false
                    804:         }
                    805:     }
1.91      www       806: }
1.905     raeburn   807: 
                    808: function setRole(crstype) {
1.468     raeburn   809: |;
1.905     raeburn   810:     if ($role_element eq '') {
                    811:         $setsections .= '    return;
                    812: }
                    813: ';
                    814:     } else {
                    815:         $setsections .= qq|
                    816:     var elementLength = document.$formname.$role_element.length;
                    817:     var allroles = Array($rolestr);
                    818:     var courserolenames = Array($courserolestr);
                    819:     var communityrolenames = Array($communityrolestr);
                    820:     if (elementLength != undefined) {
                    821:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    822:             if (crstype == 'Course') {
                    823:                 return;
                    824:             } else {
                    825:                 allroles[5] = 'co';
                    826:                 for (var i=0; i<6; i++) {
                    827:                     document.$formname.$role_element.options[i].value = allroles[i];
                    828:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    829:                 }
                    830:             }
                    831:         } else {
                    832:             if (crstype == 'Community') {
                    833:                 return;
                    834:             } else {
                    835:                 allroles[5] = 'cc';
                    836:                 for (var i=0; i<6; i++) {
                    837:                     document.$formname.$role_element.options[i].value = allroles[i];
                    838:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    839:                 }
                    840:             }
                    841:         }
                    842:     }
                    843:     return;
                    844: }
                    845: |;
                    846:     }
1.468     raeburn   847:     return $setsections;
                    848: }
                    849: 
1.91      www       850: sub selectcourse_link {
1.909     raeburn   851:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    852:        $typeelement) = @_;
                    853:    my $type = $selecttype;
1.871     raeburn   854:    my $linktext = &mt('Select Course');
                    855:    if ($selecttype eq 'Community') {
1.909     raeburn   856:        $linktext = &mt('Select Community');
1.906     raeburn   857:    } elsif ($selecttype eq 'Course/Community') {
                    858:        $linktext = &mt('Select Course/Community');
1.909     raeburn   859:        $type = '';
1.1019    raeburn   860:    } elsif ($selecttype eq 'Select') {
                    861:        $linktext = &mt('Select');
                    862:        $type = '';
1.871     raeburn   863:    }
1.787     bisitz    864:    return '<span class="LC_nobreak">'
                    865:          ."<a href='"
                    866:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    867:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   868:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   869:          ."'>".$linktext.'</a>'
1.787     bisitz    870:          .'</span>';
1.74      www       871: }
1.42      matthew   872: 
1.653     raeburn   873: sub selectauthor_link {
                    874:    my ($form,$udom)=@_;
                    875:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    876:           &mt('Select Author').'</a>';
                    877: }
                    878: 
1.876     raeburn   879: sub selectuser_link {
1.881     raeburn   880:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   881:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   882:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   883:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   884:            ');">'.$linktext.'</a>';
1.876     raeburn   885: }
                    886: 
1.273     raeburn   887: sub check_uncheck_jscript {
                    888:     my $jscript = <<"ENDSCRT";
                    889: function checkAll(field) {
                    890:     if (field.length > 0) {
                    891:         for (i = 0; i < field.length; i++) {
1.1075.2.14  raeburn   892:             if (!field[i].disabled) {
                    893:                 field[i].checked = true;
                    894:             }
1.273     raeburn   895:         }
                    896:     } else {
1.1075.2.14  raeburn   897:         if (!field.disabled) {
                    898:             field.checked = true;
                    899:         }
1.273     raeburn   900:     }
                    901: }
                    902:  
                    903: function uncheckAll(field) {
                    904:     if (field.length > 0) {
                    905:         for (i = 0; i < field.length; i++) {
                    906:             field[i].checked = false ;
1.543     albertel  907:         }
                    908:     } else {
1.273     raeburn   909:         field.checked = false ;
                    910:     }
                    911: }
                    912: ENDSCRT
                    913:     return $jscript;
                    914: }
                    915: 
1.656     www       916: sub select_timezone {
1.659     raeburn   917:    my ($name,$selected,$onchange,$includeempty)=@_;
                    918:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    919:    if ($includeempty) {
                    920:        $output .= '<option value=""';
                    921:        if (($selected eq '') || ($selected eq 'local')) {
                    922:            $output .= ' selected="selected" ';
                    923:        }
                    924:        $output .= '> </option>';
                    925:    }
1.657     raeburn   926:    my @timezones = DateTime::TimeZone->all_names;
                    927:    foreach my $tzone (@timezones) {
                    928:        $output.= '<option value="'.$tzone.'"';
                    929:        if ($tzone eq $selected) {
                    930:            $output.=' selected="selected"';
                    931:        }
                    932:        $output.=">$tzone</option>\n";
1.656     www       933:    }
                    934:    $output.="</select>";
                    935:    return $output;
                    936: }
1.273     raeburn   937: 
1.687     raeburn   938: sub select_datelocale {
                    939:     my ($name,$selected,$onchange,$includeempty)=@_;
                    940:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    941:     if ($includeempty) {
                    942:         $output .= '<option value=""';
                    943:         if ($selected eq '') {
                    944:             $output .= ' selected="selected" ';
                    945:         }
                    946:         $output .= '> </option>';
                    947:     }
                    948:     my (@possibles,%locale_names);
                    949:     my @locales = DateTime::Locale::Catalog::Locales;
                    950:     foreach my $locale (@locales) {
                    951:         if (ref($locale) eq 'HASH') {
                    952:             my $id = $locale->{'id'};
                    953:             if ($id ne '') {
                    954:                 my $en_terr = $locale->{'en_territory'};
                    955:                 my $native_terr = $locale->{'native_territory'};
1.695     raeburn   956:                 my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   957:                 if (grep(/^en$/,@languages) || !@languages) {
                    958:                     if ($en_terr ne '') {
                    959:                         $locale_names{$id} = '('.$en_terr.')';
                    960:                     } elsif ($native_terr ne '') {
                    961:                         $locale_names{$id} = $native_terr;
                    962:                     }
                    963:                 } else {
                    964:                     if ($native_terr ne '') {
                    965:                         $locale_names{$id} = $native_terr.' ';
                    966:                     } elsif ($en_terr ne '') {
                    967:                         $locale_names{$id} = '('.$en_terr.')';
                    968:                     }
                    969:                 }
                    970:                 push (@possibles,$id);
                    971:             }
                    972:         }
                    973:     }
                    974:     foreach my $item (sort(@possibles)) {
                    975:         $output.= '<option value="'.$item.'"';
                    976:         if ($item eq $selected) {
                    977:             $output.=' selected="selected"';
                    978:         }
                    979:         $output.=">$item";
                    980:         if ($locale_names{$item} ne '') {
                    981:             $output.="  $locale_names{$item}</option>\n";
                    982:         }
                    983:         $output.="</option>\n";
                    984:     }
                    985:     $output.="</select>";
                    986:     return $output;
                    987: }
                    988: 
1.792     raeburn   989: sub select_language {
                    990:     my ($name,$selected,$includeempty) = @_;
                    991:     my %langchoices;
                    992:     if ($includeempty) {
                    993:         %langchoices = ('' => 'No language preference');
                    994:     }
                    995:     foreach my $id (&languageids()) {
                    996:         my $code = &supportedlanguagecode($id);
                    997:         if ($code) {
                    998:             $langchoices{$code} = &plainlanguagedescription($id);
                    999:         }
                   1000:     }
1.970     raeburn  1001:     return &select_form($selected,$name,\%langchoices);
1.792     raeburn  1002: }
                   1003: 
1.42      matthew  1004: =pod
1.36      matthew  1005: 
1.648     raeburn  1006: =item * &linked_select_forms(...)
1.36      matthew  1007: 
                   1008: linked_select_forms returns a string containing a <script></script> block
                   1009: and html for two <select> menus.  The select menus will be linked in that
                   1010: changing the value of the first menu will result in new values being placed
                   1011: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1012: order unless a defined order is provided.
1.36      matthew  1013: 
                   1014: linked_select_forms takes the following ordered inputs:
                   1015: 
                   1016: =over 4
                   1017: 
1.112     bowersj2 1018: =item * $formname, the name of the <form> tag
1.36      matthew  1019: 
1.112     bowersj2 1020: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1021: 
1.112     bowersj2 1022: =item * $firstdefault, the default value for the first menu
1.36      matthew  1023: 
1.112     bowersj2 1024: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1025: 
1.112     bowersj2 1026: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1027: 
1.112     bowersj2 1028: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1029: 
1.609     raeburn  1030: =item * $menuorder, the order of values in the first menu
                   1031: 
1.41      ng       1032: =back 
                   1033: 
1.36      matthew  1034: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1035: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1036: values for the first select menu.  The text that coincides with the 
1.41      ng       1037: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1038: and text for the second menu are given in the hash pointed to by 
                   1039: $menu{$choice1}->{'select2'}.  
                   1040: 
1.112     bowersj2 1041:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1042:                        default => "B3",
                   1043:                        select2 => { 
                   1044:                            B1 => "Choice B1",
                   1045:                            B2 => "Choice B2",
                   1046:                            B3 => "Choice B3",
                   1047:                            B4 => "Choice B4"
1.609     raeburn  1048:                            },
                   1049:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1050:                    },
                   1051:                A2 => { text =>"Choice A2" ,
                   1052:                        default => "C2",
                   1053:                        select2 => { 
                   1054:                            C1 => "Choice C1",
                   1055:                            C2 => "Choice C2",
                   1056:                            C3 => "Choice C3"
1.609     raeburn  1057:                            },
                   1058:                        order => ['C2','C1','C3'],
1.112     bowersj2 1059:                    },
                   1060:                A3 => { text =>"Choice A3" ,
                   1061:                        default => "D6",
                   1062:                        select2 => { 
                   1063:                            D1 => "Choice D1",
                   1064:                            D2 => "Choice D2",
                   1065:                            D3 => "Choice D3",
                   1066:                            D4 => "Choice D4",
                   1067:                            D5 => "Choice D5",
                   1068:                            D6 => "Choice D6",
                   1069:                            D7 => "Choice D7"
1.609     raeburn  1070:                            },
                   1071:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1072:                    }
                   1073:                );
1.36      matthew  1074: 
                   1075: =cut
                   1076: 
                   1077: sub linked_select_forms {
                   1078:     my ($formname,
                   1079:         $middletext,
                   1080:         $firstdefault,
                   1081:         $firstselectname,
                   1082:         $secondselectname, 
1.609     raeburn  1083:         $hashref,
                   1084:         $menuorder,
1.36      matthew  1085:         ) = @_;
                   1086:     my $second = "document.$formname.$secondselectname";
                   1087:     my $first = "document.$formname.$firstselectname";
                   1088:     # output the javascript to do the changing
                   1089:     my $result = '';
1.776     bisitz   1090:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1091:     $result.="// <![CDATA[\n";
1.36      matthew  1092:     $result.="var select2data = new Object();\n";
                   1093:     $" = '","';
                   1094:     my $debug = '';
                   1095:     foreach my $s1 (sort(keys(%$hashref))) {
                   1096:         $result.="select2data.d_$s1 = new Object();\n";        
                   1097:         $result.="select2data.d_$s1.def = new String('".
                   1098:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1099:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1100:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1101:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1102:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1103:         }
1.36      matthew  1104:         $result.="\"@s2values\");\n";
                   1105:         $result.="select2data.d_$s1.texts = new Array(";        
                   1106:         my @s2texts;
                   1107:         foreach my $value (@s2values) {
                   1108:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1109:         }
                   1110:         $result.="\"@s2texts\");\n";
                   1111:     }
                   1112:     $"=' ';
                   1113:     $result.= <<"END";
                   1114: 
                   1115: function select1_changed() {
                   1116:     // Determine new choice
                   1117:     var newvalue = "d_" + $first.value;
                   1118:     // update select2
                   1119:     var values     = select2data[newvalue].values;
                   1120:     var texts      = select2data[newvalue].texts;
                   1121:     var select2def = select2data[newvalue].def;
                   1122:     var i;
                   1123:     // out with the old
                   1124:     for (i = 0; i < $second.options.length; i++) {
                   1125:         $second.options[i] = null;
                   1126:     }
                   1127:     // in with the nuclear
                   1128:     for (i=0;i<values.length; i++) {
                   1129:         $second.options[i] = new Option(values[i]);
1.143     matthew  1130:         $second.options[i].value = values[i];
1.36      matthew  1131:         $second.options[i].text = texts[i];
                   1132:         if (values[i] == select2def) {
                   1133:             $second.options[i].selected = true;
                   1134:         }
                   1135:     }
                   1136: }
1.824     bisitz   1137: // ]]>
1.36      matthew  1138: </script>
                   1139: END
                   1140:     # output the initial values for the selection lists
                   1141:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609     raeburn  1142:     my @order = sort(keys(%{$hashref}));
                   1143:     if (ref($menuorder) eq 'ARRAY') {
                   1144:         @order = @{$menuorder};
                   1145:     }
                   1146:     foreach my $value (@order) {
1.36      matthew  1147:         $result.="    <option value=\"$value\" ";
1.253     albertel 1148:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1149:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1150:     }
                   1151:     $result .= "</select>\n";
                   1152:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1153:     $result .= $middletext;
                   1154:     $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
                   1155:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1156:     
                   1157:     my @secondorder = sort(keys(%select2));
                   1158:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1159:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1160:     }
                   1161:     foreach my $value (@secondorder) {
1.36      matthew  1162:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1163:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1164:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1165:     }
                   1166:     $result .= "</select>\n";
                   1167:     #    return $debug;
                   1168:     return $result;
                   1169: }   #  end of sub linked_select_forms {
                   1170: 
1.45      matthew  1171: =pod
1.44      bowersj2 1172: 
1.973     raeburn  1173: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1174: 
1.112     bowersj2 1175: Returns a string corresponding to an HTML link to the given help
                   1176: $topic, where $topic corresponds to the name of a .tex file in
                   1177: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1178: spaces. 
                   1179: 
                   1180: $text will optionally be linked to the same topic, allowing you to
                   1181: link text in addition to the graphic. If you do not want to link
                   1182: text, but wish to specify one of the later parameters, pass an
                   1183: empty string. 
                   1184: 
                   1185: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1186: the link will not open a new window. If false, the link will open
                   1187: a new window using Javascript. (Default is false.) 
                   1188: 
                   1189: $width and $height are optional numerical parameters that will
                   1190: override the width and height of the popped up window, which may
1.973     raeburn  1191: be useful for certain help topics with big pictures included.
                   1192: 
                   1193: $imgid is the id of the img tag used for the help icon. This may be
                   1194: used in a javascript call to switch the image src.  See 
                   1195: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1196: 
                   1197: =cut
                   1198: 
                   1199: sub help_open_topic {
1.973     raeburn  1200:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1201:     $text = "" if (not defined $text);
1.44      bowersj2 1202:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1203:     $width = 500 if (not defined $width);
1.44      bowersj2 1204:     $height = 400 if (not defined $height);
                   1205:     my $filename = $topic;
                   1206:     $filename =~ s/ /_/g;
                   1207: 
1.48      bowersj2 1208:     my $template = "";
                   1209:     my $link;
1.572     banghart 1210:     
1.159     www      1211:     $topic=~s/\W/\_/g;
1.44      bowersj2 1212: 
1.572     banghart 1213:     if (!$stayOnPage) {
1.1033    www      1214: 	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037    www      1215:     } elsif ($stayOnPage eq 'popup') {
                   1216:         $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 1217:     } else {
1.48      bowersj2 1218: 	$link = "/adm/help/${filename}.hlp";
                   1219:     }
                   1220: 
                   1221:     # Add the text
1.755     neumanie 1222:     if ($text ne "") {	
1.763     bisitz   1223: 	$template.='<span class="LC_help_open_topic">'
                   1224:                   .'<a target="_top" href="'.$link.'">'
                   1225:                   .$text.'</a>';
1.48      bowersj2 1226:     }
                   1227: 
1.763     bisitz   1228:     # (Always) Add the graphic
1.179     matthew  1229:     my $title = &mt('Online Help');
1.667     raeburn  1230:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1231:     if ($imgid ne '') {
                   1232:         $imgid = ' id="'.$imgid.'"';
                   1233:     }
1.763     bisitz   1234:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1235:               .'<img src="'.$helpicon.'" border="0"'
                   1236:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1237:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1238:               .' /></a>';
                   1239:     if ($text ne "") {	
                   1240:         $template.='</span>';
                   1241:     }
1.44      bowersj2 1242:     return $template;
                   1243: 
1.106     bowersj2 1244: }
                   1245: 
                   1246: # This is a quicky function for Latex cheatsheet editing, since it 
                   1247: # appears in at least four places
                   1248: sub helpLatexCheatsheet {
1.1037    www      1249:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1250:     my $out;
1.106     bowersj2 1251:     my $addOther = '';
1.732     raeburn  1252:     if ($topic) {
1.1037    www      1253: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1254:     }
                   1255:     $out = '<span>' # Start cheatsheet
                   1256: 	  .$addOther
                   1257:           .'<span>'
1.1037    www      1258: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1259: 	  .'</span> <span>'
1.1037    www      1260: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1261: 	  .'</span>';
1.732     raeburn  1262:     unless ($not_author) {
1.763     bisitz   1263:         $out .= ' <span>'
1.1037    www      1264: 	       .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.763     bisitz   1265: 	       .'</span>';
1.732     raeburn  1266:     }
1.763     bisitz   1267:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1268:     return $out;
1.172     www      1269: }
                   1270: 
1.430     albertel 1271: sub general_help {
                   1272:     my $helptopic='Student_Intro';
                   1273:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1274: 	$helptopic='Authoring_Intro';
1.907     raeburn  1275:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1276: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1277:     } elsif ($env{'request.role'}=~/^dc/) {
                   1278:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1279:     }
                   1280:     return $helptopic;
                   1281: }
                   1282: 
                   1283: sub update_help_link {
                   1284:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1285:     my $origurl = $ENV{'REQUEST_URI'};
                   1286:     $origurl=~s|^/~|/priv/|;
                   1287:     my $timestamp = time;
                   1288:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1289:         $$datum = &escape($$datum);
                   1290:     }
                   1291: 
                   1292:     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";
                   1293:     my $output .= <<"ENDOUTPUT";
                   1294: <script type="text/javascript">
1.824     bisitz   1295: // <![CDATA[
1.430     albertel 1296: banner_link = '$banner_link';
1.824     bisitz   1297: // ]]>
1.430     albertel 1298: </script>
                   1299: ENDOUTPUT
                   1300:     return $output;
                   1301: }
                   1302: 
                   1303: # now just updates the help link and generates a blue icon
1.193     raeburn  1304: sub help_open_menu {
1.430     albertel 1305:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1306: 	= @_;    
1.949     droeschl 1307:     $stayOnPage = 1;
1.430     albertel 1308:     my $output;
                   1309:     if ($component_help) {
                   1310: 	if (!$text) {
                   1311: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1312: 				       $width,$height);
                   1313: 	} else {
                   1314: 	    my $help_text;
                   1315: 	    $help_text=&unescape($topic);
                   1316: 	    $output='<table><tr><td>'.
                   1317: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1318: 				 $width,$height).'</td></tr></table>';
                   1319: 	}
                   1320:     }
                   1321:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1322:     return $output.$banner_link;
                   1323: }
                   1324: 
                   1325: sub top_nav_help {
                   1326:     my ($text) = @_;
1.436     albertel 1327:     $text = &mt($text);
1.949     droeschl 1328:     my $stay_on_page = 1;
                   1329: 
1.572     banghart 1330:     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436     albertel 1331: 	                     : "javascript:helpMenu('open')";
1.572     banghart 1332:     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436     albertel 1333: 
1.201     raeburn  1334:     my $title = &mt('Get help');
1.436     albertel 1335: 
                   1336:     return <<"END";
                   1337: $banner_link
                   1338:  <a href="$link" title="$title">$text</a>
                   1339: END
                   1340: }
                   1341: 
                   1342: sub help_menu_js {
                   1343:     my ($text) = @_;
1.949     droeschl 1344:     my $stayOnPage = 1;
1.436     albertel 1345:     my $width = 620;
                   1346:     my $height = 600;
1.430     albertel 1347:     my $helptopic=&general_help();
                   1348:     my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1349:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1350:     my $start_page =
                   1351:         &Apache::loncommon::start_page('Help Menu', undef,
                   1352: 				       {'frameset'    => 1,
                   1353: 					'js_ready'    => 1,
                   1354: 					'add_entries' => {
                   1355: 					    'border' => '0',
1.579     raeburn  1356: 					    'rows'   => "110,*",},});
1.331     albertel 1357:     my $end_page =
                   1358:         &Apache::loncommon::end_page({'frameset' => 1,
                   1359: 				      'js_ready' => 1,});
                   1360: 
1.436     albertel 1361:     my $template .= <<"ENDTEMPLATE";
                   1362: <script type="text/javascript">
1.877     bisitz   1363: // <![CDATA[
1.253     albertel 1364: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1365: var banner_link = '';
1.243     raeburn  1366: function helpMenu(target) {
                   1367:     var caller = this;
                   1368:     if (target == 'open') {
                   1369:         var newWindow = null;
                   1370:         try {
1.262     albertel 1371:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1372:         }
                   1373:         catch(error) {
                   1374:             writeHelp(caller);
                   1375:             return;
                   1376:         }
                   1377:         if (newWindow) {
                   1378:             caller = newWindow;
                   1379:         }
1.193     raeburn  1380:     }
1.243     raeburn  1381:     writeHelp(caller);
                   1382:     return;
                   1383: }
                   1384: function writeHelp(caller) {
1.1072    raeburn  1385:     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  1386:     caller.document.close()
                   1387:     caller.focus()
1.193     raeburn  1388: }
1.877     bisitz   1389: // END LON-CAPA Internal -->
1.253     albertel 1390: // ]]>
1.436     albertel 1391: </script>
1.193     raeburn  1392: ENDTEMPLATE
                   1393:     return $template;
                   1394: }
                   1395: 
1.172     www      1396: sub help_open_bug {
                   1397:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1398:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1399:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1400:     $text = "" if (not defined $text);
                   1401: 	$stayOnPage=1;
1.184     albertel 1402:     $width = 600 if (not defined $width);
                   1403:     $height = 600 if (not defined $height);
1.172     www      1404: 
                   1405:     $topic=~s/\W+/\+/g;
                   1406:     my $link='';
                   1407:     my $template='';
1.379     albertel 1408:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1409: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1410:     if (!$stayOnPage)
                   1411:     {
                   1412: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1413:     }
                   1414:     else
                   1415:     {
                   1416: 	$link = $url;
                   1417:     }
                   1418:     # Add the text
                   1419:     if ($text ne "")
                   1420:     {
                   1421: 	$template .= 
                   1422:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1423:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1424:     }
                   1425: 
                   1426:     # Add the graphic
1.179     matthew  1427:     my $title = &mt('Report a Bug');
1.215     albertel 1428:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1429:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1430:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1431: ENDTEMPLATE
                   1432:     if ($text ne '') { $template.='</td></tr></table>' };
                   1433:     return $template;
                   1434: 
                   1435: }
                   1436: 
                   1437: sub help_open_faq {
                   1438:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1439:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1440:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1441:     $text = "" if (not defined $text);
                   1442: 	$stayOnPage=1;
                   1443:     $width = 350 if (not defined $width);
                   1444:     $height = 400 if (not defined $height);
                   1445: 
                   1446:     $topic=~s/\W+/\+/g;
                   1447:     my $link='';
                   1448:     my $template='';
                   1449:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1450:     if (!$stayOnPage)
                   1451:     {
                   1452: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1453:     }
                   1454:     else
                   1455:     {
                   1456: 	$link = $url;
                   1457:     }
                   1458: 
                   1459:     # Add the text
                   1460:     if ($text ne "")
                   1461:     {
                   1462: 	$template .= 
1.173     www      1463:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1464:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1465:     }
                   1466: 
                   1467:     # Add the graphic
1.179     matthew  1468:     my $title = &mt('View the FAQ');
1.215     albertel 1469:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1470:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1471:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1472: ENDTEMPLATE
                   1473:     if ($text ne '') { $template.='</td></tr></table>' };
                   1474:     return $template;
                   1475: 
1.44      bowersj2 1476: }
1.37      matthew  1477: 
1.180     matthew  1478: ###############################################################
                   1479: ###############################################################
                   1480: 
1.45      matthew  1481: =pod
                   1482: 
1.648     raeburn  1483: =item * &change_content_javascript():
1.256     matthew  1484: 
                   1485: This and the next function allow you to create small sections of an
                   1486: otherwise static HTML page that you can update on the fly with
                   1487: Javascript, even in Netscape 4.
                   1488: 
                   1489: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1490: must be written to the HTML page once. It will prove the Javascript
                   1491: function "change(name, content)". Calling the change function with the
                   1492: name of the section 
                   1493: you want to update, matching the name passed to C<changable_area>, and
                   1494: the new content you want to put in there, will put the content into
                   1495: that area.
                   1496: 
                   1497: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1498: to contain room for the original contents. You need to "make space"
                   1499: for whatever changes you wish to make, and be B<sure> to check your
                   1500: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1501: it's adequate for updating a one-line status display, but little more.
                   1502: This script will set the space to 100% width, so you only need to
                   1503: worry about height in Netscape 4.
                   1504: 
                   1505: Modern browsers are much less limiting, and if you can commit to the
                   1506: user not using Netscape 4, this feature may be used freely with
                   1507: pretty much any HTML.
                   1508: 
                   1509: =cut
                   1510: 
                   1511: sub change_content_javascript {
                   1512:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1513:     if ($env{'browser.type'} eq 'netscape' &&
                   1514: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1515: 	return (<<NETSCAPE4);
                   1516: 	function change(name, content) {
                   1517: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1518: 	    doc.open();
                   1519: 	    doc.write(content);
                   1520: 	    doc.close();
                   1521: 	}
                   1522: NETSCAPE4
                   1523:     } else {
                   1524: 	# Otherwise, we need to use semi-standards-compliant code
                   1525: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1526: 	# is really scary, and every useful browser supports it
                   1527: 	return (<<DOMBASED);
                   1528: 	function change(name, content) {
                   1529: 	    element = document.getElementById(name);
                   1530: 	    element.innerHTML = content;
                   1531: 	}
                   1532: DOMBASED
                   1533:     }
                   1534: }
                   1535: 
                   1536: =pod
                   1537: 
1.648     raeburn  1538: =item * &changable_area($name,$origContent):
1.256     matthew  1539: 
                   1540: This provides a "changable area" that can be modified on the fly via
                   1541: the Javascript code provided in C<change_content_javascript>. $name is
                   1542: the name you will use to reference the area later; do not repeat the
                   1543: same name on a given HTML page more then once. $origContent is what
                   1544: the area will originally contain, which can be left blank.
                   1545: 
                   1546: =cut
                   1547: 
                   1548: sub changable_area {
                   1549:     my ($name, $origContent) = @_;
                   1550: 
1.258     albertel 1551:     if ($env{'browser.type'} eq 'netscape' &&
                   1552: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1553: 	# If this is netscape 4, we need to use the Layer tag
                   1554: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1555:     } else {
                   1556: 	return "<span id='$name'>$origContent</span>";
                   1557:     }
                   1558: }
                   1559: 
                   1560: =pod
                   1561: 
1.648     raeburn  1562: =item * &viewport_geometry_js 
1.590     raeburn  1563: 
                   1564: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1565: 
                   1566: =cut
                   1567: 
                   1568: 
                   1569: sub viewport_geometry_js { 
                   1570:     return <<"GEOMETRY";
                   1571: var Geometry = {};
                   1572: function init_geometry() {
                   1573:     if (Geometry.init) { return };
                   1574:     Geometry.init=1;
                   1575:     if (window.innerHeight) {
                   1576:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1577:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1578:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1579:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1580:     }
                   1581:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1582:         Geometry.getViewportHeight =
                   1583:             function() { return document.documentElement.clientHeight; };
                   1584:         Geometry.getViewportWidth =
                   1585:             function() { return document.documentElement.clientWidth; };
                   1586: 
                   1587:         Geometry.getHorizontalScroll =
                   1588:             function() { return document.documentElement.scrollLeft; };
                   1589:         Geometry.getVerticalScroll =
                   1590:             function() { return document.documentElement.scrollTop; };
                   1591:     }
                   1592:     else if (document.body.clientHeight) {
                   1593:         Geometry.getViewportHeight =
                   1594:             function() { return document.body.clientHeight; };
                   1595:         Geometry.getViewportWidth =
                   1596:             function() { return document.body.clientWidth; };
                   1597:         Geometry.getHorizontalScroll =
                   1598:             function() { return document.body.scrollLeft; };
                   1599:         Geometry.getVerticalScroll =
                   1600:             function() { return document.body.scrollTop; };
                   1601:     }
                   1602: }
                   1603: 
                   1604: GEOMETRY
                   1605: }
                   1606: 
                   1607: =pod
                   1608: 
1.648     raeburn  1609: =item * &viewport_size_js()
1.590     raeburn  1610: 
                   1611: 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. 
                   1612: 
                   1613: =cut
                   1614: 
                   1615: sub viewport_size_js {
                   1616:     my $geometry = &viewport_geometry_js();
                   1617:     return <<"DIMS";
                   1618: 
                   1619: $geometry
                   1620: 
                   1621: function getViewportDims(width,height) {
                   1622:     init_geometry();
                   1623:     width.value = Geometry.getViewportWidth();
                   1624:     height.value = Geometry.getViewportHeight();
                   1625:     return;
                   1626: }
                   1627: 
                   1628: DIMS
                   1629: }
                   1630: 
                   1631: =pod
                   1632: 
1.648     raeburn  1633: =item * &resize_textarea_js()
1.565     albertel 1634: 
                   1635: emits the needed javascript to resize a textarea to be as big as possible
                   1636: 
                   1637: creates a function resize_textrea that takes two IDs first should be
                   1638: the id of the element to resize, second should be the id of a div that
                   1639: surrounds everything that comes after the textarea, this routine needs
                   1640: to be attached to the <body> for the onload and onresize events.
                   1641: 
1.648     raeburn  1642: =back
1.565     albertel 1643: 
                   1644: =cut
                   1645: 
                   1646: sub resize_textarea_js {
1.590     raeburn  1647:     my $geometry = &viewport_geometry_js();
1.565     albertel 1648:     return <<"RESIZE";
                   1649:     <script type="text/javascript">
1.824     bisitz   1650: // <![CDATA[
1.590     raeburn  1651: $geometry
1.565     albertel 1652: 
1.588     albertel 1653: function getX(element) {
                   1654:     var x = 0;
                   1655:     while (element) {
                   1656: 	x += element.offsetLeft;
                   1657: 	element = element.offsetParent;
                   1658:     }
                   1659:     return x;
                   1660: }
                   1661: function getY(element) {
                   1662:     var y = 0;
                   1663:     while (element) {
                   1664: 	y += element.offsetTop;
                   1665: 	element = element.offsetParent;
                   1666:     }
                   1667:     return y;
                   1668: }
                   1669: 
                   1670: 
1.565     albertel 1671: function resize_textarea(textarea_id,bottom_id) {
                   1672:     init_geometry();
                   1673:     var textarea        = document.getElementById(textarea_id);
                   1674:     //alert(textarea);
                   1675: 
1.588     albertel 1676:     var textarea_top    = getY(textarea);
1.565     albertel 1677:     var textarea_height = textarea.offsetHeight;
                   1678:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1679:     var bottom_top      = getY(bottom);
1.565     albertel 1680:     var bottom_height   = bottom.offsetHeight;
                   1681:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1682:     var fudge           = 23;
1.565     albertel 1683:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1684:     if (new_height < 300) {
                   1685: 	new_height = 300;
                   1686:     }
                   1687:     textarea.style.height=new_height+'px';
                   1688: }
1.824     bisitz   1689: // ]]>
1.565     albertel 1690: </script>
                   1691: RESIZE
                   1692: 
                   1693: }
                   1694: 
                   1695: =pod
                   1696: 
1.256     matthew  1697: =head1 Excel and CSV file utility routines
                   1698: 
                   1699: =over 4
                   1700: 
                   1701: =cut
                   1702: 
                   1703: ###############################################################
                   1704: ###############################################################
                   1705: 
                   1706: =pod
                   1707: 
1.648     raeburn  1708: =item * &csv_translate($text) 
1.37      matthew  1709: 
1.185     www      1710: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1711: format.
                   1712: 
                   1713: =cut
                   1714: 
1.180     matthew  1715: ###############################################################
                   1716: ###############################################################
1.37      matthew  1717: sub csv_translate {
                   1718:     my $text = shift;
                   1719:     $text =~ s/\"/\"\"/g;
1.209     albertel 1720:     $text =~ s/\n/ /g;
1.37      matthew  1721:     return $text;
                   1722: }
1.180     matthew  1723: 
                   1724: ###############################################################
                   1725: ###############################################################
                   1726: 
                   1727: =pod
                   1728: 
1.648     raeburn  1729: =item * &define_excel_formats()
1.180     matthew  1730: 
                   1731: Define some commonly used Excel cell formats.
                   1732: 
                   1733: Currently supported formats:
                   1734: 
                   1735: =over 4
                   1736: 
                   1737: =item header
                   1738: 
                   1739: =item bold
                   1740: 
                   1741: =item h1
                   1742: 
                   1743: =item h2
                   1744: 
                   1745: =item h3
                   1746: 
1.256     matthew  1747: =item h4
                   1748: 
                   1749: =item i
                   1750: 
1.180     matthew  1751: =item date
                   1752: 
                   1753: =back
                   1754: 
                   1755: Inputs: $workbook
                   1756: 
                   1757: Returns: $format, a hash reference.
                   1758: 
1.1057    foxr     1759: 
1.180     matthew  1760: =cut
                   1761: 
                   1762: ###############################################################
                   1763: ###############################################################
                   1764: sub define_excel_formats {
                   1765:     my ($workbook) = @_;
                   1766:     my $format;
                   1767:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1768:                                                 bottom    => 1,
                   1769:                                                 align     => 'center');
                   1770:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1771:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1772:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1773:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1774:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1775:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1776:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1777:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1778:     return $format;
                   1779: }
                   1780: 
                   1781: ###############################################################
                   1782: ###############################################################
1.113     bowersj2 1783: 
                   1784: =pod
                   1785: 
1.648     raeburn  1786: =item * &create_workbook()
1.255     matthew  1787: 
                   1788: Create an Excel worksheet.  If it fails, output message on the
                   1789: request object and return undefs.
                   1790: 
                   1791: Inputs: Apache request object
                   1792: 
                   1793: Returns (undef) on failure, 
                   1794:     Excel worksheet object, scalar with filename, and formats 
                   1795:     from &Apache::loncommon::define_excel_formats on success
                   1796: 
                   1797: =cut
                   1798: 
                   1799: ###############################################################
                   1800: ###############################################################
                   1801: sub create_workbook {
                   1802:     my ($r) = @_;
                   1803:         #
                   1804:     # Create the excel spreadsheet
                   1805:     my $filename = '/prtspool/'.
1.258     albertel 1806:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1807:         time.'_'.rand(1000000000).'.xls';
                   1808:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1809:     if (! defined($workbook)) {
                   1810:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1811:         $r->print(
                   1812:             '<p class="LC_error">'
                   1813:            .&mt('Problems occurred in creating the new Excel file.')
                   1814:            .' '.&mt('This error has been logged.')
                   1815:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1816:            .'</p>'
                   1817:         );
1.255     matthew  1818:         return (undef);
                   1819:     }
                   1820:     #
1.1014    foxr     1821:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  1822:     #
                   1823:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1824:     return ($workbook,$filename,$format);
                   1825: }
                   1826: 
                   1827: ###############################################################
                   1828: ###############################################################
                   1829: 
                   1830: =pod
                   1831: 
1.648     raeburn  1832: =item * &create_text_file()
1.113     bowersj2 1833: 
1.542     raeburn  1834: Create a file to write to and eventually make available to the user.
1.256     matthew  1835: If file creation fails, outputs an error message on the request object and 
                   1836: return undefs.
1.113     bowersj2 1837: 
1.256     matthew  1838: Inputs: Apache request object, and file suffix
1.113     bowersj2 1839: 
1.256     matthew  1840: Returns (undef) on failure, 
                   1841:     Filehandle and filename on success.
1.113     bowersj2 1842: 
                   1843: =cut
                   1844: 
1.256     matthew  1845: ###############################################################
                   1846: ###############################################################
                   1847: sub create_text_file {
                   1848:     my ($r,$suffix) = @_;
                   1849:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1850:     my $fh;
                   1851:     my $filename = '/prtspool/'.
1.258     albertel 1852:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1853:         time.'_'.rand(1000000000).'.'.$suffix;
                   1854:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1855:     if (! defined($fh)) {
                   1856:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1857:         $r->print(
                   1858:             '<p class="LC_error">'
                   1859:            .&mt('Problems occurred in creating the output file.')
                   1860:            .' '.&mt('This error has been logged.')
                   1861:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1862:            .'</p>'
                   1863:         );
1.113     bowersj2 1864:     }
1.256     matthew  1865:     return ($fh,$filename)
1.113     bowersj2 1866: }
                   1867: 
                   1868: 
1.256     matthew  1869: =pod 
1.113     bowersj2 1870: 
                   1871: =back
                   1872: 
                   1873: =cut
1.37      matthew  1874: 
                   1875: ###############################################################
1.33      matthew  1876: ##        Home server <option> list generating code          ##
                   1877: ###############################################################
1.35      matthew  1878: 
1.169     www      1879: # ------------------------------------------
                   1880: 
                   1881: sub domain_select {
                   1882:     my ($name,$value,$multiple)=@_;
                   1883:     my %domains=map { 
1.514     albertel 1884: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1885:     } &Apache::lonnet::all_domains();
1.169     www      1886:     if ($multiple) {
                   1887: 	$domains{''}=&mt('Any domain');
1.550     albertel 1888: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1889: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1890:     } else {
1.550     albertel 1891: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1892: 	return &select_form($name,$value,\%domains);
1.169     www      1893:     }
                   1894: }
                   1895: 
1.282     albertel 1896: #-------------------------------------------
                   1897: 
                   1898: =pod
                   1899: 
1.519     raeburn  1900: =head1 Routines for form select boxes
                   1901: 
                   1902: =over 4
                   1903: 
1.648     raeburn  1904: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1905: 
                   1906: Returns a string containing a <select> element int multiple mode
                   1907: 
                   1908: 
                   1909: Args:
                   1910:   $name - name of the <select> element
1.506     raeburn  1911:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1912:   $size - number of rows long the select element is
1.283     albertel 1913:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1914:           (shown text should already have been &mt())
1.506     raeburn  1915:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1916: 
1.282     albertel 1917: =cut
                   1918: 
                   1919: #-------------------------------------------
1.169     www      1920: sub multiple_select_form {
1.284     albertel 1921:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1922:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1923:     my $output='';
1.191     matthew  1924:     if (! defined($size)) {
                   1925:         $size = 4;
1.283     albertel 1926:         if (scalar(keys(%$hash))<4) {
                   1927:             $size = scalar(keys(%$hash));
1.191     matthew  1928:         }
                   1929:     }
1.734     bisitz   1930:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1931:     my @order;
1.506     raeburn  1932:     if (ref($order) eq 'ARRAY')  {
                   1933:         @order = @{$order};
                   1934:     } else {
                   1935:         @order = sort(keys(%$hash));
1.501     banghart 1936:     }
                   1937:     if (exists($$hash{'select_form_order'})) {
                   1938:         @order = @{$$hash{'select_form_order'}};
                   1939:     }
                   1940:         
1.284     albertel 1941:     foreach my $key (@order) {
1.356     albertel 1942:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1943:         $output.='selected="selected" ' if ($selected{$key});
                   1944:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1945:     }
                   1946:     $output.="</select>\n";
                   1947:     return $output;
                   1948: }
                   1949: 
1.88      www      1950: #-------------------------------------------
                   1951: 
                   1952: =pod
                   1953: 
1.970     raeburn  1954: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      1955: 
                   1956: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  1957: allow a user to select options from a ref to a hash containing:
                   1958: option_name => displayed text. An optional $onchange can include
                   1959: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   1960: 
1.88      www      1961: See lonrights.pm for an example invocation and use.
                   1962: 
                   1963: =cut
                   1964: 
                   1965: #-------------------------------------------
                   1966: sub select_form {
1.970     raeburn  1967:     my ($def,$name,$hashref,$onchange) = @_;
                   1968:     return unless (ref($hashref) eq 'HASH');
                   1969:     if ($onchange) {
                   1970:         $onchange = ' onchange="'.$onchange.'"';
                   1971:     }
                   1972:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 1973:     my @keys;
1.970     raeburn  1974:     if (exists($hashref->{'select_form_order'})) {
                   1975: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 1976:     } else {
1.970     raeburn  1977: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 1978:     }
1.356     albertel 1979:     foreach my $key (@keys) {
                   1980:         $selectform.=
                   1981: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   1982:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  1983:                 ">".$hashref->{$key}."</option>\n";
1.88      www      1984:     }
                   1985:     $selectform.="</select>";
                   1986:     return $selectform;
                   1987: }
                   1988: 
1.475     www      1989: # For display filters
                   1990: 
                   1991: sub display_filter {
1.1074    raeburn  1992:     my ($context) = @_;
1.475     www      1993:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      1994:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  1995:     my $phraseinput = 'hidden';
                   1996:     my $includeinput = 'hidden';
                   1997:     my ($checked,$includetypestext);
                   1998:     if ($env{'form.displayfilter'} eq 'containing') {
                   1999:         $phraseinput = 'text'; 
                   2000:         if ($context eq 'parmslog') {
                   2001:             $includeinput = 'checkbox';
                   2002:             if ($env{'form.includetypes'}) {
                   2003:                 $checked = ' checked="checked"';
                   2004:             }
                   2005:             $includetypestext = &mt('Include parameter types');
                   2006:         }
                   2007:     } else {
                   2008:         $includetypestext = '&nbsp;';
                   2009:     }
                   2010:     my ($additional,$secondid,$thirdid);
                   2011:     if ($context eq 'parmslog') {
                   2012:         $additional = 
                   2013:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2014:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2015:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2016:             '</label>';
                   2017:         $secondid = 'includetypes';
                   2018:         $thirdid = 'includetypestext';
                   2019:     }
                   2020:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2021:                                                     '$secondid','$thirdid')";
                   2022:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2023: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2024: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2025: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2026:            &mt('Filter: [_1]',
1.477     www      2027: 	   &select_form($env{'form.displayfilter'},
                   2028: 			'displayfilter',
1.970     raeburn  2029: 			{'currentfolder' => 'Current folder/page',
1.477     www      2030: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2031: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2032: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2033:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2034:                          '" />'.$additional;
                   2035: }
                   2036: 
                   2037: sub display_filter_js {
                   2038:     my $includetext = &mt('Include parameter types');
                   2039:     return <<"ENDJS";
                   2040:   
                   2041: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2042:     var firstType = 'hidden';
                   2043:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2044:         firstType = 'text';
                   2045:     }
                   2046:     firstObject = document.getElementById(firstid);
                   2047:     if (typeof(firstObject) == 'object') {
                   2048:         if (firstObject.type != firstType) {
                   2049:             changeInputType(firstObject,firstType);
                   2050:         }
                   2051:     }
                   2052:     if (context == 'parmslog') {
                   2053:         var secondType = 'hidden';
                   2054:         if (firstType == 'text') {
                   2055:             secondType = 'checkbox';
                   2056:         }
                   2057:         secondObject = document.getElementById(secondid);  
                   2058:         if (typeof(secondObject) == 'object') {
                   2059:             if (secondObject.type != secondType) {
                   2060:                 changeInputType(secondObject,secondType);
                   2061:             }
                   2062:         }
                   2063:         var textItem = document.getElementById(thirdid);
                   2064:         var currtext = textItem.innerHTML;
                   2065:         var newtext;
                   2066:         if (firstType == 'text') {
                   2067:             newtext = '$includetext';
                   2068:         } else {
                   2069:             newtext = '&nbsp;';
                   2070:         }
                   2071:         if (currtext != newtext) {
                   2072:             textItem.innerHTML = newtext;
                   2073:         }
                   2074:     }
                   2075:     return;
                   2076: }
                   2077: 
                   2078: function changeInputType(oldObject,newType) {
                   2079:     var newObject = document.createElement('input');
                   2080:     newObject.type = newType;
                   2081:     if (oldObject.size) {
                   2082:         newObject.size = oldObject.size;
                   2083:     }
                   2084:     if (oldObject.value) {
                   2085:         newObject.value = oldObject.value;
                   2086:     }
                   2087:     if (oldObject.name) {
                   2088:         newObject.name = oldObject.name;
                   2089:     }
                   2090:     if (oldObject.id) {
                   2091:         newObject.id = oldObject.id;
                   2092:     }
                   2093:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2094:     return;
                   2095: }
                   2096: 
                   2097: ENDJS
1.475     www      2098: }
                   2099: 
1.167     www      2100: sub gradeleveldescription {
                   2101:     my $gradelevel=shift;
                   2102:     my %gradelevels=(0 => 'Not specified',
                   2103: 		     1 => 'Grade 1',
                   2104: 		     2 => 'Grade 2',
                   2105: 		     3 => 'Grade 3',
                   2106: 		     4 => 'Grade 4',
                   2107: 		     5 => 'Grade 5',
                   2108: 		     6 => 'Grade 6',
                   2109: 		     7 => 'Grade 7',
                   2110: 		     8 => 'Grade 8',
                   2111: 		     9 => 'Grade 9',
                   2112: 		     10 => 'Grade 10',
                   2113: 		     11 => 'Grade 11',
                   2114: 		     12 => 'Grade 12',
                   2115: 		     13 => 'Grade 13',
                   2116: 		     14 => '100 Level',
                   2117: 		     15 => '200 Level',
                   2118: 		     16 => '300 Level',
                   2119: 		     17 => '400 Level',
                   2120: 		     18 => 'Graduate Level');
                   2121:     return &mt($gradelevels{$gradelevel});
                   2122: }
                   2123: 
1.163     www      2124: sub select_level_form {
                   2125:     my ($deflevel,$name)=@_;
                   2126:     unless ($deflevel) { $deflevel=0; }
1.167     www      2127:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2128:     for (my $i=0; $i<=18; $i++) {
                   2129:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2130:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2131:                 ">".&gradeleveldescription($i)."</option>\n";
                   2132:     }
                   2133:     $selectform.="</select>";
                   2134:     return $selectform;
1.163     www      2135: }
1.167     www      2136: 
1.35      matthew  2137: #-------------------------------------------
                   2138: 
1.45      matthew  2139: =pod
                   2140: 
1.910     raeburn  2141: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms)
1.35      matthew  2142: 
                   2143: Returns a string containing a <select name='$name' size='1'> form to 
                   2144: allow a user to select the domain to preform an operation in.  
                   2145: See loncreateuser.pm for an example invocation and use.
                   2146: 
1.90      www      2147: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2148: selected");
                   2149: 
1.743     raeburn  2150: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2151: 
1.910     raeburn  2152: 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.
                   2153: 
                   2154: The optional $incdoms is a reference to an array of domains which will be the only available options. 
1.563     raeburn  2155: 
1.35      matthew  2156: =cut
                   2157: 
                   2158: #-------------------------------------------
1.34      matthew  2159: sub select_dom_form {
1.910     raeburn  2160:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms) = @_;
1.872     raeburn  2161:     if ($onchange) {
1.874     raeburn  2162:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2163:     }
1.910     raeburn  2164:     my @domains;
                   2165:     if (ref($incdoms) eq 'ARRAY') {
                   2166:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2167:     } else {
                   2168:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2169:     }
1.90      www      2170:     if ($includeempty) { @domains=('',@domains); }
1.743     raeburn  2171:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2172:     foreach my $dom (@domains) {
                   2173:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2174:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2175:         if ($showdomdesc) {
                   2176:             if ($dom ne '') {
                   2177:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2178:                 if ($domdesc ne '') {
                   2179:                     $selectdomain .= ' ('.$domdesc.')';
                   2180:                 }
                   2181:             } 
                   2182:         }
                   2183:         $selectdomain .= "</option>\n";
1.34      matthew  2184:     }
                   2185:     $selectdomain.="</select>";
                   2186:     return $selectdomain;
                   2187: }
                   2188: 
1.35      matthew  2189: #-------------------------------------------
                   2190: 
1.45      matthew  2191: =pod
                   2192: 
1.648     raeburn  2193: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2194: 
1.586     raeburn  2195: input: 4 arguments (two required, two optional) - 
                   2196:     $domain - domain of new user
                   2197:     $name - name of form element
                   2198:     $default - Value of 'default' causes a default item to be first 
                   2199:                             option, and selected by default. 
                   2200:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2201:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2202: output: returns 2 items: 
1.586     raeburn  2203: (a) form element which contains either:
                   2204:    (i) <select name="$name">
                   2205:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2206:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2207:        </select>
                   2208:        form item if there are multiple library servers in $domain, or
                   2209:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2210:        if there is only one library server in $domain.
                   2211: 
                   2212: (b) number of library servers found.
                   2213: 
                   2214: See loncreateuser.pm for example of use.
1.35      matthew  2215: 
                   2216: =cut
                   2217: 
                   2218: #-------------------------------------------
1.586     raeburn  2219: sub home_server_form_item {
                   2220:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2221:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2222:     my $result;
                   2223:     my $numlib = keys(%servers);
                   2224:     if ($numlib > 1) {
                   2225:         $result .= '<select name="'.$name.'" />'."\n";
                   2226:         if ($default) {
1.804     bisitz   2227:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2228:                        '</option>'."\n";
                   2229:         }
                   2230:         foreach my $hostid (sort(keys(%servers))) {
                   2231:             $result.= '<option value="'.$hostid.'">'.
                   2232: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2233:         }
                   2234:         $result .= '</select>'."\n";
                   2235:     } elsif ($numlib == 1) {
                   2236:         my $hostid;
                   2237:         foreach my $item (keys(%servers)) {
                   2238:             $hostid = $item;
                   2239:         }
                   2240:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2241:                    $hostid.'" />';
                   2242:                    if (!$hide) {
                   2243:                        $result .= $hostid.' '.$servers{$hostid};
                   2244:                    }
                   2245:                    $result .= "\n";
                   2246:     } elsif ($default) {
                   2247:         $result .= '<input type="hidden" name="'.$name.
                   2248:                    '" value="default" />';
                   2249:                    if (!$hide) {
                   2250:                        $result .= &mt('default');
                   2251:                    }
                   2252:                    $result .= "\n";
1.33      matthew  2253:     }
1.586     raeburn  2254:     return ($result,$numlib);
1.33      matthew  2255: }
1.112     bowersj2 2256: 
                   2257: =pod
                   2258: 
1.534     albertel 2259: =back 
                   2260: 
1.112     bowersj2 2261: =cut
1.87      matthew  2262: 
                   2263: ###############################################################
1.112     bowersj2 2264: ##                  Decoding User Agent                      ##
1.87      matthew  2265: ###############################################################
                   2266: 
                   2267: =pod
                   2268: 
1.112     bowersj2 2269: =head1 Decoding the User Agent
                   2270: 
                   2271: =over 4
                   2272: 
                   2273: =item * &decode_user_agent()
1.87      matthew  2274: 
                   2275: Inputs: $r
                   2276: 
                   2277: Outputs:
                   2278: 
                   2279: =over 4
                   2280: 
1.112     bowersj2 2281: =item * $httpbrowser
1.87      matthew  2282: 
1.112     bowersj2 2283: =item * $clientbrowser
1.87      matthew  2284: 
1.112     bowersj2 2285: =item * $clientversion
1.87      matthew  2286: 
1.112     bowersj2 2287: =item * $clientmathml
1.87      matthew  2288: 
1.112     bowersj2 2289: =item * $clientunicode
1.87      matthew  2290: 
1.112     bowersj2 2291: =item * $clientos
1.87      matthew  2292: 
                   2293: =back
                   2294: 
1.157     matthew  2295: =back 
                   2296: 
1.87      matthew  2297: =cut
                   2298: 
                   2299: ###############################################################
                   2300: ###############################################################
                   2301: sub decode_user_agent {
1.247     albertel 2302:     my ($r)=@_;
1.87      matthew  2303:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2304:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2305:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2306:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2307:     my $clientbrowser='unknown';
                   2308:     my $clientversion='0';
                   2309:     my $clientmathml='';
                   2310:     my $clientunicode='0';
                   2311:     for (my $i=0;$i<=$#browsertype;$i++) {
                   2312:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   2313: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2314: 	    $clientbrowser=$bname;
                   2315:             $httpbrowser=~/$vreg/i;
                   2316: 	    $clientversion=$1;
                   2317:             $clientmathml=($clientversion>=$minv);
                   2318:             $clientunicode=($clientversion>=$univ);
                   2319: 	}
                   2320:     }
                   2321:     my $clientos='unknown';
                   2322:     if (($httpbrowser=~/linux/i) ||
                   2323:         ($httpbrowser=~/unix/i) ||
                   2324:         ($httpbrowser=~/ux/i) ||
                   2325:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2326:     if (($httpbrowser=~/vax/i) ||
                   2327:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2328:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2329:     if (($httpbrowser=~/mac/i) ||
                   2330:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   2331:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   2332:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
                   2333:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   2334:             $clientunicode,$clientos,);
                   2335: }
                   2336: 
1.32      matthew  2337: ###############################################################
                   2338: ##    Authentication changing form generation subroutines    ##
                   2339: ###############################################################
                   2340: ##
                   2341: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2342: ## hash, and have reasonable default values.
                   2343: ##
                   2344: ##    formname = the name given in the <form> tag.
1.35      matthew  2345: #-------------------------------------------
                   2346: 
1.45      matthew  2347: =pod
                   2348: 
1.112     bowersj2 2349: =head1 Authentication Routines
                   2350: 
                   2351: =over 4
                   2352: 
1.648     raeburn  2353: =item * &authform_xxxxxx()
1.35      matthew  2354: 
                   2355: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2356: handle some of the conveniences required for authentication forms.  
                   2357: This is not an optimal method, but it works.  
                   2358: 
                   2359: =over 4
                   2360: 
1.112     bowersj2 2361: =item * authform_header
1.35      matthew  2362: 
1.112     bowersj2 2363: =item * authform_authorwarning
1.35      matthew  2364: 
1.112     bowersj2 2365: =item * authform_nochange
1.35      matthew  2366: 
1.112     bowersj2 2367: =item * authform_kerberos
1.35      matthew  2368: 
1.112     bowersj2 2369: =item * authform_internal
1.35      matthew  2370: 
1.112     bowersj2 2371: =item * authform_filesystem
1.35      matthew  2372: 
                   2373: =back
                   2374: 
1.648     raeburn  2375: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2376: 
1.35      matthew  2377: =cut
                   2378: 
                   2379: #-------------------------------------------
1.32      matthew  2380: sub authform_header{  
                   2381:     my %in = (
                   2382:         formname => 'cu',
1.80      albertel 2383:         kerb_def_dom => '',
1.32      matthew  2384:         @_,
                   2385:     );
                   2386:     $in{'formname'} = 'document.' . $in{'formname'};
                   2387:     my $result='';
1.80      albertel 2388: 
                   2389: #---------------------------------------------- Code for upper case translation
                   2390:     my $Javascript_toUpperCase;
                   2391:     unless ($in{kerb_def_dom}) {
                   2392:         $Javascript_toUpperCase =<<"END";
                   2393:         switch (choice) {
                   2394:            case 'krb': currentform.elements[choicearg].value =
                   2395:                currentform.elements[choicearg].value.toUpperCase();
                   2396:                break;
                   2397:            default:
                   2398:         }
                   2399: END
                   2400:     } else {
                   2401:         $Javascript_toUpperCase = "";
                   2402:     }
                   2403: 
1.165     raeburn  2404:     my $radioval = "'nochange'";
1.591     raeburn  2405:     if (defined($in{'curr_authtype'})) {
                   2406:         if ($in{'curr_authtype'} ne '') {
                   2407:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2408:         }
1.174     matthew  2409:     }
1.165     raeburn  2410:     my $argfield = 'null';
1.591     raeburn  2411:     if (defined($in{'mode'})) {
1.165     raeburn  2412:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2413:             if (defined($in{'curr_autharg'})) {
                   2414:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2415:                     $argfield = "'$in{'curr_autharg'}'";
                   2416:                 }
                   2417:             }
                   2418:         }
                   2419:     }
                   2420: 
1.32      matthew  2421:     $result.=<<"END";
                   2422: var current = new Object();
1.165     raeburn  2423: current.radiovalue = $radioval;
                   2424: current.argfield = $argfield;
1.32      matthew  2425: 
                   2426: function changed_radio(choice,currentform) {
                   2427:     var choicearg = choice + 'arg';
                   2428:     // If a radio button in changed, we need to change the argfield
                   2429:     if (current.radiovalue != choice) {
                   2430:         current.radiovalue = choice;
                   2431:         if (current.argfield != null) {
                   2432:             currentform.elements[current.argfield].value = '';
                   2433:         }
                   2434:         if (choice == 'nochange') {
                   2435:             current.argfield = null;
                   2436:         } else {
                   2437:             current.argfield = choicearg;
                   2438:             switch(choice) {
                   2439:                 case 'krb': 
                   2440:                     currentform.elements[current.argfield].value = 
                   2441:                         "$in{'kerb_def_dom'}";
                   2442:                 break;
                   2443:               default:
                   2444:                 break;
                   2445:             }
                   2446:         }
                   2447:     }
                   2448:     return;
                   2449: }
1.22      www      2450: 
1.32      matthew  2451: function changed_text(choice,currentform) {
                   2452:     var choicearg = choice + 'arg';
                   2453:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2454:         $Javascript_toUpperCase
1.32      matthew  2455:         // clear old field
                   2456:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2457:             currentform.elements[current.argfield].value = '';
                   2458:         }
                   2459:         current.argfield = choicearg;
                   2460:     }
                   2461:     set_auth_radio_buttons(choice,currentform);
                   2462:     return;
1.20      www      2463: }
1.32      matthew  2464: 
                   2465: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2466:     var numauthchoices = currentform.login.length;
                   2467:     if (typeof numauthchoices  == "undefined") {
                   2468:         return;
                   2469:     } 
1.32      matthew  2470:     var i=0;
1.986     raeburn  2471:     while (i < numauthchoices) {
1.32      matthew  2472:         if (currentform.login[i].value == newvalue) { break; }
                   2473:         i++;
                   2474:     }
1.986     raeburn  2475:     if (i == numauthchoices) {
1.32      matthew  2476:         return;
                   2477:     }
                   2478:     current.radiovalue = newvalue;
                   2479:     currentform.login[i].checked = true;
                   2480:     return;
                   2481: }
                   2482: END
                   2483:     return $result;
                   2484: }
                   2485: 
1.1075.2.20  raeburn  2486: sub authform_authorwarning {
1.32      matthew  2487:     my $result='';
1.144     matthew  2488:     $result='<i>'.
                   2489:         &mt('As a general rule, only authors or co-authors should be '.
                   2490:             'filesystem authenticated '.
                   2491:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2492:     return $result;
                   2493: }
                   2494: 
1.1075.2.20  raeburn  2495: sub authform_nochange {
1.32      matthew  2496:     my %in = (
                   2497:               formname => 'document.cu',
                   2498:               kerb_def_dom => 'MSU.EDU',
                   2499:               @_,
                   2500:           );
1.1075.2.20  raeburn  2501:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); 
1.586     raeburn  2502:     my $result;
1.1075.2.20  raeburn  2503:     if (!$authnum) {
                   2504:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2505:     } else {
                   2506:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2507:                   '<input type="radio" name="login" value="nochange" '.
                   2508:                   'checked="checked" onclick="'.
1.281     albertel 2509:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2510: 	    '</label>';
1.586     raeburn  2511:     }
1.32      matthew  2512:     return $result;
                   2513: }
                   2514: 
1.591     raeburn  2515: sub authform_kerberos {
1.32      matthew  2516:     my %in = (
                   2517:               formname => 'document.cu',
                   2518:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2519:               kerb_def_auth => 'krb4',
1.32      matthew  2520:               @_,
                   2521:               );
1.586     raeburn  2522:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2523:         $autharg,$jscall);
1.1075.2.20  raeburn  2524:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2525:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2526:        $check5 = ' checked="checked"';
1.80      albertel 2527:     } else {
1.772     bisitz   2528:        $check4 = ' checked="checked"';
1.80      albertel 2529:     }
1.165     raeburn  2530:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2531:     if (defined($in{'curr_authtype'})) {
                   2532:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2533:             $krbcheck = ' checked="checked"';
1.623     raeburn  2534:             if (defined($in{'mode'})) {
                   2535:                 if ($in{'mode'} eq 'modifyuser') {
                   2536:                     $krbcheck = '';
                   2537:                 }
                   2538:             }
1.591     raeburn  2539:             if (defined($in{'curr_kerb_ver'})) {
                   2540:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2541:                     $check5 = ' checked="checked"';
1.591     raeburn  2542:                     $check4 = '';
                   2543:                 } else {
1.772     bisitz   2544:                     $check4 = ' checked="checked"';
1.591     raeburn  2545:                     $check5 = '';
                   2546:                 }
1.586     raeburn  2547:             }
1.591     raeburn  2548:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2549:                 $krbarg = $in{'curr_autharg'};
                   2550:             }
1.586     raeburn  2551:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2552:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2553:                     $result = 
                   2554:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2555:         $in{'curr_autharg'},$krbver);
                   2556:                 } else {
                   2557:                     $result =
                   2558:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2559:                 }
                   2560:                 return $result; 
                   2561:             }
                   2562:         }
                   2563:     } else {
                   2564:         if ($authnum == 1) {
1.784     bisitz   2565:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2566:         }
                   2567:     }
1.586     raeburn  2568:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2569:         return;
1.587     raeburn  2570:     } elsif ($authtype eq '') {
1.591     raeburn  2571:         if (defined($in{'mode'})) {
1.587     raeburn  2572:             if ($in{'mode'} eq 'modifycourse') {
                   2573:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2574:                     $authtype = '<input type="radio" name="login" value="krb" />';
1.587     raeburn  2575:                 }
                   2576:             }
                   2577:         }
1.586     raeburn  2578:     }
                   2579:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2580:     if ($authtype eq '') {
                   2581:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2582:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2583:                     $krbcheck.' />';
                   2584:     }
                   2585:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20  raeburn  2586:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2587:          $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20  raeburn  2588:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2589:          $in{'curr_authtype'} eq 'krb4')) {
                   2590:         $result .= &mt
1.144     matthew  2591:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2592:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2593:          '<label>'.$authtype,
1.281     albertel 2594:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2595:              'value="'.$krbarg.'" '.
1.144     matthew  2596:              'onchange="'.$jscall.'" />',
1.281     albertel 2597:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2598:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2599: 	 '</label>');
1.586     raeburn  2600:     } elsif ($can_assign{'krb4'}) {
                   2601:         $result .= &mt
                   2602:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2603:          '[_3] Version 4 [_4]',
                   2604:          '<label>'.$authtype,
                   2605:          '</label><input type="text" size="10" name="krbarg" '.
                   2606:              'value="'.$krbarg.'" '.
                   2607:              'onchange="'.$jscall.'" />',
                   2608:          '<label><input type="hidden" name="krbver" value="4" />',
                   2609:          '</label>');
                   2610:     } elsif ($can_assign{'krb5'}) {
                   2611:         $result .= &mt
                   2612:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2613:          '[_3] Version 5 [_4]',
                   2614:          '<label>'.$authtype,
                   2615:          '</label><input type="text" size="10" name="krbarg" '.
                   2616:              'value="'.$krbarg.'" '.
                   2617:              'onchange="'.$jscall.'" />',
                   2618:          '<label><input type="hidden" name="krbver" value="5" />',
                   2619:          '</label>');
                   2620:     }
1.32      matthew  2621:     return $result;
                   2622: }
                   2623: 
1.1075.2.20  raeburn  2624: sub authform_internal {
1.586     raeburn  2625:     my %in = (
1.32      matthew  2626:                 formname => 'document.cu',
                   2627:                 kerb_def_dom => 'MSU.EDU',
                   2628:                 @_,
                   2629:                 );
1.586     raeburn  2630:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2631:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2632:     if (defined($in{'curr_authtype'})) {
                   2633:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2634:             if ($can_assign{'int'}) {
1.772     bisitz   2635:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2636:                 if (defined($in{'mode'})) {
                   2637:                     if ($in{'mode'} eq 'modifyuser') {
                   2638:                         $intcheck = '';
                   2639:                     }
                   2640:                 }
1.591     raeburn  2641:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2642:                     $intarg = $in{'curr_autharg'};
                   2643:                 }
                   2644:             } else {
                   2645:                 $result = &mt('Currently internally authenticated.');
                   2646:                 return $result;
1.165     raeburn  2647:             }
                   2648:         }
1.586     raeburn  2649:     } else {
                   2650:         if ($authnum == 1) {
1.784     bisitz   2651:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2652:         }
                   2653:     }
                   2654:     if (!$can_assign{'int'}) {
                   2655:         return;
1.587     raeburn  2656:     } elsif ($authtype eq '') {
1.591     raeburn  2657:         if (defined($in{'mode'})) {
1.587     raeburn  2658:             if ($in{'mode'} eq 'modifycourse') {
                   2659:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2660:                     $authtype = '<input type="radio" name="login" value="int" />';
1.587     raeburn  2661:                 }
                   2662:             }
                   2663:         }
1.165     raeburn  2664:     }
1.586     raeburn  2665:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2666:     if ($authtype eq '') {
                   2667:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2668:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2669:     }
1.605     bisitz   2670:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2671:                $intarg.'" onchange="'.$jscall.'" />';
                   2672:     $result = &mt
1.144     matthew  2673:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2674:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2675:     $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  2676:     return $result;
                   2677: }
                   2678: 
1.1075.2.20  raeburn  2679: sub authform_local {
1.32      matthew  2680:     my %in = (
                   2681:               formname => 'document.cu',
                   2682:               kerb_def_dom => 'MSU.EDU',
                   2683:               @_,
                   2684:               );
1.586     raeburn  2685:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2686:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2687:     if (defined($in{'curr_authtype'})) {
                   2688:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2689:             if ($can_assign{'loc'}) {
1.772     bisitz   2690:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2691:                 if (defined($in{'mode'})) {
                   2692:                     if ($in{'mode'} eq 'modifyuser') {
                   2693:                         $loccheck = '';
                   2694:                     }
                   2695:                 }
1.591     raeburn  2696:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2697:                     $locarg = $in{'curr_autharg'};
                   2698:                 }
                   2699:             } else {
                   2700:                 $result = &mt('Currently using local (institutional) authentication.');
                   2701:                 return $result;
1.165     raeburn  2702:             }
                   2703:         }
1.586     raeburn  2704:     } else {
                   2705:         if ($authnum == 1) {
1.784     bisitz   2706:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2707:         }
                   2708:     }
                   2709:     if (!$can_assign{'loc'}) {
                   2710:         return;
1.587     raeburn  2711:     } elsif ($authtype eq '') {
1.591     raeburn  2712:         if (defined($in{'mode'})) {
1.587     raeburn  2713:             if ($in{'mode'} eq 'modifycourse') {
                   2714:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2715:                     $authtype = '<input type="radio" name="login" value="loc" />';
1.587     raeburn  2716:                 }
                   2717:             }
                   2718:         }
1.165     raeburn  2719:     }
1.586     raeburn  2720:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2721:     if ($authtype eq '') {
                   2722:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2723:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2724:                     $jscall.'" />';
                   2725:     }
                   2726:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2727:                $locarg.'" onchange="'.$jscall.'" />';
                   2728:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2729:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2730:     return $result;
                   2731: }
                   2732: 
1.1075.2.20  raeburn  2733: sub authform_filesystem {
1.32      matthew  2734:     my %in = (
                   2735:               formname => 'document.cu',
                   2736:               kerb_def_dom => 'MSU.EDU',
                   2737:               @_,
                   2738:               );
1.586     raeburn  2739:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2740:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2741:     if (defined($in{'curr_authtype'})) {
                   2742:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2743:             if ($can_assign{'fsys'}) {
1.772     bisitz   2744:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2745:                 if (defined($in{'mode'})) {
                   2746:                     if ($in{'mode'} eq 'modifyuser') {
                   2747:                         $fsyscheck = '';
                   2748:                     }
                   2749:                 }
1.586     raeburn  2750:             } else {
                   2751:                 $result = &mt('Currently Filesystem Authenticated.');
                   2752:                 return $result;
                   2753:             }           
                   2754:         }
                   2755:     } else {
                   2756:         if ($authnum == 1) {
1.784     bisitz   2757:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2758:         }
                   2759:     }
                   2760:     if (!$can_assign{'fsys'}) {
                   2761:         return;
1.587     raeburn  2762:     } elsif ($authtype eq '') {
1.591     raeburn  2763:         if (defined($in{'mode'})) {
1.587     raeburn  2764:             if ($in{'mode'} eq 'modifycourse') {
                   2765:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2766:                     $authtype = '<input type="radio" name="login" value="fsys" />';
1.587     raeburn  2767:                 }
                   2768:             }
                   2769:         }
1.586     raeburn  2770:     }
                   2771:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2772:     if ($authtype eq '') {
                   2773:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2774:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2775:                     $jscall.'" />';
                   2776:     }
                   2777:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2778:                ' onchange="'.$jscall.'" />';
                   2779:     $result = &mt
1.144     matthew  2780:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2781:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2782:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2783:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2784:                   'onchange="'.$jscall.'" />');
1.32      matthew  2785:     return $result;
                   2786: }
                   2787: 
1.586     raeburn  2788: sub get_assignable_auth {
                   2789:     my ($dom) = @_;
                   2790:     if ($dom eq '') {
                   2791:         $dom = $env{'request.role.domain'};
                   2792:     }
                   2793:     my %can_assign = (
                   2794:                           krb4 => 1,
                   2795:                           krb5 => 1,
                   2796:                           int  => 1,
                   2797:                           loc  => 1,
                   2798:                      );
                   2799:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2800:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2801:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2802:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2803:             my $context;
                   2804:             if ($env{'request.role'} =~ /^au/) {
                   2805:                 $context = 'author';
                   2806:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2807:                 $context = 'domain';
                   2808:             } elsif ($env{'request.course.id'}) {
                   2809:                 $context = 'course';
                   2810:             }
                   2811:             if ($context) {
                   2812:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2813:                    %can_assign = %{$authhash->{$context}}; 
                   2814:                 }
                   2815:             }
                   2816:         }
                   2817:     }
                   2818:     my $authnum = 0;
                   2819:     foreach my $key (keys(%can_assign)) {
                   2820:         if ($can_assign{$key}) {
                   2821:             $authnum ++;
                   2822:         }
                   2823:     }
                   2824:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2825:         $authnum --;
                   2826:     }
                   2827:     return ($authnum,%can_assign);
                   2828: }
                   2829: 
1.80      albertel 2830: ###############################################################
                   2831: ##    Get Kerberos Defaults for Domain                 ##
                   2832: ###############################################################
                   2833: ##
                   2834: ## Returns default kerberos version and an associated argument
                   2835: ## as listed in file domain.tab. If not listed, provides
                   2836: ## appropriate default domain and kerberos version.
                   2837: ##
                   2838: #-------------------------------------------
                   2839: 
                   2840: =pod
                   2841: 
1.648     raeburn  2842: =item * &get_kerberos_defaults()
1.80      albertel 2843: 
                   2844: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2845: version and domain. If not found, it defaults to version 4 and the 
                   2846: domain of the server.
1.80      albertel 2847: 
1.648     raeburn  2848: =over 4
                   2849: 
1.80      albertel 2850: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2851: 
1.648     raeburn  2852: =back
                   2853: 
                   2854: =back
                   2855: 
1.80      albertel 2856: =cut
                   2857: 
                   2858: #-------------------------------------------
                   2859: sub get_kerberos_defaults {
                   2860:     my $domain=shift;
1.641     raeburn  2861:     my ($krbdef,$krbdefdom);
                   2862:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2863:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2864:         $krbdef = $domdefaults{'auth_def'};
                   2865:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2866:     } else {
1.80      albertel 2867:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2868:         my $krbdefdom=$1;
                   2869:         $krbdefdom=~tr/a-z/A-Z/;
                   2870:         $krbdef = "krb4";
                   2871:     }
                   2872:     return ($krbdef,$krbdefdom);
                   2873: }
1.112     bowersj2 2874: 
1.32      matthew  2875: 
1.46      matthew  2876: ###############################################################
                   2877: ##                Thesaurus Functions                        ##
                   2878: ###############################################################
1.20      www      2879: 
1.46      matthew  2880: =pod
1.20      www      2881: 
1.112     bowersj2 2882: =head1 Thesaurus Functions
                   2883: 
                   2884: =over 4
                   2885: 
1.648     raeburn  2886: =item * &initialize_keywords()
1.46      matthew  2887: 
                   2888: Initializes the package variable %Keywords if it is empty.  Uses the
                   2889: package variable $thesaurus_db_file.
                   2890: 
                   2891: =cut
                   2892: 
                   2893: ###################################################
                   2894: 
                   2895: sub initialize_keywords {
                   2896:     return 1 if (scalar keys(%Keywords));
                   2897:     # If we are here, %Keywords is empty, so fill it up
                   2898:     #   Make sure the file we need exists...
                   2899:     if (! -e $thesaurus_db_file) {
                   2900:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2901:                                  " failed because it does not exist");
                   2902:         return 0;
                   2903:     }
                   2904:     #   Set up the hash as a database
                   2905:     my %thesaurus_db;
                   2906:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2907:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2908:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2909:                                  $thesaurus_db_file);
                   2910:         return 0;
                   2911:     } 
                   2912:     #  Get the average number of appearances of a word.
                   2913:     my $avecount = $thesaurus_db{'average.count'};
                   2914:     #  Put keywords (those that appear > average) into %Keywords
                   2915:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2916:         my ($count,undef) = split /:/,$data;
                   2917:         $Keywords{$word}++ if ($count > $avecount);
                   2918:     }
                   2919:     untie %thesaurus_db;
                   2920:     # Remove special values from %Keywords.
1.356     albertel 2921:     foreach my $value ('total.count','average.count') {
                   2922:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2923:   }
1.46      matthew  2924:     return 1;
                   2925: }
                   2926: 
                   2927: ###################################################
                   2928: 
                   2929: =pod
                   2930: 
1.648     raeburn  2931: =item * &keyword($word)
1.46      matthew  2932: 
                   2933: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   2934: than the average number of times in the thesaurus database.  Calls 
                   2935: &initialize_keywords
                   2936: 
                   2937: =cut
                   2938: 
                   2939: ###################################################
1.20      www      2940: 
                   2941: sub keyword {
1.46      matthew  2942:     return if (!&initialize_keywords());
                   2943:     my $word=lc(shift());
                   2944:     $word=~s/\W//g;
                   2945:     return exists($Keywords{$word});
1.20      www      2946: }
1.46      matthew  2947: 
                   2948: ###############################################################
                   2949: 
                   2950: =pod 
1.20      www      2951: 
1.648     raeburn  2952: =item * &get_related_words()
1.46      matthew  2953: 
1.160     matthew  2954: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  2955: an array of words.  If the keyword is not in the thesaurus, an empty array
                   2956: will be returned.  The order of the words returned is determined by the
                   2957: database which holds them.
                   2958: 
                   2959: Uses global $thesaurus_db_file.
                   2960: 
1.1057    foxr     2961: 
1.46      matthew  2962: =cut
                   2963: 
                   2964: ###############################################################
                   2965: sub get_related_words {
                   2966:     my $keyword = shift;
                   2967:     my %thesaurus_db;
                   2968:     if (! -e $thesaurus_db_file) {
                   2969:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   2970:                                  "failed because the file does not exist");
                   2971:         return ();
                   2972:     }
                   2973:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2974:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2975:         return ();
                   2976:     } 
                   2977:     my @Words=();
1.429     www      2978:     my $count=0;
1.46      matthew  2979:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 2980: 	# The first element is the number of times
                   2981: 	# the word appears.  We do not need it now.
1.429     www      2982: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   2983: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   2984: 	my $threshold=$mostfrequentcount/10;
                   2985:         foreach my $possibleword (@RelatedWords) {
                   2986:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   2987:             if ($wordcount>$threshold) {
                   2988: 		push(@Words,$word);
                   2989:                 $count++;
                   2990:                 if ($count>10) { last; }
                   2991: 	    }
1.20      www      2992:         }
                   2993:     }
1.46      matthew  2994:     untie %thesaurus_db;
                   2995:     return @Words;
1.14      harris41 2996: }
1.46      matthew  2997: 
1.112     bowersj2 2998: =pod
                   2999: 
                   3000: =back
                   3001: 
                   3002: =cut
1.61      www      3003: 
                   3004: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3005: =pod
                   3006: 
1.112     bowersj2 3007: =head1 User Name Functions
                   3008: 
                   3009: =over 4
                   3010: 
1.648     raeburn  3011: =item * &plainname($uname,$udom,$first)
1.81      albertel 3012: 
1.112     bowersj2 3013: Takes a users logon name and returns it as a string in
1.226     albertel 3014: "first middle last generation" form 
                   3015: if $first is set to 'lastname' then it returns it as
                   3016: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3017: 
                   3018: =cut
1.61      www      3019: 
1.295     www      3020: 
1.81      albertel 3021: ###############################################################
1.61      www      3022: sub plainname {
1.226     albertel 3023:     my ($uname,$udom,$first)=@_;
1.537     albertel 3024:     return if (!defined($uname) || !defined($udom));
1.295     www      3025:     my %names=&getnames($uname,$udom);
1.226     albertel 3026:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3027: 					  $names{'middlename'},
                   3028: 					  $names{'lastname'},
                   3029: 					  $names{'generation'},$first);
                   3030:     $name=~s/^\s+//;
1.62      www      3031:     $name=~s/\s+$//;
                   3032:     $name=~s/\s+/ /g;
1.353     albertel 3033:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3034:     return $name;
1.61      www      3035: }
1.66      www      3036: 
                   3037: # -------------------------------------------------------------------- Nickname
1.81      albertel 3038: =pod
                   3039: 
1.648     raeburn  3040: =item * &nickname($uname,$udom)
1.81      albertel 3041: 
                   3042: Gets a users name and returns it as a string as
                   3043: 
                   3044: "&quot;nickname&quot;"
1.66      www      3045: 
1.81      albertel 3046: if the user has a nickname or
                   3047: 
                   3048: "first middle last generation"
                   3049: 
                   3050: if the user does not
                   3051: 
                   3052: =cut
1.66      www      3053: 
                   3054: sub nickname {
                   3055:     my ($uname,$udom)=@_;
1.537     albertel 3056:     return if (!defined($uname) || !defined($udom));
1.295     www      3057:     my %names=&getnames($uname,$udom);
1.68      albertel 3058:     my $name=$names{'nickname'};
1.66      www      3059:     if ($name) {
                   3060:        $name='&quot;'.$name.'&quot;'; 
                   3061:     } else {
                   3062:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3063: 	     $names{'lastname'}.' '.$names{'generation'};
                   3064:        $name=~s/\s+$//;
                   3065:        $name=~s/\s+/ /g;
                   3066:     }
                   3067:     return $name;
                   3068: }
                   3069: 
1.295     www      3070: sub getnames {
                   3071:     my ($uname,$udom)=@_;
1.537     albertel 3072:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3073:     if ($udom eq 'public' && $uname eq 'public') {
                   3074: 	return ('lastname' => &mt('Public'));
                   3075:     }
1.295     www      3076:     my $id=$uname.':'.$udom;
                   3077:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3078:     if ($cached) {
                   3079: 	return %{$names};
                   3080:     } else {
                   3081: 	my %loadnames=&Apache::lonnet::get('environment',
                   3082:                     ['firstname','middlename','lastname','generation','nickname'],
                   3083: 					 $udom,$uname);
                   3084: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3085: 	return %loadnames;
                   3086:     }
                   3087: }
1.61      www      3088: 
1.542     raeburn  3089: # -------------------------------------------------------------------- getemails
1.648     raeburn  3090: 
1.542     raeburn  3091: =pod
                   3092: 
1.648     raeburn  3093: =item * &getemails($uname,$udom)
1.542     raeburn  3094: 
                   3095: Gets a user's email information and returns it as a hash with keys:
                   3096: notification, critnotification, permanentemail
                   3097: 
                   3098: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3099: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3100:  
1.648     raeburn  3101: 
1.542     raeburn  3102: =cut
                   3103: 
1.648     raeburn  3104: 
1.466     albertel 3105: sub getemails {
                   3106:     my ($uname,$udom)=@_;
                   3107:     if ($udom eq 'public' && $uname eq 'public') {
                   3108: 	return;
                   3109:     }
1.467     www      3110:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3111:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3112:     my $id=$uname.':'.$udom;
                   3113:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3114:     if ($cached) {
                   3115: 	return %{$names};
                   3116:     } else {
                   3117: 	my %loadnames=&Apache::lonnet::get('environment',
                   3118:                     			   ['notification','critnotification',
                   3119: 					    'permanentemail'],
                   3120: 					   $udom,$uname);
                   3121: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3122: 	return %loadnames;
                   3123:     }
                   3124: }
                   3125: 
1.551     albertel 3126: sub flush_email_cache {
                   3127:     my ($uname,$udom)=@_;
                   3128:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3129:     if (!$uname) { $uname=$env{'user.name'};   }
                   3130:     return if ($udom eq 'public' && $uname eq 'public');
                   3131:     my $id=$uname.':'.$udom;
                   3132:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3133: }
                   3134: 
1.728     raeburn  3135: # -------------------------------------------------------------------- getlangs
                   3136: 
                   3137: =pod
                   3138: 
                   3139: =item * &getlangs($uname,$udom)
                   3140: 
                   3141: Gets a user's language preference and returns it as a hash with key:
                   3142: language.
                   3143: 
                   3144: =cut
                   3145: 
                   3146: 
                   3147: sub getlangs {
                   3148:     my ($uname,$udom) = @_;
                   3149:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3150:     if (!$uname) { $uname=$env{'user.name'};   }
                   3151:     my $id=$uname.':'.$udom;
                   3152:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3153:     if ($cached) {
                   3154:         return %{$langs};
                   3155:     } else {
                   3156:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3157:                                            $udom,$uname);
                   3158:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3159:         return %loadlangs;
                   3160:     }
                   3161: }
                   3162: 
                   3163: sub flush_langs_cache {
                   3164:     my ($uname,$udom)=@_;
                   3165:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3166:     if (!$uname) { $uname=$env{'user.name'};   }
                   3167:     return if ($udom eq 'public' && $uname eq 'public');
                   3168:     my $id=$uname.':'.$udom;
                   3169:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3170: }
                   3171: 
1.61      www      3172: # ------------------------------------------------------------------ Screenname
1.81      albertel 3173: 
                   3174: =pod
                   3175: 
1.648     raeburn  3176: =item * &screenname($uname,$udom)
1.81      albertel 3177: 
                   3178: Gets a users screenname and returns it as a string
                   3179: 
                   3180: =cut
1.61      www      3181: 
                   3182: sub screenname {
                   3183:     my ($uname,$udom)=@_;
1.258     albertel 3184:     if ($uname eq $env{'user.name'} &&
                   3185: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3186:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3187:     return $names{'screenname'};
1.62      www      3188: }
                   3189: 
1.212     albertel 3190: 
1.802     bisitz   3191: # ------------------------------------------------------------- Confirm Wrapper
                   3192: =pod
                   3193: 
                   3194: =item confirmwrapper
                   3195: 
                   3196: Wrap messages about completion of operation in box
                   3197: 
                   3198: =cut
                   3199: 
                   3200: sub confirmwrapper {
                   3201:     my ($message)=@_;
                   3202:     if ($message) {
                   3203:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3204:                .$message."\n"
                   3205:                .'</div>'."\n";
                   3206:     } else {
                   3207:         return $message;
                   3208:     }
                   3209: }
                   3210: 
1.62      www      3211: # ------------------------------------------------------------- Message Wrapper
                   3212: 
                   3213: sub messagewrapper {
1.369     www      3214:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3215:     return 
1.441     albertel 3216:         '<a href="/adm/email?compose=individual&amp;'.
                   3217:         'recname='.$username.'&amp;recdom='.$domain.
                   3218: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3219:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3220: }
1.802     bisitz   3221: 
1.74      www      3222: # --------------------------------------------------------------- Notes Wrapper
                   3223: 
                   3224: sub noteswrapper {
                   3225:     my ($link,$un,$do)=@_;
                   3226:     return 
1.896     amueller 3227: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3228: }
1.802     bisitz   3229: 
1.62      www      3230: # ------------------------------------------------------------- Aboutme Wrapper
                   3231: 
                   3232: sub aboutmewrapper {
1.1070    raeburn  3233:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3234:     if (!defined($username)  && !defined($domain)) {
                   3235:         return;
                   3236:     }
1.1075.2.15  raeburn  3237:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3238: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3239: }
                   3240: 
                   3241: # ------------------------------------------------------------ Syllabus Wrapper
                   3242: 
                   3243: sub syllabuswrapper {
1.707     bisitz   3244:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3245:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3246: }
1.14      harris41 3247: 
1.802     bisitz   3248: # -----------------------------------------------------------------------------
                   3249: 
1.208     matthew  3250: sub track_student_link {
1.887     raeburn  3251:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3252:     my $link ="/adm/trackstudent?";
1.208     matthew  3253:     my $title = 'View recent activity';
                   3254:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3255:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3256:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3257:         $title .= ' of this student';
1.268     albertel 3258:     } 
1.208     matthew  3259:     if (defined($target) && $target !~ /^\s*$/) {
                   3260:         $target = qq{target="$target"};
                   3261:     } else {
                   3262:         $target = '';
                   3263:     }
1.268     albertel 3264:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3265:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3266:     $title = &mt($title);
                   3267:     $linktext = &mt($linktext);
1.448     albertel 3268:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3269: 	&help_open_topic('View_recent_activity');
1.208     matthew  3270: }
                   3271: 
1.781     raeburn  3272: sub slot_reservations_link {
                   3273:     my ($linktext,$sname,$sdom,$target) = @_;
                   3274:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3275:     my $title = 'View slot reservation history';
                   3276:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3277:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3278:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3279:         $title .= ' of this student';
                   3280:     }
                   3281:     if (defined($target) && $target !~ /^\s*$/) {
                   3282:         $target = qq{target="$target"};
                   3283:     } else {
                   3284:         $target = '';
                   3285:     }
                   3286:     $title = &mt($title);
                   3287:     $linktext = &mt($linktext);
                   3288:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3289: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3290: 
                   3291: }
                   3292: 
1.508     www      3293: # ===================================================== Display a student photo
                   3294: 
                   3295: 
1.509     albertel 3296: sub student_image_tag {
1.508     www      3297:     my ($domain,$user)=@_;
                   3298:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3299:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3300: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3301:     } else {
                   3302: 	return '';
                   3303:     }
                   3304: }
                   3305: 
1.112     bowersj2 3306: =pod
                   3307: 
                   3308: =back
                   3309: 
                   3310: =head1 Access .tab File Data
                   3311: 
                   3312: =over 4
                   3313: 
1.648     raeburn  3314: =item * &languageids() 
1.112     bowersj2 3315: 
                   3316: returns list of all language ids
                   3317: 
                   3318: =cut
                   3319: 
1.14      harris41 3320: sub languageids {
1.16      harris41 3321:     return sort(keys(%language));
1.14      harris41 3322: }
                   3323: 
1.112     bowersj2 3324: =pod
                   3325: 
1.648     raeburn  3326: =item * &languagedescription() 
1.112     bowersj2 3327: 
                   3328: returns description of a specified language id
                   3329: 
                   3330: =cut
                   3331: 
1.14      harris41 3332: sub languagedescription {
1.125     www      3333:     my $code=shift;
                   3334:     return  ($supported_language{$code}?'* ':'').
                   3335:             $language{$code}.
1.126     www      3336: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3337: }
                   3338: 
1.1048    foxr     3339: =pod
                   3340: 
                   3341: =item * &plainlanguagedescription
                   3342: 
                   3343: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3344: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3345: 
                   3346: =cut
                   3347: 
1.145     www      3348: sub plainlanguagedescription {
                   3349:     my $code=shift;
                   3350:     return $language{$code};
                   3351: }
                   3352: 
1.1048    foxr     3353: =pod
                   3354: 
                   3355: =item * &supportedlanguagecode
                   3356: 
                   3357: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3358: code.
                   3359: 
                   3360: =cut
                   3361: 
1.145     www      3362: sub supportedlanguagecode {
                   3363:     my $code=shift;
                   3364:     return $supported_language{$code};
1.97      www      3365: }
                   3366: 
1.112     bowersj2 3367: =pod
                   3368: 
1.1048    foxr     3369: =item * &latexlanguage()
                   3370: 
                   3371: Given a language key code returns the correspondnig language to use
                   3372: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3373: is no supported hyphenation for the language code.
                   3374: 
                   3375: =cut
                   3376: 
                   3377: sub latexlanguage {
                   3378:     my $code = shift;
                   3379:     return $latex_language{$code};
                   3380: }
                   3381: 
                   3382: =pod
                   3383: 
                   3384: =item * &latexhyphenation()
                   3385: 
                   3386: Same as above but what's supplied is the language as it might be stored
                   3387: in the metadata.
                   3388: 
                   3389: =cut
                   3390: 
                   3391: sub latexhyphenation {
                   3392:     my $key = shift;
                   3393:     return $latex_language_bykey{$key};
                   3394: }
                   3395: 
                   3396: =pod
                   3397: 
1.648     raeburn  3398: =item * &copyrightids() 
1.112     bowersj2 3399: 
                   3400: returns list of all copyrights
                   3401: 
                   3402: =cut
                   3403: 
                   3404: sub copyrightids {
                   3405:     return sort(keys(%cprtag));
                   3406: }
                   3407: 
                   3408: =pod
                   3409: 
1.648     raeburn  3410: =item * &copyrightdescription() 
1.112     bowersj2 3411: 
                   3412: returns description of a specified copyright id
                   3413: 
                   3414: =cut
                   3415: 
                   3416: sub copyrightdescription {
1.166     www      3417:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3418: }
1.197     matthew  3419: 
                   3420: =pod
                   3421: 
1.648     raeburn  3422: =item * &source_copyrightids() 
1.192     taceyjo1 3423: 
                   3424: returns list of all source copyrights
                   3425: 
                   3426: =cut
                   3427: 
                   3428: sub source_copyrightids {
                   3429:     return sort(keys(%scprtag));
                   3430: }
                   3431: 
                   3432: =pod
                   3433: 
1.648     raeburn  3434: =item * &source_copyrightdescription() 
1.192     taceyjo1 3435: 
                   3436: returns description of a specified source copyright id
                   3437: 
                   3438: =cut
                   3439: 
                   3440: sub source_copyrightdescription {
                   3441:     return &mt($scprtag{shift(@_)});
                   3442: }
1.112     bowersj2 3443: 
                   3444: =pod
                   3445: 
1.648     raeburn  3446: =item * &filecategories() 
1.112     bowersj2 3447: 
                   3448: returns list of all file categories
                   3449: 
                   3450: =cut
                   3451: 
                   3452: sub filecategories {
                   3453:     return sort(keys(%category_extensions));
                   3454: }
                   3455: 
                   3456: =pod
                   3457: 
1.648     raeburn  3458: =item * &filecategorytypes() 
1.112     bowersj2 3459: 
                   3460: returns list of file types belonging to a given file
                   3461: category
                   3462: 
                   3463: =cut
                   3464: 
                   3465: sub filecategorytypes {
1.356     albertel 3466:     my ($cat) = @_;
                   3467:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3468: }
                   3469: 
                   3470: =pod
                   3471: 
1.648     raeburn  3472: =item * &fileembstyle() 
1.112     bowersj2 3473: 
                   3474: returns embedding style for a specified file type
                   3475: 
                   3476: =cut
                   3477: 
                   3478: sub fileembstyle {
                   3479:     return $fe{lc(shift(@_))};
1.169     www      3480: }
                   3481: 
1.351     www      3482: sub filemimetype {
                   3483:     return $fm{lc(shift(@_))};
                   3484: }
                   3485: 
1.169     www      3486: 
                   3487: sub filecategoryselect {
                   3488:     my ($name,$value)=@_;
1.189     matthew  3489:     return &select_form($value,$name,
1.970     raeburn  3490:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3491: }
                   3492: 
                   3493: =pod
                   3494: 
1.648     raeburn  3495: =item * &filedescription() 
1.112     bowersj2 3496: 
                   3497: returns description for a specified file type
                   3498: 
                   3499: =cut
                   3500: 
                   3501: sub filedescription {
1.188     matthew  3502:     my $file_description = $fd{lc(shift())};
                   3503:     $file_description =~ s:([\[\]]):~$1:g;
                   3504:     return &mt($file_description);
1.112     bowersj2 3505: }
                   3506: 
                   3507: =pod
                   3508: 
1.648     raeburn  3509: =item * &filedescriptionex() 
1.112     bowersj2 3510: 
                   3511: returns description for a specified file type with
                   3512: extra formatting
                   3513: 
                   3514: =cut
                   3515: 
                   3516: sub filedescriptionex {
                   3517:     my $ex=shift;
1.188     matthew  3518:     my $file_description = $fd{lc($ex)};
                   3519:     $file_description =~ s:([\[\]]):~$1:g;
                   3520:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3521: }
                   3522: 
                   3523: # End of .tab access
                   3524: =pod
                   3525: 
                   3526: =back
                   3527: 
                   3528: =cut
                   3529: 
                   3530: # ------------------------------------------------------------------ File Types
                   3531: sub fileextensions {
                   3532:     return sort(keys(%fe));
                   3533: }
                   3534: 
1.97      www      3535: # ----------------------------------------------------------- Display Languages
                   3536: # returns a hash with all desired display languages
                   3537: #
                   3538: 
                   3539: sub display_languages {
                   3540:     my %languages=();
1.695     raeburn  3541:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3542: 	$languages{$lang}=1;
1.97      www      3543:     }
                   3544:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3545:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3546: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3547: 	    $languages{$lang}=1;
1.97      www      3548:         }
                   3549:     }
                   3550:     return %languages;
1.14      harris41 3551: }
                   3552: 
1.582     albertel 3553: sub languages {
                   3554:     my ($possible_langs) = @_;
1.695     raeburn  3555:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3556:     if (!ref($possible_langs)) {
                   3557: 	if( wantarray ) {
                   3558: 	    return @preferred_langs;
                   3559: 	} else {
                   3560: 	    return $preferred_langs[0];
                   3561: 	}
                   3562:     }
                   3563:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3564:     my @preferred_possibilities;
                   3565:     foreach my $preferred_lang (@preferred_langs) {
                   3566: 	if (exists($possibilities{$preferred_lang})) {
                   3567: 	    push(@preferred_possibilities, $preferred_lang);
                   3568: 	}
                   3569:     }
                   3570:     if( wantarray ) {
                   3571: 	return @preferred_possibilities;
                   3572:     }
                   3573:     return $preferred_possibilities[0];
                   3574: }
                   3575: 
1.742     raeburn  3576: sub user_lang {
                   3577:     my ($touname,$toudom,$fromcid) = @_;
                   3578:     my @userlangs;
                   3579:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3580:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3581:                     $env{'course.'.$fromcid.'.languages'}));
                   3582:     } else {
                   3583:         my %langhash = &getlangs($touname,$toudom);
                   3584:         if ($langhash{'languages'} ne '') {
                   3585:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3586:         } else {
                   3587:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3588:             if ($domdefs{'lang_def'} ne '') {
                   3589:                 @userlangs = ($domdefs{'lang_def'});
                   3590:             }
                   3591:         }
                   3592:     }
                   3593:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3594:     my $user_lh = Apache::localize->get_handle(@languages);
                   3595:     return $user_lh;
                   3596: }
                   3597: 
                   3598: 
1.112     bowersj2 3599: ###############################################################
                   3600: ##               Student Answer Attempts                     ##
                   3601: ###############################################################
                   3602: 
                   3603: =pod
                   3604: 
                   3605: =head1 Alternate Problem Views
                   3606: 
                   3607: =over 4
                   3608: 
1.648     raeburn  3609: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3610:     $getattempt, $regexp, $gradesub)
                   3611: 
                   3612: Return string with previous attempt on problem. Arguments:
                   3613: 
                   3614: =over 4
                   3615: 
                   3616: =item * $symb: Problem, including path
                   3617: 
                   3618: =item * $username: username of the desired student
                   3619: 
                   3620: =item * $domain: domain of the desired student
1.14      harris41 3621: 
1.112     bowersj2 3622: =item * $course: Course ID
1.14      harris41 3623: 
1.112     bowersj2 3624: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3625:     something
1.14      harris41 3626: 
1.112     bowersj2 3627: =item * $regexp: if string matches this regexp, the string will be
                   3628:     sent to $gradesub
1.14      harris41 3629: 
1.112     bowersj2 3630: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3631: 
1.112     bowersj2 3632: =back
1.14      harris41 3633: 
1.112     bowersj2 3634: The output string is a table containing all desired attempts, if any.
1.16      harris41 3635: 
1.112     bowersj2 3636: =cut
1.1       albertel 3637: 
                   3638: sub get_previous_attempt {
1.43      ng       3639:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3640:   my $prevattempts='';
1.43      ng       3641:   no strict 'refs';
1.1       albertel 3642:   if ($symb) {
1.3       albertel 3643:     my (%returnhash)=
                   3644:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3645:     if ($returnhash{'version'}) {
                   3646:       my %lasthash=();
                   3647:       my $version;
                   3648:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3649:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3650: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3651:         }
1.1       albertel 3652:       }
1.596     albertel 3653:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3654:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3655:       my (%typeparts,%lasthidden);
1.945     raeburn  3656:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3657:       foreach my $key (sort(keys(%lasthash))) {
                   3658: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3659: 	if ($#parts > 0) {
1.31      albertel 3660: 	  my $data=$parts[-1];
1.989     raeburn  3661:           next if ($data eq 'foilorder');
1.31      albertel 3662: 	  pop(@parts);
1.1010    www      3663:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3664:           if ($data eq 'type') {
                   3665:               unless ($showsurv) {
                   3666:                   my $id = join(',',@parts);
                   3667:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3668:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3669:                       $lasthidden{$ign.'.'.$id} = 1;
                   3670:                   }
1.945     raeburn  3671:               }
1.1010    www      3672:           } 
1.31      albertel 3673: 	} else {
1.41      ng       3674: 	  if ($#parts == 0) {
                   3675: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3676: 	  } else {
                   3677: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3678: 	  }
1.31      albertel 3679: 	}
1.16      harris41 3680:       }
1.596     albertel 3681:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3682:       if ($getattempt eq '') {
                   3683: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3684:             my @hidden;
                   3685:             if (%typeparts) {
                   3686:                 foreach my $id (keys(%typeparts)) {
                   3687:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3688:                         push(@hidden,$id);
                   3689:                     }
                   3690:                 }
                   3691:             }
                   3692:             $prevattempts.=&start_data_table_row().
                   3693:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3694:             if (@hidden) {
                   3695:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3696:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3697:                     my $hide;
                   3698:                     foreach my $id (@hidden) {
                   3699:                         if ($key =~ /^\Q$id\E/) {
                   3700:                             $hide = 1;
                   3701:                             last;
                   3702:                         }
                   3703:                     }
                   3704:                     if ($hide) {
                   3705:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3706:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3707:                             my $value = &format_previous_attempt_value($key,
                   3708:                                              $returnhash{$version.':'.$key});
                   3709:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3710:                         } else {
                   3711:                             $prevattempts.='<td>&nbsp;</td>';
                   3712:                         }
                   3713:                     } else {
                   3714:                         if ($key =~ /\./) {
                   3715:                             my $value = &format_previous_attempt_value($key,
                   3716:                                               $returnhash{$version.':'.$key});
                   3717:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3718:                         } else {
                   3719:                             $prevattempts.='<td>&nbsp;</td>';
                   3720:                         }
                   3721:                     }
                   3722:                 }
                   3723:             } else {
                   3724: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3725:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3726: 		    my $value = &format_previous_attempt_value($key,
                   3727: 			            $returnhash{$version.':'.$key});
                   3728: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3729: 	        }
                   3730:             }
                   3731: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3732: 	 }
1.1       albertel 3733:       }
1.945     raeburn  3734:       my @currhidden = keys(%lasthidden);
1.596     albertel 3735:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3736:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3737:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3738:           if (%typeparts) {
                   3739:               my $hidden;
                   3740:               foreach my $id (@currhidden) {
                   3741:                   if ($key =~ /^\Q$id\E/) {
                   3742:                       $hidden = 1;
                   3743:                       last;
                   3744:                   }
                   3745:               }
                   3746:               if ($hidden) {
                   3747:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3748:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3749:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3750:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3751:                           $value = &$gradesub($value);
                   3752:                       }
                   3753:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3754:                   } else {
                   3755:                       $prevattempts.='<td>&nbsp;</td>';
                   3756:                   }
                   3757:               } else {
                   3758:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3759:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3760:                       $value = &$gradesub($value);
                   3761:                   }
                   3762:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3763:               }
                   3764:           } else {
                   3765: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3766: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3767:                   $value = &$gradesub($value);
                   3768:               }
                   3769: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3770:           }
1.16      harris41 3771:       }
1.596     albertel 3772:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3773:     } else {
1.596     albertel 3774:       $prevattempts=
                   3775: 	  &start_data_table().&start_data_table_row().
                   3776: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3777: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3778:     }
                   3779:   } else {
1.596     albertel 3780:     $prevattempts=
                   3781: 	  &start_data_table().&start_data_table_row().
                   3782: 	  '<td>'.&mt('No data.').'</td>'.
                   3783: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3784:   }
1.10      albertel 3785: }
                   3786: 
1.581     albertel 3787: sub format_previous_attempt_value {
                   3788:     my ($key,$value) = @_;
1.1011    www      3789:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 3790: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3791:     } elsif (ref($value) eq 'ARRAY') {
                   3792: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3793:     } elsif ($key =~ /answerstring$/) {
                   3794:         my %answers = &Apache::lonnet::str2hash($value);
                   3795:         my @anskeys = sort(keys(%answers));
                   3796:         if (@anskeys == 1) {
                   3797:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3798:             if ($answer =~ m{\0}) {
                   3799:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3800:             }
                   3801:             my $tag_internal_answer_name = 'INTERNAL';
                   3802:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3803:                 $value = $answer; 
                   3804:             } else {
                   3805:                 $value = $anskeys[0].'='.$answer;
                   3806:             }
                   3807:         } else {
                   3808:             foreach my $ans (@anskeys) {
                   3809:                 my $answer = $answers{$ans};
1.1001    raeburn  3810:                 if ($answer =~ m{\0}) {
                   3811:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3812:                 }
                   3813:                 $value .=  $ans.'='.$answer.'<br />';;
                   3814:             } 
                   3815:         }
1.581     albertel 3816:     } else {
                   3817: 	$value = &unescape($value);
                   3818:     }
                   3819:     return $value;
                   3820: }
                   3821: 
                   3822: 
1.107     albertel 3823: sub relative_to_absolute {
                   3824:     my ($url,$output)=@_;
                   3825:     my $parser=HTML::TokeParser->new(\$output);
                   3826:     my $token;
                   3827:     my $thisdir=$url;
                   3828:     my @rlinks=();
                   3829:     while ($token=$parser->get_token) {
                   3830: 	if ($token->[0] eq 'S') {
                   3831: 	    if ($token->[1] eq 'a') {
                   3832: 		if ($token->[2]->{'href'}) {
                   3833: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3834: 		}
                   3835: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3836: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3837: 	    } elsif ($token->[1] eq 'base') {
                   3838: 		$thisdir=$token->[2]->{'href'};
                   3839: 	    }
                   3840: 	}
                   3841:     }
                   3842:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3843:     foreach my $link (@rlinks) {
1.726     raeburn  3844: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3845: 		($link=~/^\//) ||
                   3846: 		($link=~/^javascript:/i) ||
                   3847: 		($link=~/^mailto:/i) ||
                   3848: 		($link=~/^\#/)) {
                   3849: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3850: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3851: 	}
                   3852:     }
                   3853: # -------------------------------------------------- Deal with Applet codebases
                   3854:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3855:     return $output;
                   3856: }
                   3857: 
1.112     bowersj2 3858: =pod
                   3859: 
1.648     raeburn  3860: =item * &get_student_view()
1.112     bowersj2 3861: 
                   3862: show a snapshot of what student was looking at
                   3863: 
                   3864: =cut
                   3865: 
1.10      albertel 3866: sub get_student_view {
1.186     albertel 3867:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3868:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3869:   my (%form);
1.10      albertel 3870:   my @elements=('symb','courseid','domain','username');
                   3871:   foreach my $element (@elements) {
1.186     albertel 3872:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3873:   }
1.186     albertel 3874:   if (defined($moreenv)) {
                   3875:       %form=(%form,%{$moreenv});
                   3876:   }
1.236     albertel 3877:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 3878:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      3879:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 3880:   $userview=~s/\<body[^\>]*\>//gi;
                   3881:   $userview=~s/\<\/body\>//gi;
                   3882:   $userview=~s/\<html\>//gi;
                   3883:   $userview=~s/\<\/html\>//gi;
                   3884:   $userview=~s/\<head\>//gi;
                   3885:   $userview=~s/\<\/head\>//gi;
                   3886:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 3887:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      3888:   if (wantarray) {
                   3889:      return ($userview,$response);
                   3890:   } else {
                   3891:      return $userview;
                   3892:   }
                   3893: }
                   3894: 
                   3895: sub get_student_view_with_retries {
                   3896:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   3897: 
                   3898:     my $ok = 0;                 # True if we got a good response.
                   3899:     my $content;
                   3900:     my $response;
                   3901: 
                   3902:     # Try to get the student_view done. within the retries count:
                   3903:     
                   3904:     do {
                   3905:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   3906:          $ok      = $response->is_success;
                   3907:          if (!$ok) {
                   3908:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   3909:          }
                   3910:          $retries--;
                   3911:     } while (!$ok && ($retries > 0));
                   3912:     
                   3913:     if (!$ok) {
                   3914:        $content = '';          # On error return an empty content.
                   3915:     }
1.651     www      3916:     if (wantarray) {
                   3917:        return ($content, $response);
                   3918:     } else {
                   3919:        return $content;
                   3920:     }
1.11      albertel 3921: }
                   3922: 
1.112     bowersj2 3923: =pod
                   3924: 
1.648     raeburn  3925: =item * &get_student_answers() 
1.112     bowersj2 3926: 
                   3927: show a snapshot of how student was answering problem
                   3928: 
                   3929: =cut
                   3930: 
1.11      albertel 3931: sub get_student_answers {
1.100     sakharuk 3932:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      3933:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3934:   my (%moreenv);
1.11      albertel 3935:   my @elements=('symb','courseid','domain','username');
                   3936:   foreach my $element (@elements) {
1.186     albertel 3937:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3938:   }
1.186     albertel 3939:   $moreenv{'grade_target'}='answer';
                   3940:   %moreenv=(%form,%moreenv);
1.497     raeburn  3941:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   3942:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 3943:   return $userview;
1.1       albertel 3944: }
1.116     albertel 3945: 
                   3946: =pod
                   3947: 
                   3948: =item * &submlink()
                   3949: 
1.242     albertel 3950: Inputs: $text $uname $udom $symb $target
1.116     albertel 3951: 
                   3952: Returns: A link to grades.pm such as to see the SUBM view of a student
                   3953: 
                   3954: =cut
                   3955: 
                   3956: ###############################################
                   3957: sub submlink {
1.242     albertel 3958:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 3959:     if (!($uname && $udom)) {
                   3960: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3961: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 3962: 	if (!$symb) { $symb=$cursymb; }
                   3963:     }
1.254     matthew  3964:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3965:     $symb=&escape($symb);
1.960     bisitz   3966:     if ($target) { $target=" target=\"$target\""; }
                   3967:     return
                   3968:         '<a href="/adm/grades?command=submission'.
                   3969:         '&amp;symb='.$symb.
                   3970:         '&amp;student='.$uname.
                   3971:         '&amp;userdom='.$udom.'"'.
                   3972:         $target.'>'.$text.'</a>';
1.242     albertel 3973: }
                   3974: ##############################################
                   3975: 
                   3976: =pod
                   3977: 
                   3978: =item * &pgrdlink()
                   3979: 
                   3980: Inputs: $text $uname $udom $symb $target
                   3981: 
                   3982: Returns: A link to grades.pm such as to see the PGRD view of a student
                   3983: 
                   3984: =cut
                   3985: 
                   3986: ###############################################
                   3987: sub pgrdlink {
                   3988:     my $link=&submlink(@_);
                   3989:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   3990:     return $link;
                   3991: }
                   3992: ##############################################
                   3993: 
                   3994: =pod
                   3995: 
                   3996: =item * &pprmlink()
                   3997: 
                   3998: Inputs: $text $uname $udom $symb $target
                   3999: 
                   4000: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4001: student and a specific resource
1.242     albertel 4002: 
                   4003: =cut
                   4004: 
                   4005: ###############################################
                   4006: sub pprmlink {
                   4007:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4008:     if (!($uname && $udom)) {
                   4009: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4010: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4011: 	if (!$symb) { $symb=$cursymb; }
                   4012:     }
1.254     matthew  4013:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4014:     $symb=&escape($symb);
1.242     albertel 4015:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4016:     return '<a href="/adm/parmset?command=set&amp;'.
                   4017: 	'symb='.$symb.'&amp;uname='.$uname.
                   4018: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4019: }
                   4020: ##############################################
1.37      matthew  4021: 
1.112     bowersj2 4022: =pod
                   4023: 
                   4024: =back
                   4025: 
                   4026: =cut
                   4027: 
1.37      matthew  4028: ###############################################
1.51      www      4029: 
                   4030: 
                   4031: sub timehash {
1.687     raeburn  4032:     my ($thistime) = @_;
                   4033:     my $timezone = &Apache::lonlocal::gettimezone();
                   4034:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4035:                      ->set_time_zone($timezone);
                   4036:     my $wday = $dt->day_of_week();
                   4037:     if ($wday == 7) { $wday = 0; }
                   4038:     return ( 'second' => $dt->second(),
                   4039:              'minute' => $dt->minute(),
                   4040:              'hour'   => $dt->hour(),
                   4041:              'day'     => $dt->day_of_month(),
                   4042:              'month'   => $dt->month(),
                   4043:              'year'    => $dt->year(),
                   4044:              'weekday' => $wday,
                   4045:              'dayyear' => $dt->day_of_year(),
                   4046:              'dlsav'   => $dt->is_dst() );
1.51      www      4047: }
                   4048: 
1.370     www      4049: sub utc_string {
                   4050:     my ($date)=@_;
1.371     www      4051:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4052: }
                   4053: 
1.51      www      4054: sub maketime {
                   4055:     my %th=@_;
1.687     raeburn  4056:     my ($epoch_time,$timezone,$dt);
                   4057:     $timezone = &Apache::lonlocal::gettimezone();
                   4058:     eval {
                   4059:         $dt = DateTime->new( year   => $th{'year'},
                   4060:                              month  => $th{'month'},
                   4061:                              day    => $th{'day'},
                   4062:                              hour   => $th{'hour'},
                   4063:                              minute => $th{'minute'},
                   4064:                              second => $th{'second'},
                   4065:                              time_zone => $timezone,
                   4066:                          );
                   4067:     };
                   4068:     if (!$@) {
                   4069:         $epoch_time = $dt->epoch;
                   4070:         if ($epoch_time) {
                   4071:             return $epoch_time;
                   4072:         }
                   4073:     }
1.51      www      4074:     return POSIX::mktime(
                   4075:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4076:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4077: }
                   4078: 
                   4079: #########################################
1.51      www      4080: 
                   4081: sub findallcourses {
1.482     raeburn  4082:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4083:     my %roles;
                   4084:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4085:     my %courses;
1.51      www      4086:     my $now=time;
1.482     raeburn  4087:     if (!defined($uname)) {
                   4088:         $uname = $env{'user.name'};
                   4089:     }
                   4090:     if (!defined($udom)) {
                   4091:         $udom = $env{'user.domain'};
                   4092:     }
                   4093:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4094:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4095:         if (!%roles) {
                   4096:             %roles = (
                   4097:                        cc => 1,
1.907     raeburn  4098:                        co => 1,
1.482     raeburn  4099:                        in => 1,
                   4100:                        ep => 1,
                   4101:                        ta => 1,
                   4102:                        cr => 1,
                   4103:                        st => 1,
                   4104:              );
                   4105:         }
                   4106:         foreach my $entry (keys(%roleshash)) {
                   4107:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4108:             if ($trole =~ /^cr/) { 
                   4109:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4110:             } else {
                   4111:                 next if (!exists($roles{$trole}));
                   4112:             }
                   4113:             if ($tend) {
                   4114:                 next if ($tend < $now);
                   4115:             }
                   4116:             if ($tstart) {
                   4117:                 next if ($tstart > $now);
                   4118:             }
1.1058    raeburn  4119:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4120:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4121:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4122:             if ($secpart eq '') {
                   4123:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4124:                 $sec = 'none';
1.1058    raeburn  4125:                 $value .= $cnum.'/';
1.482     raeburn  4126:             } else {
                   4127:                 $cnum = $cnumpart;
                   4128:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4129:                 $value .= $cnum.'/'.$sec;
                   4130:             }
                   4131:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4132:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4133:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4134:                 }
                   4135:             } else {
                   4136:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4137:             }
1.482     raeburn  4138:         }
                   4139:     } else {
                   4140:         foreach my $key (keys(%env)) {
1.483     albertel 4141: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4142:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4143: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4144: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4145: 	        next if (%roles && !exists($roles{$role}));
                   4146: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4147:                 my $active=1;
                   4148:                 if ($starttime) {
                   4149: 		    if ($now<$starttime) { $active=0; }
                   4150:                 }
                   4151:                 if ($endtime) {
                   4152:                     if ($now>$endtime) { $active=0; }
                   4153:                 }
                   4154:                 if ($active) {
1.1058    raeburn  4155:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4156:                     if ($sec eq '') {
                   4157:                         $sec = 'none';
1.1058    raeburn  4158:                     } else {
                   4159:                         $value .= $sec;
                   4160:                     }
                   4161:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4162:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4163:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4164:                         }
                   4165:                     } else {
                   4166:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4167:                     }
1.474     raeburn  4168:                 }
                   4169:             }
1.51      www      4170:         }
                   4171:     }
1.474     raeburn  4172:     return %courses;
1.51      www      4173: }
1.37      matthew  4174: 
1.54      www      4175: ###############################################
1.474     raeburn  4176: 
                   4177: sub blockcheck {
1.1062    raeburn  4178:     my ($setters,$activity,$uname,$udom,$url) = @_;
1.490     raeburn  4179: 
                   4180:     if (!defined($udom)) {
                   4181:         $udom = $env{'user.domain'};
                   4182:     }
                   4183:     if (!defined($uname)) {
                   4184:         $uname = $env{'user.name'};
                   4185:     }
                   4186: 
                   4187:     # If uname and udom are for a course, check for blocks in the course.
                   4188: 
                   4189:     if (&Apache::lonnet::is_course($udom,$uname)) {
1.1062    raeburn  4190:         my ($startblock,$endblock,$triggerblock) = 
                   4191:             &get_blocks($setters,$activity,$udom,$uname,$url);
                   4192:         return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4193:     }
1.474     raeburn  4194: 
1.502     raeburn  4195:     my $startblock = 0;
                   4196:     my $endblock = 0;
1.1062    raeburn  4197:     my $triggerblock = '';
1.482     raeburn  4198:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4199: 
1.490     raeburn  4200:     # If uname is for a user, and activity is course-specific, i.e.,
                   4201:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4202: 
1.490     raeburn  4203:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   4204:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   4205:         foreach my $key (keys(%live_courses)) {
                   4206:             if ($key ne $env{'request.course.id'}) {
                   4207:                 delete($live_courses{$key});
                   4208:             }
                   4209:         }
                   4210:     }
                   4211: 
                   4212:     my $otheruser = 0;
                   4213:     my %own_courses;
                   4214:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4215:         # Resource belongs to user other than current user.
                   4216:         $otheruser = 1;
                   4217:         # Gather courses for current user
                   4218:         %own_courses = 
                   4219:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4220:     }
                   4221: 
                   4222:     # Gather active course roles - course coordinator, instructor, 
                   4223:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4224: 
                   4225:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4226:         my ($cdom,$cnum);
                   4227:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4228:             $cdom = $env{'course.'.$course.'.domain'};
                   4229:             $cnum = $env{'course.'.$course.'.num'};
                   4230:         } else {
1.490     raeburn  4231:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4232:         }
                   4233:         my $no_ownblock = 0;
                   4234:         my $no_userblock = 0;
1.533     raeburn  4235:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4236:             # Check if current user has 'evb' priv for this
                   4237:             if (defined($own_courses{$course})) {
                   4238:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4239:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4240:                     if ($sec ne 'none') {
                   4241:                         $checkrole .= '/'.$sec;
                   4242:                     }
                   4243:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4244:                         $no_ownblock = 1;
                   4245:                         last;
                   4246:                     }
                   4247:                 }
                   4248:             }
                   4249:             # if they have 'evb' priv and are currently not playing student
                   4250:             next if (($no_ownblock) &&
                   4251:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4252:         }
1.474     raeburn  4253:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4254:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4255:             if ($sec ne 'none') {
1.482     raeburn  4256:                 $checkrole .= '/'.$sec;
1.474     raeburn  4257:             }
1.490     raeburn  4258:             if ($otheruser) {
                   4259:                 # Resource belongs to user other than current user.
                   4260:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4261:                 my (%allroles,%userroles);
                   4262:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4263:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4264:                         my ($trole,$tdom,$tnum,$tsec);
                   4265:                         if ($entry =~ /^cr/) {
                   4266:                             ($trole,$tdom,$tnum,$tsec) = 
                   4267:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4268:                         } else {
                   4269:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4270:                         }
                   4271:                         my ($spec,$area,$trest);
                   4272:                         $area = '/'.$tdom.'/'.$tnum;
                   4273:                         $trest = $tnum;
                   4274:                         if ($tsec ne '') {
                   4275:                             $area .= '/'.$tsec;
                   4276:                             $trest .= '/'.$tsec;
                   4277:                         }
                   4278:                         $spec = $trole.'.'.$area;
                   4279:                         if ($trole =~ /^cr/) {
                   4280:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4281:                                                               $tdom,$spec,$trest,$area);
                   4282:                         } else {
                   4283:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4284:                                                                 $tdom,$spec,$trest,$area);
                   4285:                         }
                   4286:                     }
                   4287:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4288:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4289:                         if ($1) {
                   4290:                             $no_userblock = 1;
                   4291:                             last;
                   4292:                         }
1.486     raeburn  4293:                     }
                   4294:                 }
1.490     raeburn  4295:             } else {
                   4296:                 # Resource belongs to current user
                   4297:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4298:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4299:                     $no_ownblock = 1;
                   4300:                     last;
                   4301:                 }
1.474     raeburn  4302:             }
                   4303:         }
                   4304:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4305:         next if (($no_ownblock) &&
1.491     albertel 4306:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4307:         next if ($no_userblock);
1.474     raeburn  4308: 
1.866     kalberla 4309:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4310:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4311:         
1.1062    raeburn  4312:         my ($start,$end,$trigger) = 
                   4313:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4314:         if (($start != 0) && 
                   4315:             (($startblock == 0) || ($startblock > $start))) {
                   4316:             $startblock = $start;
1.1062    raeburn  4317:             if ($trigger ne '') {
                   4318:                 $triggerblock = $trigger;
                   4319:             }
1.502     raeburn  4320:         }
                   4321:         if (($end != 0)  &&
                   4322:             (($endblock == 0) || ($endblock < $end))) {
                   4323:             $endblock = $end;
1.1062    raeburn  4324:             if ($trigger ne '') {
                   4325:                 $triggerblock = $trigger;
                   4326:             }
1.502     raeburn  4327:         }
1.490     raeburn  4328:     }
1.1062    raeburn  4329:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4330: }
                   4331: 
                   4332: sub get_blocks {
1.1062    raeburn  4333:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4334:     my $startblock = 0;
                   4335:     my $endblock = 0;
1.1062    raeburn  4336:     my $triggerblock = '';
1.490     raeburn  4337:     my $course = $cdom.'_'.$cnum;
                   4338:     $setters->{$course} = {};
                   4339:     $setters->{$course}{'staff'} = [];
                   4340:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4341:     $setters->{$course}{'triggers'} = [];
                   4342:     my (@blockers,%triggered);
                   4343:     my $now = time;
                   4344:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4345:     if ($activity eq 'docs') {
                   4346:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4347:         foreach my $block (@blockers) {
                   4348:             if ($block =~ /^firstaccess____(.+)$/) {
                   4349:                 my $item = $1;
                   4350:                 my $type = 'map';
                   4351:                 my $timersymb = $item;
                   4352:                 if ($item eq 'course') {
                   4353:                     $type = 'course';
                   4354:                 } elsif ($item =~ /___\d+___/) {
                   4355:                     $type = 'resource';
                   4356:                 } else {
                   4357:                     $timersymb = &Apache::lonnet::symbread($item);
                   4358:                 }
                   4359:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4360:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4361:                 $triggered{$block} = {
                   4362:                                        start => $start,
                   4363:                                        end   => $end,
                   4364:                                        type  => $type,
                   4365:                                      };
                   4366:             }
                   4367:         }
                   4368:     } else {
                   4369:         foreach my $block (keys(%commblocks)) {
                   4370:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4371:                 my ($start,$end) = ($1,$2);
                   4372:                 if ($start <= time && $end >= time) {
                   4373:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4374:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4375:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4376:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4377:                                     push(@blockers,$block);
                   4378:                                 }
                   4379:                             }
                   4380:                         }
                   4381:                     }
                   4382:                 }
                   4383:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4384:                 my $item = $1;
                   4385:                 my $timersymb = $item; 
                   4386:                 my $type = 'map';
                   4387:                 if ($item eq 'course') {
                   4388:                     $type = 'course';
                   4389:                 } elsif ($item =~ /___\d+___/) {
                   4390:                     $type = 'resource';
                   4391:                 } else {
                   4392:                     $timersymb = &Apache::lonnet::symbread($item);
                   4393:                 }
                   4394:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4395:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4396:                 if ($start && $end) {
                   4397:                     if (($start <= time) && ($end >= time)) {
                   4398:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4399:                             push(@blockers,$block);
                   4400:                             $triggered{$block} = {
                   4401:                                                    start => $start,
                   4402:                                                    end   => $end,
                   4403:                                                    type  => $type,
                   4404:                                                  };
                   4405:                         }
                   4406:                     }
1.490     raeburn  4407:                 }
1.1062    raeburn  4408:             }
                   4409:         }
                   4410:     }
                   4411:     foreach my $blocker (@blockers) {
                   4412:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4413:             &parse_block_record($commblocks{$blocker});
                   4414:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4415:         my ($start,$end,$triggertype);
                   4416:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4417:             ($start,$end) = ($1,$2);
                   4418:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4419:             $start = $triggered{$blocker}{'start'};
                   4420:             $end = $triggered{$blocker}{'end'};
                   4421:             $triggertype = $triggered{$blocker}{'type'};
                   4422:         }
                   4423:         if ($start) {
                   4424:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4425:             if ($triggertype) {
                   4426:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4427:             } else {
                   4428:                 push(@{$$setters{$course}{'triggers'}},0);
                   4429:             }
                   4430:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4431:                 $startblock = $start;
                   4432:                 if ($triggertype) {
                   4433:                     $triggerblock = $blocker;
1.474     raeburn  4434:                 }
                   4435:             }
1.1062    raeburn  4436:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4437:                $endblock = $end;
                   4438:                if ($triggertype) {
                   4439:                    $triggerblock = $blocker;
                   4440:                }
                   4441:             }
1.474     raeburn  4442:         }
                   4443:     }
1.1062    raeburn  4444:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4445: }
                   4446: 
                   4447: sub parse_block_record {
                   4448:     my ($record) = @_;
                   4449:     my ($setuname,$setudom,$title,$blocks);
                   4450:     if (ref($record) eq 'HASH') {
                   4451:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4452:         $title = &unescape($record->{'event'});
                   4453:         $blocks = $record->{'blocks'};
                   4454:     } else {
                   4455:         my @data = split(/:/,$record,3);
                   4456:         if (scalar(@data) eq 2) {
                   4457:             $title = $data[1];
                   4458:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4459:         } else {
                   4460:             ($setuname,$setudom,$title) = @data;
                   4461:         }
                   4462:         $blocks = { 'com' => 'on' };
                   4463:     }
                   4464:     return ($setuname,$setudom,$title,$blocks);
                   4465: }
                   4466: 
1.854     kalberla 4467: sub blocking_status {
1.1062    raeburn  4468:     my ($activity,$uname,$udom,$url) = @_;
1.1061    raeburn  4469:     my %setters;
1.890     droeschl 4470: 
1.1061    raeburn  4471: # check for active blocking
1.1062    raeburn  4472:     my ($startblock,$endblock,$triggerblock) = 
                   4473:         &blockcheck(\%setters,$activity,$uname,$udom,$url);
                   4474:     my $blocked = 0;
                   4475:     if ($startblock && $endblock) {
                   4476:         $blocked = 1;
                   4477:     }
1.890     droeschl 4478: 
1.1061    raeburn  4479: # caller just wants to know whether a block is active
                   4480:     if (!wantarray) { return $blocked; }
                   4481: 
                   4482: # build a link to a popup window containing the details
                   4483:     my $querystring  = "?activity=$activity";
                   4484: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062    raeburn  4485:     if ($activity eq 'port') {
                   4486:         $querystring .= "&amp;udom=$udom"      if $udom;
                   4487:         $querystring .= "&amp;uname=$uname"    if $uname;
                   4488:     } elsif ($activity eq 'docs') {
                   4489:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4490:     }
1.1061    raeburn  4491: 
                   4492:     my $output .= <<'END_MYBLOCK';
                   4493: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4494:     var options = "width=" + w + ",height=" + h + ",";
                   4495:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4496:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4497:     var newWin = window.open(url, wdwName, options);
                   4498:     newWin.focus();
                   4499: }
1.890     droeschl 4500: END_MYBLOCK
1.854     kalberla 4501: 
1.1061    raeburn  4502:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4503:   
1.1061    raeburn  4504:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4505:     my $text = &mt('Communication Blocked');
                   4506:     if ($activity eq 'docs') {
                   4507:         $text = &mt('Content Access Blocked');
1.1063    raeburn  4508:     } elsif ($activity eq 'printout') {
                   4509:         $text = &mt('Printing Blocked');
1.1062    raeburn  4510:     }
1.1061    raeburn  4511:     $output .= <<"END_BLOCK";
1.867     kalberla 4512: <div class='LC_comblock'>
1.869     kalberla 4513:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4514:   title='$text'>
                   4515:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4516:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4517:   title='$text'>$text</a>
1.867     kalberla 4518: </div>
                   4519: 
                   4520: END_BLOCK
1.474     raeburn  4521: 
1.1061    raeburn  4522:     return ($blocked, $output);
1.854     kalberla 4523: }
1.490     raeburn  4524: 
1.60      matthew  4525: ###############################################
                   4526: 
1.682     raeburn  4527: sub check_ip_acc {
                   4528:     my ($acc)=@_;
                   4529:     &Apache::lonxml::debug("acc is $acc");
                   4530:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4531:         return 1;
                   4532:     }
                   4533:     my $allowed=0;
                   4534:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4535: 
                   4536:     my $name;
                   4537:     foreach my $pattern (split(',',$acc)) {
                   4538:         $pattern =~ s/^\s*//;
                   4539:         $pattern =~ s/\s*$//;
                   4540:         if ($pattern =~ /\*$/) {
                   4541:             #35.8.*
                   4542:             $pattern=~s/\*//;
                   4543:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4544:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4545:             #35.8.3.[34-56]
                   4546:             my $low=$2;
                   4547:             my $high=$3;
                   4548:             $pattern=$1;
                   4549:             if ($ip =~ /^\Q$pattern\E/) {
                   4550:                 my $last=(split(/\./,$ip))[3];
                   4551:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4552:             }
                   4553:         } elsif ($pattern =~ /^\*/) {
                   4554:             #*.msu.edu
                   4555:             $pattern=~s/\*//;
                   4556:             if (!defined($name)) {
                   4557:                 use Socket;
                   4558:                 my $netaddr=inet_aton($ip);
                   4559:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4560:             }
                   4561:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4562:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4563:             #127.0.0.1
                   4564:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4565:         } else {
                   4566:             #some.name.com
                   4567:             if (!defined($name)) {
                   4568:                 use Socket;
                   4569:                 my $netaddr=inet_aton($ip);
                   4570:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4571:             }
                   4572:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4573:         }
                   4574:         if ($allowed) { last; }
                   4575:     }
                   4576:     return $allowed;
                   4577: }
                   4578: 
                   4579: ###############################################
                   4580: 
1.60      matthew  4581: =pod
                   4582: 
1.112     bowersj2 4583: =head1 Domain Template Functions
                   4584: 
                   4585: =over 4
                   4586: 
                   4587: =item * &determinedomain()
1.60      matthew  4588: 
                   4589: Inputs: $domain (usually will be undef)
                   4590: 
1.63      www      4591: Returns: Determines which domain should be used for designs
1.60      matthew  4592: 
                   4593: =cut
1.54      www      4594: 
1.60      matthew  4595: ###############################################
1.63      www      4596: sub determinedomain {
                   4597:     my $domain=shift;
1.531     albertel 4598:     if (! $domain) {
1.60      matthew  4599:         # Determine domain if we have not been given one
1.893     raeburn  4600:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4601:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4602:         if ($env{'request.role.domain'}) { 
                   4603:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4604:         }
                   4605:     }
1.63      www      4606:     return $domain;
                   4607: }
                   4608: ###############################################
1.517     raeburn  4609: 
1.518     albertel 4610: sub devalidate_domconfig_cache {
                   4611:     my ($udom)=@_;
                   4612:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4613: }
                   4614: 
                   4615: # ---------------------- Get domain configuration for a domain
                   4616: sub get_domainconf {
                   4617:     my ($udom) = @_;
                   4618:     my $cachetime=1800;
                   4619:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4620:     if (defined($cached)) { return %{$result}; }
                   4621: 
                   4622:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4623: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4624:     my (%designhash,%legacy);
1.518     albertel 4625:     if (keys(%domconfig) > 0) {
                   4626:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4627:             if (keys(%{$domconfig{'login'}})) {
                   4628:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4629:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4630:                         if ($key eq 'loginvia') {
                   4631:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013    raeburn  4632:                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948     raeburn  4633:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4634:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4635:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4636:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4637:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4638: 
                   4639:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4640:                                             } else {
1.1013    raeburn  4641:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948     raeburn  4642:                                             }
                   4643:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4644:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4645:                                             }
1.946     raeburn  4646:                                         }
                   4647:                                     }
                   4648:                                 }
                   4649:                             }
                   4650:                         } else {
                   4651:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4652:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4653:                                     $domconfig{'login'}{$key}{$img};
                   4654:                             }
1.699     raeburn  4655:                         }
                   4656:                     } else {
                   4657:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4658:                     }
1.632     raeburn  4659:                 }
                   4660:             } else {
                   4661:                 $legacy{'login'} = 1;
1.518     albertel 4662:             }
1.632     raeburn  4663:         } else {
                   4664:             $legacy{'login'} = 1;
1.518     albertel 4665:         }
                   4666:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4667:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4668:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4669:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4670:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4671:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4672:                         }
1.518     albertel 4673:                     }
                   4674:                 }
1.632     raeburn  4675:             } else {
                   4676:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4677:             }
1.632     raeburn  4678:         } else {
                   4679:             $legacy{'rolecolors'} = 1;
1.518     albertel 4680:         }
1.948     raeburn  4681:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4682:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4683:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4684:             }
                   4685:         }
1.632     raeburn  4686:         if (keys(%legacy) > 0) {
                   4687:             my %legacyhash = &get_legacy_domconf($udom);
                   4688:             foreach my $item (keys(%legacyhash)) {
                   4689:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4690:                     if ($legacy{'login'}) { 
                   4691:                         $designhash{$item} = $legacyhash{$item};
                   4692:                     }
                   4693:                 } else {
                   4694:                     if ($legacy{'rolecolors'}) {
                   4695:                         $designhash{$item} = $legacyhash{$item};
                   4696:                     }
1.518     albertel 4697:                 }
                   4698:             }
                   4699:         }
1.632     raeburn  4700:     } else {
                   4701:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4702:     }
                   4703:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4704: 				  $cachetime);
                   4705:     return %designhash;
                   4706: }
                   4707: 
1.632     raeburn  4708: sub get_legacy_domconf {
                   4709:     my ($udom) = @_;
                   4710:     my %legacyhash;
                   4711:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4712:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4713:     if (-e $designfile) {
                   4714:         if ( open (my $fh,"<$designfile") ) {
                   4715:             while (my $line = <$fh>) {
                   4716:                 next if ($line =~ /^\#/);
                   4717:                 chomp($line);
                   4718:                 my ($key,$val)=(split(/\=/,$line));
                   4719:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4720:             }
                   4721:             close($fh);
                   4722:         }
                   4723:     }
1.1026    raeburn  4724:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4725:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4726:     }
                   4727:     return %legacyhash;
                   4728: }
                   4729: 
1.63      www      4730: =pod
                   4731: 
1.112     bowersj2 4732: =item * &domainlogo()
1.63      www      4733: 
                   4734: Inputs: $domain (usually will be undef)
                   4735: 
                   4736: Returns: A link to a domain logo, if the domain logo exists.
                   4737: If the domain logo does not exist, a description of the domain.
                   4738: 
                   4739: =cut
1.112     bowersj2 4740: 
1.63      www      4741: ###############################################
                   4742: sub domainlogo {
1.517     raeburn  4743:     my $domain = &determinedomain(shift);
1.518     albertel 4744:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4745:     # See if there is a logo
                   4746:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4747:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4748:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4749: 	    if ($imgsrc =~ m{^/res/}) {
                   4750: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4751: 		&Apache::lonnet::repcopy($local_name);
                   4752: 	    }
                   4753: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4754:         } 
                   4755:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4756:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4757:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4758:     } else {
1.60      matthew  4759:         return '';
1.59      www      4760:     }
                   4761: }
1.63      www      4762: ##############################################
                   4763: 
                   4764: =pod
                   4765: 
1.112     bowersj2 4766: =item * &designparm()
1.63      www      4767: 
                   4768: Inputs: $which parameter; $domain (usually will be undef)
                   4769: 
                   4770: Returns: value of designparamter $which
                   4771: 
                   4772: =cut
1.112     bowersj2 4773: 
1.397     albertel 4774: 
1.400     albertel 4775: ##############################################
1.397     albertel 4776: sub designparm {
                   4777:     my ($which,$domain)=@_;
                   4778:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4779:         return $env{'environment.color.'.$which};
1.96      www      4780:     }
1.63      www      4781:     $domain=&determinedomain($domain);
1.1016    raeburn  4782:     my %domdesign;
                   4783:     unless ($domain eq 'public') {
                   4784:         %domdesign = &get_domainconf($domain);
                   4785:     }
1.520     raeburn  4786:     my $output;
1.517     raeburn  4787:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4788:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4789:     } else {
1.520     raeburn  4790:         $output = $defaultdesign{$which};
                   4791:     }
                   4792:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4793:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4794:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4795:             if ($output =~ m{^/res/}) {
                   4796:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4797:                 &Apache::lonnet::repcopy($local_name);
                   4798:             }
1.520     raeburn  4799:             $output = &lonhttpdurl($output);
                   4800:         }
1.63      www      4801:     }
1.520     raeburn  4802:     return $output;
1.63      www      4803: }
1.59      www      4804: 
1.822     bisitz   4805: ##############################################
                   4806: =pod
                   4807: 
1.832     bisitz   4808: =item * &authorspace()
                   4809: 
1.1028    raeburn  4810: Inputs: $url (usually will be undef).
1.832     bisitz   4811: 
1.1028    raeburn  4812: Returns: Path to Construction Space containing the resource or 
                   4813:          directory being viewed (or for which action is being taken). 
                   4814:          If $url is provided, and begins /priv/<domain>/<uname>
                   4815:          the path will be that portion of the $context argument.
                   4816:          Otherwise the path will be for the author space of the current
                   4817:          user when the current role is author, or for that of the 
                   4818:          co-author/assistant co-author space when the current role 
                   4819:          is co-author or assistant co-author.
1.832     bisitz   4820: 
                   4821: =cut
                   4822: 
                   4823: sub authorspace {
1.1028    raeburn  4824:     my ($url) = @_;
                   4825:     if ($url ne '') {
                   4826:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4827:            return $1;
                   4828:         }
                   4829:     }
1.832     bisitz   4830:     my $caname = '';
1.1024    www      4831:     my $cadom = '';
1.1028    raeburn  4832:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4833:         ($cadom,$caname) =
1.832     bisitz   4834:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4835:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4836:         $caname = $env{'user.name'};
1.1024    www      4837:         $cadom = $env{'user.domain'};
1.832     bisitz   4838:     }
1.1028    raeburn  4839:     if (($caname ne '') && ($cadom ne '')) {
                   4840:         return "/priv/$cadom/$caname/";
                   4841:     }
                   4842:     return;
1.832     bisitz   4843: }
                   4844: 
                   4845: ##############################################
                   4846: =pod
                   4847: 
1.822     bisitz   4848: =item * &head_subbox()
                   4849: 
                   4850: Inputs: $content (contains HTML code with page functions, etc.)
                   4851: 
                   4852: Returns: HTML div with $content
                   4853:          To be included in page header
                   4854: 
                   4855: =cut
                   4856: 
                   4857: sub head_subbox {
                   4858:     my ($content)=@_;
                   4859:     my $output =
1.993     raeburn  4860:         '<div class="LC_head_subbox">'
1.822     bisitz   4861:        .$content
                   4862:        .'</div>'
                   4863: }
                   4864: 
                   4865: ##############################################
                   4866: =pod
                   4867: 
                   4868: =item * &CSTR_pageheader()
                   4869: 
1.1026    raeburn  4870: Input: (optional) filename from which breadcrumb trail is built.
                   4871:        In most cases no input as needed, as $env{'request.filename'}
                   4872:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   4873: 
                   4874: Returns: HTML div with CSTR path and recent box
                   4875:          To be included on Construction Space pages
                   4876: 
                   4877: =cut
                   4878: 
                   4879: sub CSTR_pageheader {
1.1026    raeburn  4880:     my ($trailfile) = @_;
                   4881:     if ($trailfile eq '') {
                   4882:         $trailfile = $env{'request.filename'};
                   4883:     }
                   4884: 
                   4885: # this is for resources; directories have customtitle, and crumbs
                   4886: # and select recent are created in lonpubdir.pm
                   4887: 
                   4888:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      4889:     my ($udom,$uname,$thisdisfn)=
1.1026    raeburn  4890:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)/(.*)$});
                   4891:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   4892:     $formaction =~ s{/+}{/}g;
1.822     bisitz   4893: 
                   4894:     my $parentpath = '';
                   4895:     my $lastitem = '';
                   4896:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   4897:         $parentpath = $1;
                   4898:         $lastitem = $2;
                   4899:     } else {
                   4900:         $lastitem = $thisdisfn;
                   4901:     }
1.921     bisitz   4902: 
                   4903:     my $output =
1.822     bisitz   4904:          '<div>'
                   4905:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
                   4906:         .'<b>'.&mt('Construction Space:').'</b> '
                   4907:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   4908:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      4909:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   4910: 
                   4911:     if ($lastitem) {
                   4912:         $output .=
                   4913:              '<span class="LC_filename">'
                   4914:             .$lastitem
                   4915:             .'</span>';
                   4916:     }
                   4917:     $output .=
                   4918:          '<br />'
1.822     bisitz   4919:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   4920:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   4921:         .'</form>'
                   4922:         .&Apache::lonmenu::constspaceform()
                   4923:         .'</div>';
1.921     bisitz   4924: 
                   4925:     return $output;
1.822     bisitz   4926: }
                   4927: 
1.60      matthew  4928: ###############################################
                   4929: ###############################################
                   4930: 
                   4931: =pod
                   4932: 
1.112     bowersj2 4933: =back
                   4934: 
1.549     albertel 4935: =head1 HTML Helpers
1.112     bowersj2 4936: 
                   4937: =over 4
                   4938: 
                   4939: =item * &bodytag()
1.60      matthew  4940: 
                   4941: Returns a uniform header for LON-CAPA web pages.
                   4942: 
                   4943: Inputs: 
                   4944: 
1.112     bowersj2 4945: =over 4
                   4946: 
                   4947: =item * $title, A title to be displayed on the page.
                   4948: 
                   4949: =item * $function, the current role (can be undef).
                   4950: 
                   4951: =item * $addentries, extra parameters for the <body> tag.
                   4952: 
                   4953: =item * $bodyonly, if defined, only return the <body> tag.
                   4954: 
                   4955: =item * $domain, if defined, force a given domain.
                   4956: 
                   4957: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      4958:             text interface only)
1.60      matthew  4959: 
1.814     bisitz   4960: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   4961:                      navigational links
1.317     albertel 4962: 
1.338     albertel 4963: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   4964: 
1.1075.2.12  raeburn  4965: =item * $no_inline_link, if true and in remote mode, don't show the
                   4966:          'Switch To Inline Menu' link
                   4967: 
1.460     albertel 4968: =item * $args, optional argument valid values are
                   4969:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 4970:             inherit_jsmath -> when creating popup window in a page,
                   4971:                               should it have jsmath forced on by the
                   4972:                               current page
1.460     albertel 4973: 
1.1075.2.15  raeburn  4974: =item * $advtoolsref, optional argument, ref to an array containing
                   4975:             inlineremote items to be added in "Functions" menu below
                   4976:             breadcrumbs.
                   4977: 
1.112     bowersj2 4978: =back
                   4979: 
1.60      matthew  4980: Returns: A uniform header for LON-CAPA web pages.  
                   4981: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   4982: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   4983: other decorations will be returned.
                   4984: 
                   4985: =cut
                   4986: 
1.54      www      4987: sub bodytag {
1.831     bisitz   4988:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15  raeburn  4989:         $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339     albertel 4990: 
1.954     raeburn  4991:     my $public;
                   4992:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   4993:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   4994:         $public = 1;
                   4995:     }
1.460     albertel 4996:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339     albertel 4997: 
1.183     matthew  4998:     $function = &get_users_function() if (!$function);
1.339     albertel 4999:     my $img =    &designparm($function.'.img',$domain);
                   5000:     my $font =   &designparm($function.'.font',$domain);
                   5001:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5002: 
1.803     bisitz   5003:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5004: 		   'bgcolor' => $pgbg,
1.339     albertel 5005: 		   'text'    => $font,
                   5006:                    'alink'   => &designparm($function.'.alink',$domain),
                   5007: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5008: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5009:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5010: 
1.63      www      5011:  # role and realm
1.378     raeburn  5012:     my ($role,$realm) = split(/\./,$env{'request.role'},2);
                   5013:     if ($role  eq 'ca') {
1.479     albertel 5014:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5015:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5016:     } 
1.55      www      5017: # realm
1.258     albertel 5018:     if ($env{'request.course.id'}) {
1.378     raeburn  5019:         if ($env{'request.role'} !~ /^cr/) {
                   5020:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5021:         }
1.898     raeburn  5022:         if ($env{'request.course.sec'}) {
                   5023:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5024:         }   
1.359     albertel 5025: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5026:     } else {
                   5027:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5028:     }
1.433     albertel 5029: 
1.359     albertel 5030:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5031: 
1.438     albertel 5032:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5033: 
1.101     www      5034: # construct main body tag
1.359     albertel 5035:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 5036: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 5037: 
1.530     albertel 5038:     if ($bodyonly) {
1.60      matthew  5039:         return $bodytag;
1.798     tempelho 5040:     } 
1.359     albertel 5041: 
1.410     albertel 5042:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.954     raeburn  5043:     if ($public) {
1.433     albertel 5044: 	undef($role);
1.434     albertel 5045:     } else {
1.1070    raeburn  5046: 	$name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
                   5047:                                 undef,'LC_menubuttons_link');
1.433     albertel 5048:     }
1.359     albertel 5049:     
1.762     bisitz   5050:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5051:     #
                   5052:     # Extra info if you are the DC
                   5053:     my $dc_info = '';
                   5054:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5055:                         $env{'course.'.$env{'request.course.id'}.
                   5056:                                  '.domain'}.'/'})) {
                   5057:         my $cid = $env{'request.course.id'};
1.917     raeburn  5058:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5059:         $dc_info =~ s/\s+$//;
1.359     albertel 5060:     }
                   5061: 
1.898     raeburn  5062:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853     droeschl 5063:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5064: 
1.1075.2.13  raeburn  5065:     if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') { 
                   5066:         return $bodytag; 
                   5067:     }
1.903     droeschl 5068: 
1.1075.2.13  raeburn  5069:     if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5070: 
1.1075.2.21  raeburn  5071:     my $funclist;
                   5072:     if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
                   5073:         $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions(), 'start')."\n".
                   5074:                     Apache::lonmenu::serverform();
                   5075:         my $forbodytag;
                   5076:         &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5077:                                             $forcereg,$args->{'group'},
                   5078:                                             $args->{'bread_crumbs'},
                   5079:                                             $advtoolsref,'',\$forbodytag);
                   5080:         unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5081:             $funclist = $forbodytag;
                   5082:         }
                   5083:     } else {
1.903     droeschl 5084: 
                   5085:         #    if ($env{'request.state'} eq 'construct') {
                   5086:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5087:         #    }
                   5088: 
1.359     albertel 5089: 
1.1075.2.2  raeburn  5090: 
1.916     droeschl 5091:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22  raeburn  5092:             if ($dc_info) {
                   5093:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1  raeburn  5094:             }
1.1075.2.22  raeburn  5095:             $bodytag .= qq|<div id="LC_nav_bar">$name $role<br />
                   5096:                            <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5097:             return $bodytag;
                   5098:         }
1.894     droeschl 5099: 
1.927     raeburn  5100:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
                   5101:             $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>|;
                   5102:         }
1.916     droeschl 5103: 
1.903     droeschl 5104:         $bodytag .= Apache::lonhtmlcommon::scripttag(
                   5105:             Apache::lonmenu::utilityfunctions(), 'start');
1.816     bisitz   5106: 
1.903     droeschl 5107:         $bodytag .= Apache::lonmenu::primary_menu();
1.852     droeschl 5108: 
1.917     raeburn  5109:         if ($dc_info) {
                   5110:             $dc_info = &dc_courseid_toggle($dc_info);
                   5111:         }
                   5112:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5113: 
1.903     droeschl 5114:         #don't show menus for public users
1.954     raeburn  5115:         if (!$public){
1.903     droeschl 5116:             $bodytag .= Apache::lonmenu::secondary_menu();
                   5117:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5118:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5119:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5120:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5121:                                 $args->{'bread_crumbs'});
                   5122:             } elsif ($forcereg) { 
1.1075.2.22  raeburn  5123:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                   5124:                                                             $args->{'group'});
1.1075.2.15  raeburn  5125:             } else {
1.1075.2.21  raeburn  5126:                 my $forbodytag;
                   5127:                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5128:                                                     $forcereg,$args->{'group'},
                   5129:                                                     $args->{'bread_crumbs'},
                   5130:                                                     $advtoolsref,'',\$forbodytag);
                   5131:                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5132:                     $bodytag .= $forbodytag;
                   5133:                 }
1.920     raeburn  5134:             }
1.903     droeschl 5135:         }else{
                   5136:             # this is to seperate menu from content when there's no secondary
                   5137:             # menu. Especially needed for public accessible ressources.
                   5138:             $bodytag .= '<hr style="clear:both" />';
                   5139:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5140:         }
1.903     droeschl 5141: 
1.235     raeburn  5142:         return $bodytag;
1.1075.2.12  raeburn  5143:     }
                   5144: 
                   5145: #
                   5146: # Top frame rendering, Remote is up
                   5147: #
                   5148: 
                   5149:     my $imgsrc = $img;
                   5150:     if ($img =~ /^\/adm/) {
                   5151:         $imgsrc = &lonhttpdurl($img);
                   5152:     }
                   5153:     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
                   5154: 
                   5155:     # Explicit link to get inline menu
                   5156:     my $menu= ($no_inline_link?''
                   5157:                :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
                   5158: 
                   5159:     if ($dc_info) {
                   5160:         $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
                   5161:     }
                   5162: 
                   5163:     unless ($env{'form.inhibitmenu'}) {
                   5164:         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
                   5165:                        <ol class="LC_primary_menu LC_right">
                   5166:                        <li>$menu</li>
                   5167:                        </ol><div id="LC_realm"> $realm $dc_info</div>|;
                   5168:     }
1.1075.2.13  raeburn  5169:     if ($env{'request.state'} eq 'construct') {
                   5170:         if (!$public){
                   5171:             if ($env{'request.state'} eq 'construct') {
                   5172:                 $funclist = &Apache::lonhtmlcommon::scripttag(
                   5173:                                 &Apache::lonmenu::utilityfunctions(), 'start').
                   5174:                             &Apache::lonhtmlcommon::scripttag('','end').
                   5175:                             &Apache::lonmenu::innerregister($forcereg,
                   5176:                                                             $args->{'bread_crumbs'});
                   5177:             }
                   5178:         }
                   5179:     }
1.1075.2.21  raeburn  5180:     return $bodytag."\n".$funclist;
1.182     matthew  5181: }
                   5182: 
1.917     raeburn  5183: sub dc_courseid_toggle {
                   5184:     my ($dc_info) = @_;
1.980     raeburn  5185:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5186:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5187:            &mt('(More ...)').'</a></span>'.
                   5188:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5189: }
                   5190: 
1.330     albertel 5191: sub make_attr_string {
                   5192:     my ($register,$attr_ref) = @_;
                   5193: 
                   5194:     if ($attr_ref && !ref($attr_ref)) {
                   5195: 	die("addentries Must be a hash ref ".
                   5196: 	    join(':',caller(1))." ".
                   5197: 	    join(':',caller(0))." ");
                   5198:     }
                   5199: 
                   5200:     if ($register) {
1.339     albertel 5201: 	my ($on_load,$on_unload);
                   5202: 	foreach my $key (keys(%{$attr_ref})) {
                   5203: 	    if      (lc($key) eq 'onload') {
                   5204: 		$on_load.=$attr_ref->{$key}.';';
                   5205: 		delete($attr_ref->{$key});
                   5206: 
                   5207: 	    } elsif (lc($key) eq 'onunload') {
                   5208: 		$on_unload.=$attr_ref->{$key}.';';
                   5209: 		delete($attr_ref->{$key});
                   5210: 	    }
                   5211: 	}
1.1075.2.12  raeburn  5212:         if ($env{'environment.remote'} eq 'on') {
                   5213:             $attr_ref->{'onload'}  =
                   5214:                 &Apache::lonmenu::loadevents().  $on_load;
                   5215:             $attr_ref->{'onunload'}=
                   5216:                 &Apache::lonmenu::unloadevents().$on_unload;
                   5217:         } else {  
                   5218: 	    $attr_ref->{'onload'}  = $on_load;
                   5219: 	    $attr_ref->{'onunload'}= $on_unload;
                   5220:         }
1.330     albertel 5221:     }
1.339     albertel 5222: 
1.330     albertel 5223:     my $attr_string;
                   5224:     foreach my $attr (keys(%$attr_ref)) {
                   5225: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5226:     }
                   5227:     return $attr_string;
                   5228: }
                   5229: 
                   5230: 
1.182     matthew  5231: ###############################################
1.251     albertel 5232: ###############################################
                   5233: 
                   5234: =pod
                   5235: 
                   5236: =item * &endbodytag()
                   5237: 
                   5238: Returns a uniform footer for LON-CAPA web pages.
                   5239: 
1.635     raeburn  5240: Inputs: 1 - optional reference to an args hash
                   5241: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5242: a 'Continue' link is not displayed if the page contains an
                   5243: internal redirect in the <head></head> section,
                   5244: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5245: 
                   5246: =cut
                   5247: 
                   5248: sub endbodytag {
1.635     raeburn  5249:     my ($args) = @_;
1.1075.2.6  raeburn  5250:     my $endbodytag;
                   5251:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5252:         $endbodytag='</body>';
                   5253:     }
1.269     albertel 5254:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 5255:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5256:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5257: 	    $endbodytag=
                   5258: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5259: 	        &mt('Continue').'</a>'.
                   5260: 	        $endbodytag;
                   5261:         }
1.315     albertel 5262:     }
1.251     albertel 5263:     return $endbodytag;
                   5264: }
                   5265: 
1.352     albertel 5266: =pod
                   5267: 
                   5268: =item * &standard_css()
                   5269: 
                   5270: Returns a style sheet
                   5271: 
                   5272: Inputs: (all optional)
                   5273:             domain         -> force to color decorate a page for a specific
                   5274:                                domain
                   5275:             function       -> force usage of a specific rolish color scheme
                   5276:             bgcolor        -> override the default page bgcolor
                   5277: 
                   5278: =cut
                   5279: 
1.343     albertel 5280: sub standard_css {
1.345     albertel 5281:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5282:     $function  = &get_users_function() if (!$function);
                   5283:     my $img    = &designparm($function.'.img',   $domain);
                   5284:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5285:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5286:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5287: #second colour for later usage
1.345     albertel 5288:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5289:     my $pgbg_or_bgcolor =
                   5290: 	         $bgcolor ||
1.352     albertel 5291: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5292:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5293:     my $alink  = &designparm($function.'.alink', $domain);
                   5294:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5295:     my $link   = &designparm($function.'.link',  $domain);
                   5296: 
1.602     albertel 5297:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5298:     my $mono                 = 'monospace';
1.850     bisitz   5299:     my $data_table_head      = $sidebg;
                   5300:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5301:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5302:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5303:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5304:     my $mail_new             = '#FFBB77';
                   5305:     my $mail_new_hover       = '#DD9955';
                   5306:     my $mail_read            = '#BBBB77';
                   5307:     my $mail_read_hover      = '#999944';
                   5308:     my $mail_replied         = '#AAAA88';
                   5309:     my $mail_replied_hover   = '#888855';
                   5310:     my $mail_other           = '#99BBBB';
                   5311:     my $mail_other_hover     = '#669999';
1.391     albertel 5312:     my $table_header         = '#DDDDDD';
1.489     raeburn  5313:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5314:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5315:     my $button_hover         = '#BF2317';
1.392     albertel 5316: 
1.608     albertel 5317:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5318:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5319:                                              : '0 3px 0 4px';
1.448     albertel 5320: 
1.523     albertel 5321: 
1.343     albertel 5322:     return <<END;
1.947     droeschl 5323: 
                   5324: /* needed for iframe to allow 100% height in FF */
                   5325: body, html { 
                   5326:     margin: 0;
                   5327:     padding: 0 0.5%;
                   5328:     height: 99%; /* to avoid scrollbars */
                   5329: }
                   5330: 
1.795     www      5331: body {
1.911     bisitz   5332:   font-family: $sans;
                   5333:   line-height:130%;
                   5334:   font-size:0.83em;
                   5335:   color:$font;
1.795     www      5336: }
                   5337: 
1.959     onken    5338: a:focus,
                   5339: a:focus img {
1.795     www      5340:   color: red;
                   5341: }
1.698     harmsja  5342: 
1.911     bisitz   5343: form, .inline {
                   5344:   display: inline;
1.795     www      5345: }
1.721     harmsja  5346: 
1.795     www      5347: .LC_right {
1.911     bisitz   5348:   text-align:right;
1.795     www      5349: }
                   5350: 
                   5351: .LC_middle {
1.911     bisitz   5352:   vertical-align:middle;
1.795     www      5353: }
1.721     harmsja  5354: 
1.911     bisitz   5355: .LC_400Box {
                   5356:   width:400px;
                   5357: }
1.721     harmsja  5358: 
1.947     droeschl 5359: .LC_iframecontainer {
                   5360:     width: 98%;
                   5361:     margin: 0;
                   5362:     position: fixed;
                   5363:     top: 8.5em;
                   5364:     bottom: 0;
                   5365: }
                   5366: 
                   5367: .LC_iframecontainer iframe{
                   5368:     border: none;
                   5369:     width: 100%;
                   5370:     height: 100%;
                   5371: }
                   5372: 
1.778     bisitz   5373: .LC_filename {
                   5374:   font-family: $mono;
                   5375:   white-space:pre;
1.921     bisitz   5376:   font-size: 120%;
1.778     bisitz   5377: }
                   5378: 
                   5379: .LC_fileicon {
                   5380:   border: none;
                   5381:   height: 1.3em;
                   5382:   vertical-align: text-bottom;
                   5383:   margin-right: 0.3em;
                   5384:   text-decoration:none;
                   5385: }
                   5386: 
1.1008    www      5387: .LC_setting {
                   5388:   text-decoration:underline;
                   5389: }
                   5390: 
1.350     albertel 5391: .LC_error {
                   5392:   color: red;
                   5393: }
1.795     www      5394: 
1.1075.2.15  raeburn  5395: .LC_warning {
                   5396:   color: darkorange;
                   5397: }
                   5398: 
1.457     albertel 5399: .LC_diff_removed {
1.733     bisitz   5400:   color: red;
1.394     albertel 5401: }
1.532     albertel 5402: 
                   5403: .LC_info,
1.457     albertel 5404: .LC_success,
                   5405: .LC_diff_added {
1.350     albertel 5406:   color: green;
                   5407: }
1.795     www      5408: 
1.802     bisitz   5409: div.LC_confirm_box {
                   5410:   background-color: #FAFAFA;
                   5411:   border: 1px solid $lg_border_color;
                   5412:   margin-right: 0;
                   5413:   padding: 5px;
                   5414: }
                   5415: 
                   5416: div.LC_confirm_box .LC_error img,
                   5417: div.LC_confirm_box .LC_success img {
                   5418:   vertical-align: middle;
                   5419: }
                   5420: 
1.440     albertel 5421: .LC_icon {
1.771     droeschl 5422:   border: none;
1.790     droeschl 5423:   vertical-align: middle;
1.771     droeschl 5424: }
                   5425: 
1.543     albertel 5426: .LC_docs_spacer {
                   5427:   width: 25px;
                   5428:   height: 1px;
1.771     droeschl 5429:   border: none;
1.543     albertel 5430: }
1.346     albertel 5431: 
1.532     albertel 5432: .LC_internal_info {
1.735     bisitz   5433:   color: #999999;
1.532     albertel 5434: }
                   5435: 
1.794     www      5436: .LC_discussion {
1.1050    www      5437:   background: $data_table_dark;
1.911     bisitz   5438:   border: 1px solid black;
                   5439:   margin: 2px;
1.794     www      5440: }
                   5441: 
                   5442: .LC_disc_action_left {
1.1050    www      5443:   background: $sidebg;
1.911     bisitz   5444:   text-align: left;
1.1050    www      5445:   padding: 4px;
                   5446:   margin: 2px;
1.794     www      5447: }
                   5448: 
                   5449: .LC_disc_action_right {
1.1050    www      5450:   background: $sidebg;
1.911     bisitz   5451:   text-align: right;
1.1050    www      5452:   padding: 4px;
                   5453:   margin: 2px;
1.794     www      5454: }
                   5455: 
                   5456: .LC_disc_new_item {
1.911     bisitz   5457:   background: white;
                   5458:   border: 2px solid red;
1.1050    www      5459:   margin: 4px;
                   5460:   padding: 4px;
1.794     www      5461: }
                   5462: 
                   5463: .LC_disc_old_item {
1.911     bisitz   5464:   background: white;
1.1050    www      5465:   margin: 4px;
                   5466:   padding: 4px;
1.794     www      5467: }
                   5468: 
1.458     albertel 5469: table.LC_pastsubmission {
                   5470:   border: 1px solid black;
                   5471:   margin: 2px;
                   5472: }
                   5473: 
1.924     bisitz   5474: table#LC_menubuttons {
1.345     albertel 5475:   width: 100%;
                   5476:   background: $pgbg;
1.392     albertel 5477:   border: 2px;
1.402     albertel 5478:   border-collapse: separate;
1.803     bisitz   5479:   padding: 0;
1.345     albertel 5480: }
1.392     albertel 5481: 
1.801     tempelho 5482: table#LC_title_bar a {
                   5483:   color: $fontmenu;
                   5484: }
1.836     bisitz   5485: 
1.807     droeschl 5486: table#LC_title_bar {
1.819     tempelho 5487:   clear: both;
1.836     bisitz   5488:   display: none;
1.807     droeschl 5489: }
                   5490: 
1.795     www      5491: table#LC_title_bar,
1.933     droeschl 5492: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5493: table#LC_title_bar.LC_with_remote {
1.359     albertel 5494:   width: 100%;
1.392     albertel 5495:   border-color: $pgbg;
                   5496:   border-style: solid;
                   5497:   border-width: $border;
1.379     albertel 5498:   background: $pgbg;
1.801     tempelho 5499:   color: $fontmenu;
1.392     albertel 5500:   border-collapse: collapse;
1.803     bisitz   5501:   padding: 0;
1.819     tempelho 5502:   margin: 0;
1.359     albertel 5503: }
1.795     www      5504: 
1.933     droeschl 5505: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5506:     margin: 0;
                   5507:     padding: 0;
1.933     droeschl 5508:     position: relative;
                   5509:     list-style: none;
1.913     droeschl 5510: }
1.933     droeschl 5511: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5512:     display: inline;
                   5513: }
1.933     droeschl 5514: 
                   5515: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5516:     padding: 0;
1.933     droeschl 5517:     margin: 0;
                   5518:     float: left;
1.913     droeschl 5519: }
1.933     droeschl 5520: .LC_breadcrumb_tools_tools {
                   5521:     padding: 0;
                   5522:     margin: 0;
1.913     droeschl 5523:     float: right;
                   5524: }
                   5525: 
1.359     albertel 5526: table#LC_title_bar td {
                   5527:   background: $tabbg;
                   5528: }
1.795     www      5529: 
1.911     bisitz   5530: table#LC_menubuttons img {
1.803     bisitz   5531:   border: none;
1.346     albertel 5532: }
1.795     www      5533: 
1.842     droeschl 5534: .LC_breadcrumbs_component {
1.911     bisitz   5535:   float: right;
                   5536:   margin: 0 1em;
1.357     albertel 5537: }
1.842     droeschl 5538: .LC_breadcrumbs_component img {
1.911     bisitz   5539:   vertical-align: middle;
1.777     tempelho 5540: }
1.795     www      5541: 
1.383     albertel 5542: td.LC_table_cell_checkbox {
                   5543:   text-align: center;
                   5544: }
1.795     www      5545: 
                   5546: .LC_fontsize_small {
1.911     bisitz   5547:   font-size: 70%;
1.705     tempelho 5548: }
                   5549: 
1.844     bisitz   5550: #LC_breadcrumbs {
1.911     bisitz   5551:   clear:both;
                   5552:   background: $sidebg;
                   5553:   border-bottom: 1px solid $lg_border_color;
                   5554:   line-height: 2.5em;
1.933     droeschl 5555:   overflow: hidden;
1.911     bisitz   5556:   margin: 0;
                   5557:   padding: 0;
1.995     raeburn  5558:   text-align: left;
1.819     tempelho 5559: }
1.862     bisitz   5560: 
1.1075.2.16  raeburn  5561: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   5562:   clear:both;
                   5563:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5564:   border: 1px solid $sidebg;
1.1075.2.16  raeburn  5565:   margin: 0 0 10px 0;
1.966     bisitz   5566:   padding: 3px;
1.995     raeburn  5567:   text-align: left;
1.822     bisitz   5568: }
                   5569: 
1.795     www      5570: .LC_fontsize_medium {
1.911     bisitz   5571:   font-size: 85%;
1.705     tempelho 5572: }
                   5573: 
1.795     www      5574: .LC_fontsize_large {
1.911     bisitz   5575:   font-size: 120%;
1.705     tempelho 5576: }
                   5577: 
1.346     albertel 5578: .LC_menubuttons_inline_text {
                   5579:   color: $font;
1.698     harmsja  5580:   font-size: 90%;
1.701     harmsja  5581:   padding-left:3px;
1.346     albertel 5582: }
                   5583: 
1.934     droeschl 5584: .LC_menubuttons_inline_text img{
                   5585:   vertical-align: middle;
                   5586: }
                   5587: 
1.1051    www      5588: li.LC_menubuttons_inline_text img {
1.951     onken    5589:   cursor:pointer;
1.1002    droeschl 5590:   text-decoration: none;
1.951     onken    5591: }
                   5592: 
1.526     www      5593: .LC_menubuttons_link {
                   5594:   text-decoration: none;
                   5595: }
1.795     www      5596: 
1.522     albertel 5597: .LC_menubuttons_category {
1.521     www      5598:   color: $font;
1.526     www      5599:   background: $pgbg;
1.521     www      5600:   font-size: larger;
                   5601:   font-weight: bold;
                   5602: }
                   5603: 
1.346     albertel 5604: td.LC_menubuttons_text {
1.911     bisitz   5605:   color: $font;
1.346     albertel 5606: }
1.706     harmsja  5607: 
1.346     albertel 5608: .LC_current_location {
                   5609:   background: $tabbg;
                   5610: }
1.795     www      5611: 
1.938     bisitz   5612: table.LC_data_table {
1.347     albertel 5613:   border: 1px solid #000000;
1.402     albertel 5614:   border-collapse: separate;
1.426     albertel 5615:   border-spacing: 1px;
1.610     albertel 5616:   background: $pgbg;
1.347     albertel 5617: }
1.795     www      5618: 
1.422     albertel 5619: .LC_data_table_dense {
                   5620:   font-size: small;
                   5621: }
1.795     www      5622: 
1.507     raeburn  5623: table.LC_nested_outer {
                   5624:   border: 1px solid #000000;
1.589     raeburn  5625:   border-collapse: collapse;
1.803     bisitz   5626:   border-spacing: 0;
1.507     raeburn  5627:   width: 100%;
                   5628: }
1.795     www      5629: 
1.879     raeburn  5630: table.LC_innerpickbox,
1.507     raeburn  5631: table.LC_nested {
1.803     bisitz   5632:   border: none;
1.589     raeburn  5633:   border-collapse: collapse;
1.803     bisitz   5634:   border-spacing: 0;
1.507     raeburn  5635:   width: 100%;
                   5636: }
1.795     www      5637: 
1.911     bisitz   5638: table.LC_data_table tr th,
                   5639: table.LC_calendar tr th,
1.879     raeburn  5640: table.LC_prior_tries tr th,
                   5641: table.LC_innerpickbox tr th {
1.349     albertel 5642:   font-weight: bold;
                   5643:   background-color: $data_table_head;
1.801     tempelho 5644:   color:$fontmenu;
1.701     harmsja  5645:   font-size:90%;
1.347     albertel 5646: }
1.795     www      5647: 
1.879     raeburn  5648: table.LC_innerpickbox tr th,
                   5649: table.LC_innerpickbox tr td {
                   5650:   vertical-align: top;
                   5651: }
                   5652: 
1.711     raeburn  5653: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5654:   background-color: #CCCCCC;
1.711     raeburn  5655:   font-weight: bold;
                   5656:   text-align: left;
                   5657: }
1.795     www      5658: 
1.912     bisitz   5659: table.LC_data_table tr.LC_odd_row > td {
                   5660:   background-color: $data_table_light;
                   5661:   padding: 2px;
                   5662:   vertical-align: top;
                   5663: }
                   5664: 
1.809     bisitz   5665: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5666:   background-color: $data_table_light;
1.912     bisitz   5667:   vertical-align: top;
                   5668: }
                   5669: 
                   5670: table.LC_data_table tr.LC_even_row > td {
                   5671:   background-color: $data_table_dark;
1.425     albertel 5672:   padding: 2px;
1.900     bisitz   5673:   vertical-align: top;
1.347     albertel 5674: }
1.795     www      5675: 
1.809     bisitz   5676: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5677:   background-color: $data_table_dark;
1.900     bisitz   5678:   vertical-align: top;
1.347     albertel 5679: }
1.795     www      5680: 
1.425     albertel 5681: table.LC_data_table tr.LC_data_table_highlight td {
                   5682:   background-color: $data_table_darker;
                   5683: }
1.795     www      5684: 
1.639     raeburn  5685: table.LC_data_table tr td.LC_leftcol_header {
                   5686:   background-color: $data_table_head;
                   5687:   font-weight: bold;
                   5688: }
1.795     www      5689: 
1.451     albertel 5690: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5691: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5692:   font-weight: bold;
                   5693:   font-style: italic;
                   5694:   text-align: center;
                   5695:   padding: 8px;
1.347     albertel 5696: }
1.795     www      5697: 
1.940     bisitz   5698: table.LC_data_table tr.LC_empty_row td {
                   5699:   background-color: $sidebg;
                   5700: }
                   5701: 
                   5702: table.LC_nested tr.LC_empty_row td {
                   5703:   background-color: #FFFFFF;
                   5704: }
                   5705: 
1.890     droeschl 5706: table.LC_caption {
                   5707: }
                   5708: 
1.507     raeburn  5709: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5710:   padding: 4ex
                   5711: }
1.795     www      5712: 
1.507     raeburn  5713: table.LC_nested_outer tr th {
                   5714:   font-weight: bold;
1.801     tempelho 5715:   color:$fontmenu;
1.507     raeburn  5716:   background-color: $data_table_head;
1.701     harmsja  5717:   font-size: small;
1.507     raeburn  5718:   border-bottom: 1px solid #000000;
                   5719: }
1.795     www      5720: 
1.507     raeburn  5721: table.LC_nested_outer tr td.LC_subheader {
                   5722:   background-color: $data_table_head;
                   5723:   font-weight: bold;
                   5724:   font-size: small;
                   5725:   border-bottom: 1px solid #000000;
                   5726:   text-align: right;
1.451     albertel 5727: }
1.795     www      5728: 
1.507     raeburn  5729: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5730:   background-color: #CCCCCC;
1.451     albertel 5731:   font-weight: bold;
                   5732:   font-size: small;
1.507     raeburn  5733:   text-align: center;
                   5734: }
1.795     www      5735: 
1.589     raeburn  5736: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5737: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5738:   text-align: left;
1.451     albertel 5739: }
1.795     www      5740: 
1.507     raeburn  5741: table.LC_nested td {
1.735     bisitz   5742:   background-color: #FFFFFF;
1.451     albertel 5743:   font-size: small;
1.507     raeburn  5744: }
1.795     www      5745: 
1.507     raeburn  5746: table.LC_nested_outer tr th.LC_right_item,
                   5747: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5748: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5749: table.LC_nested tr td.LC_right_item {
1.451     albertel 5750:   text-align: right;
                   5751: }
                   5752: 
1.507     raeburn  5753: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5754:   background-color: #EEEEEE;
1.451     albertel 5755: }
                   5756: 
1.473     raeburn  5757: table.LC_createuser {
                   5758: }
                   5759: 
                   5760: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5761:   font-size: small;
1.473     raeburn  5762: }
                   5763: 
                   5764: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5765:   background-color: #CCCCCC;
1.473     raeburn  5766:   font-weight: bold;
                   5767:   text-align: center;
                   5768: }
                   5769: 
1.349     albertel 5770: table.LC_calendar {
                   5771:   border: 1px solid #000000;
                   5772:   border-collapse: collapse;
1.917     raeburn  5773:   width: 98%;
1.349     albertel 5774: }
1.795     www      5775: 
1.349     albertel 5776: table.LC_calendar_pickdate {
                   5777:   font-size: xx-small;
                   5778: }
1.795     www      5779: 
1.349     albertel 5780: table.LC_calendar tr td {
                   5781:   border: 1px solid #000000;
                   5782:   vertical-align: top;
1.917     raeburn  5783:   width: 14%;
1.349     albertel 5784: }
1.795     www      5785: 
1.349     albertel 5786: table.LC_calendar tr td.LC_calendar_day_empty {
                   5787:   background-color: $data_table_dark;
                   5788: }
1.795     www      5789: 
1.779     bisitz   5790: table.LC_calendar tr td.LC_calendar_day_current {
                   5791:   background-color: $data_table_highlight;
1.777     tempelho 5792: }
1.795     www      5793: 
1.938     bisitz   5794: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5795:   background-color: $mail_new;
                   5796: }
1.795     www      5797: 
1.938     bisitz   5798: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5799:   background-color: $mail_new_hover;
                   5800: }
1.795     www      5801: 
1.938     bisitz   5802: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5803:   background-color: $mail_read;
                   5804: }
1.795     www      5805: 
1.938     bisitz   5806: /*
                   5807: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5808:   background-color: $mail_read_hover;
                   5809: }
1.938     bisitz   5810: */
1.795     www      5811: 
1.938     bisitz   5812: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5813:   background-color: $mail_replied;
                   5814: }
1.795     www      5815: 
1.938     bisitz   5816: /*
                   5817: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5818:   background-color: $mail_replied_hover;
                   5819: }
1.938     bisitz   5820: */
1.795     www      5821: 
1.938     bisitz   5822: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5823:   background-color: $mail_other;
                   5824: }
1.795     www      5825: 
1.938     bisitz   5826: /*
                   5827: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5828:   background-color: $mail_other_hover;
                   5829: }
1.938     bisitz   5830: */
1.494     raeburn  5831: 
1.777     tempelho 5832: table.LC_data_table tr > td.LC_browser_file,
                   5833: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5834:   background: #AAEE77;
1.389     albertel 5835: }
1.795     www      5836: 
1.777     tempelho 5837: table.LC_data_table tr > td.LC_browser_file_locked,
                   5838: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5839:   background: #FFAA99;
1.387     albertel 5840: }
1.795     www      5841: 
1.777     tempelho 5842: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5843:   background: #888888;
1.779     bisitz   5844: }
1.795     www      5845: 
1.777     tempelho 5846: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5847: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5848:   background: #F8F866;
1.777     tempelho 5849: }
1.795     www      5850: 
1.696     bisitz   5851: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5852:   background: #E0E8FF;
1.387     albertel 5853: }
1.696     bisitz   5854: 
1.707     bisitz   5855: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5856:   /* background: #77FF77; */
1.707     bisitz   5857: }
1.795     www      5858: 
1.707     bisitz   5859: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5860:   border-right: 8px solid #FFFF77;
1.707     bisitz   5861: }
1.795     www      5862: 
1.707     bisitz   5863: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5864:   border-right: 8px solid #FFAA77;
1.707     bisitz   5865: }
1.795     www      5866: 
1.707     bisitz   5867: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5868:   border-right: 8px solid #FF7777;
1.707     bisitz   5869: }
1.795     www      5870: 
1.707     bisitz   5871: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5872:   border-right: 8px solid #AAFF77;
1.707     bisitz   5873: }
1.795     www      5874: 
1.707     bisitz   5875: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5876:   border-right: 8px solid #11CC55;
1.707     bisitz   5877: }
                   5878: 
1.388     albertel 5879: span.LC_current_location {
1.701     harmsja  5880:   font-size:larger;
1.388     albertel 5881:   background: $pgbg;
                   5882: }
1.387     albertel 5883: 
1.1029    www      5884: span.LC_current_nav_location {
                   5885:   font-weight:bold;
                   5886:   background: $sidebg;
                   5887: }
                   5888: 
1.395     albertel 5889: span.LC_parm_menu_item {
                   5890:   font-size: larger;
                   5891: }
1.795     www      5892: 
1.395     albertel 5893: span.LC_parm_scope_all {
                   5894:   color: red;
                   5895: }
1.795     www      5896: 
1.395     albertel 5897: span.LC_parm_scope_folder {
                   5898:   color: green;
                   5899: }
1.795     www      5900: 
1.395     albertel 5901: span.LC_parm_scope_resource {
                   5902:   color: orange;
                   5903: }
1.795     www      5904: 
1.395     albertel 5905: span.LC_parm_part {
                   5906:   color: blue;
                   5907: }
1.795     www      5908: 
1.911     bisitz   5909: span.LC_parm_folder,
                   5910: span.LC_parm_symb {
1.395     albertel 5911:   font-size: x-small;
                   5912:   font-family: $mono;
                   5913:   color: #AAAAAA;
                   5914: }
                   5915: 
1.977     bisitz   5916: ul.LC_parm_parmlist li {
                   5917:   display: inline-block;
                   5918:   padding: 0.3em 0.8em;
                   5919:   vertical-align: top;
                   5920:   width: 150px;
                   5921:   border-top:1px solid $lg_border_color;
                   5922: }
                   5923: 
1.795     www      5924: td.LC_parm_overview_level_menu,
                   5925: td.LC_parm_overview_map_menu,
                   5926: td.LC_parm_overview_parm_selectors,
                   5927: td.LC_parm_overview_restrictions  {
1.396     albertel 5928:   border: 1px solid black;
                   5929:   border-collapse: collapse;
                   5930: }
1.795     www      5931: 
1.396     albertel 5932: table.LC_parm_overview_restrictions td {
                   5933:   border-width: 1px 4px 1px 4px;
                   5934:   border-style: solid;
                   5935:   border-color: $pgbg;
                   5936:   text-align: center;
                   5937: }
1.795     www      5938: 
1.396     albertel 5939: table.LC_parm_overview_restrictions th {
                   5940:   background: $tabbg;
                   5941:   border-width: 1px 4px 1px 4px;
                   5942:   border-style: solid;
                   5943:   border-color: $pgbg;
                   5944: }
1.795     www      5945: 
1.398     albertel 5946: table#LC_helpmenu {
1.803     bisitz   5947:   border: none;
1.398     albertel 5948:   height: 55px;
1.803     bisitz   5949:   border-spacing: 0;
1.398     albertel 5950: }
                   5951: 
                   5952: table#LC_helpmenu fieldset legend {
                   5953:   font-size: larger;
                   5954: }
1.795     www      5955: 
1.397     albertel 5956: table#LC_helpmenu_links {
                   5957:   width: 100%;
                   5958:   border: 1px solid black;
                   5959:   background: $pgbg;
1.803     bisitz   5960:   padding: 0;
1.397     albertel 5961:   border-spacing: 1px;
                   5962: }
1.795     www      5963: 
1.397     albertel 5964: table#LC_helpmenu_links tr td {
                   5965:   padding: 1px;
                   5966:   background: $tabbg;
1.399     albertel 5967:   text-align: center;
                   5968:   font-weight: bold;
1.397     albertel 5969: }
1.396     albertel 5970: 
1.795     www      5971: table#LC_helpmenu_links a:link,
                   5972: table#LC_helpmenu_links a:visited,
1.397     albertel 5973: table#LC_helpmenu_links a:active {
                   5974:   text-decoration: none;
                   5975:   color: $font;
                   5976: }
1.795     www      5977: 
1.397     albertel 5978: table#LC_helpmenu_links a:hover {
                   5979:   text-decoration: underline;
                   5980:   color: $vlink;
                   5981: }
1.396     albertel 5982: 
1.417     albertel 5983: .LC_chrt_popup_exists {
                   5984:   border: 1px solid #339933;
                   5985:   margin: -1px;
                   5986: }
1.795     www      5987: 
1.417     albertel 5988: .LC_chrt_popup_up {
                   5989:   border: 1px solid yellow;
                   5990:   margin: -1px;
                   5991: }
1.795     www      5992: 
1.417     albertel 5993: .LC_chrt_popup {
                   5994:   border: 1px solid #8888FF;
                   5995:   background: #CCCCFF;
                   5996: }
1.795     www      5997: 
1.421     albertel 5998: table.LC_pick_box {
                   5999:   border-collapse: separate;
                   6000:   background: white;
                   6001:   border: 1px solid black;
                   6002:   border-spacing: 1px;
                   6003: }
1.795     www      6004: 
1.421     albertel 6005: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6006:   background: $sidebg;
1.421     albertel 6007:   font-weight: bold;
1.900     bisitz   6008:   text-align: left;
1.740     bisitz   6009:   vertical-align: top;
1.421     albertel 6010:   width: 184px;
                   6011:   padding: 8px;
                   6012: }
1.795     www      6013: 
1.579     raeburn  6014: table.LC_pick_box td.LC_pick_box_value {
                   6015:   text-align: left;
                   6016:   padding: 8px;
                   6017: }
1.795     www      6018: 
1.579     raeburn  6019: table.LC_pick_box td.LC_pick_box_select {
                   6020:   text-align: left;
                   6021:   padding: 8px;
                   6022: }
1.795     www      6023: 
1.424     albertel 6024: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6025:   padding: 0;
1.421     albertel 6026:   height: 1px;
                   6027:   background: black;
                   6028: }
1.795     www      6029: 
1.421     albertel 6030: table.LC_pick_box td.LC_pick_box_submit {
                   6031:   text-align: right;
                   6032: }
1.795     www      6033: 
1.579     raeburn  6034: table.LC_pick_box td.LC_evenrow_value {
                   6035:   text-align: left;
                   6036:   padding: 8px;
                   6037:   background-color: $data_table_light;
                   6038: }
1.795     www      6039: 
1.579     raeburn  6040: table.LC_pick_box td.LC_oddrow_value {
                   6041:   text-align: left;
                   6042:   padding: 8px;
                   6043:   background-color: $data_table_light;
                   6044: }
1.795     www      6045: 
1.579     raeburn  6046: span.LC_helpform_receipt_cat {
                   6047:   font-weight: bold;
                   6048: }
1.795     www      6049: 
1.424     albertel 6050: table.LC_group_priv_box {
                   6051:   background: white;
                   6052:   border: 1px solid black;
                   6053:   border-spacing: 1px;
                   6054: }
1.795     www      6055: 
1.424     albertel 6056: table.LC_group_priv_box td.LC_pick_box_title {
                   6057:   background: $tabbg;
                   6058:   font-weight: bold;
                   6059:   text-align: right;
                   6060:   width: 184px;
                   6061: }
1.795     www      6062: 
1.424     albertel 6063: table.LC_group_priv_box td.LC_groups_fixed {
                   6064:   background: $data_table_light;
                   6065:   text-align: center;
                   6066: }
1.795     www      6067: 
1.424     albertel 6068: table.LC_group_priv_box td.LC_groups_optional {
                   6069:   background: $data_table_dark;
                   6070:   text-align: center;
                   6071: }
1.795     www      6072: 
1.424     albertel 6073: table.LC_group_priv_box td.LC_groups_functionality {
                   6074:   background: $data_table_darker;
                   6075:   text-align: center;
                   6076:   font-weight: bold;
                   6077: }
1.795     www      6078: 
1.424     albertel 6079: table.LC_group_priv td {
                   6080:   text-align: left;
1.803     bisitz   6081:   padding: 0;
1.424     albertel 6082: }
                   6083: 
                   6084: .LC_navbuttons {
                   6085:   margin: 2ex 0ex 2ex 0ex;
                   6086: }
1.795     www      6087: 
1.423     albertel 6088: .LC_topic_bar {
                   6089:   font-weight: bold;
                   6090:   background: $tabbg;
1.918     wenzelju 6091:   margin: 1em 0em 1em 2em;
1.805     bisitz   6092:   padding: 3px;
1.918     wenzelju 6093:   font-size: 1.2em;
1.423     albertel 6094: }
1.795     www      6095: 
1.423     albertel 6096: .LC_topic_bar span {
1.918     wenzelju 6097:   left: 0.5em;
                   6098:   position: absolute;
1.423     albertel 6099:   vertical-align: middle;
1.918     wenzelju 6100:   font-size: 1.2em;
1.423     albertel 6101: }
1.795     www      6102: 
1.423     albertel 6103: table.LC_course_group_status {
                   6104:   margin: 20px;
                   6105: }
1.795     www      6106: 
1.423     albertel 6107: table.LC_status_selector td {
                   6108:   vertical-align: top;
                   6109:   text-align: center;
1.424     albertel 6110:   padding: 4px;
                   6111: }
1.795     www      6112: 
1.599     albertel 6113: div.LC_feedback_link {
1.616     albertel 6114:   clear: both;
1.829     kalberla 6115:   background: $sidebg;
1.779     bisitz   6116:   width: 100%;
1.829     kalberla 6117:   padding-bottom: 10px;
                   6118:   border: 1px $tabbg solid;
1.833     kalberla 6119:   height: 22px;
                   6120:   line-height: 22px;
                   6121:   padding-top: 5px;
                   6122: }
                   6123: 
                   6124: div.LC_feedback_link img {
                   6125:   height: 22px;
1.867     kalberla 6126:   vertical-align:middle;
1.829     kalberla 6127: }
                   6128: 
1.911     bisitz   6129: div.LC_feedback_link a {
1.829     kalberla 6130:   text-decoration: none;
1.489     raeburn  6131: }
1.795     www      6132: 
1.867     kalberla 6133: div.LC_comblock {
1.911     bisitz   6134:   display:inline;
1.867     kalberla 6135:   color:$font;
                   6136:   font-size:90%;
                   6137: }
                   6138: 
                   6139: div.LC_feedback_link div.LC_comblock {
                   6140:   padding-left:5px;
                   6141: }
                   6142: 
                   6143: div.LC_feedback_link div.LC_comblock a {
                   6144:   color:$font;
                   6145: }
                   6146: 
1.489     raeburn  6147: span.LC_feedback_link {
1.858     bisitz   6148:   /* background: $feedback_link_bg; */
1.599     albertel 6149:   font-size: larger;
                   6150: }
1.795     www      6151: 
1.599     albertel 6152: span.LC_message_link {
1.858     bisitz   6153:   /* background: $feedback_link_bg; */
1.599     albertel 6154:   font-size: larger;
                   6155:   position: absolute;
                   6156:   right: 1em;
1.489     raeburn  6157: }
1.421     albertel 6158: 
1.515     albertel 6159: table.LC_prior_tries {
1.524     albertel 6160:   border: 1px solid #000000;
                   6161:   border-collapse: separate;
                   6162:   border-spacing: 1px;
1.515     albertel 6163: }
1.523     albertel 6164: 
1.515     albertel 6165: table.LC_prior_tries td {
1.524     albertel 6166:   padding: 2px;
1.515     albertel 6167: }
1.523     albertel 6168: 
                   6169: .LC_answer_correct {
1.795     www      6170:   background: lightgreen;
                   6171:   color: darkgreen;
                   6172:   padding: 6px;
1.523     albertel 6173: }
1.795     www      6174: 
1.523     albertel 6175: .LC_answer_charged_try {
1.797     www      6176:   background: #FFAAAA;
1.795     www      6177:   color: darkred;
                   6178:   padding: 6px;
1.523     albertel 6179: }
1.795     www      6180: 
1.779     bisitz   6181: .LC_answer_not_charged_try,
1.523     albertel 6182: .LC_answer_no_grade,
                   6183: .LC_answer_late {
1.795     www      6184:   background: lightyellow;
1.523     albertel 6185:   color: black;
1.795     www      6186:   padding: 6px;
1.523     albertel 6187: }
1.795     www      6188: 
1.523     albertel 6189: .LC_answer_previous {
1.795     www      6190:   background: lightblue;
                   6191:   color: darkblue;
                   6192:   padding: 6px;
1.523     albertel 6193: }
1.795     www      6194: 
1.779     bisitz   6195: .LC_answer_no_message {
1.777     tempelho 6196:   background: #FFFFFF;
                   6197:   color: black;
1.795     www      6198:   padding: 6px;
1.779     bisitz   6199: }
1.795     www      6200: 
1.779     bisitz   6201: .LC_answer_unknown {
                   6202:   background: orange;
                   6203:   color: black;
1.795     www      6204:   padding: 6px;
1.777     tempelho 6205: }
1.795     www      6206: 
1.529     albertel 6207: span.LC_prior_numerical,
                   6208: span.LC_prior_string,
                   6209: span.LC_prior_custom,
                   6210: span.LC_prior_reaction,
                   6211: span.LC_prior_math {
1.925     bisitz   6212:   font-family: $mono;
1.523     albertel 6213:   white-space: pre;
                   6214: }
                   6215: 
1.525     albertel 6216: span.LC_prior_string {
1.925     bisitz   6217:   font-family: $mono;
1.525     albertel 6218:   white-space: pre;
                   6219: }
                   6220: 
1.523     albertel 6221: table.LC_prior_option {
                   6222:   width: 100%;
                   6223:   border-collapse: collapse;
                   6224: }
1.795     www      6225: 
1.911     bisitz   6226: table.LC_prior_rank,
1.795     www      6227: table.LC_prior_match {
1.528     albertel 6228:   border-collapse: collapse;
                   6229: }
1.795     www      6230: 
1.528     albertel 6231: table.LC_prior_option tr td,
                   6232: table.LC_prior_rank tr td,
                   6233: table.LC_prior_match tr td {
1.524     albertel 6234:   border: 1px solid #000000;
1.515     albertel 6235: }
                   6236: 
1.855     bisitz   6237: .LC_nobreak {
1.544     albertel 6238:   white-space: nowrap;
1.519     raeburn  6239: }
                   6240: 
1.576     raeburn  6241: span.LC_cusr_emph {
                   6242:   font-style: italic;
                   6243: }
                   6244: 
1.633     raeburn  6245: span.LC_cusr_subheading {
                   6246:   font-weight: normal;
                   6247:   font-size: 85%;
                   6248: }
                   6249: 
1.861     bisitz   6250: div.LC_docs_entry_move {
1.859     bisitz   6251:   border: 1px solid #BBBBBB;
1.545     albertel 6252:   background: #DDDDDD;
1.861     bisitz   6253:   width: 22px;
1.859     bisitz   6254:   padding: 1px;
                   6255:   margin: 0;
1.545     albertel 6256: }
                   6257: 
1.861     bisitz   6258: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6259: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6260:   font-size: x-small;
                   6261: }
1.795     www      6262: 
1.861     bisitz   6263: .LC_docs_entry_parameter {
                   6264:   white-space: nowrap;
                   6265: }
                   6266: 
1.544     albertel 6267: .LC_docs_copy {
1.545     albertel 6268:   color: #000099;
1.544     albertel 6269: }
1.795     www      6270: 
1.544     albertel 6271: .LC_docs_cut {
1.545     albertel 6272:   color: #550044;
1.544     albertel 6273: }
1.795     www      6274: 
1.544     albertel 6275: .LC_docs_rename {
1.545     albertel 6276:   color: #009900;
1.544     albertel 6277: }
1.795     www      6278: 
1.544     albertel 6279: .LC_docs_remove {
1.545     albertel 6280:   color: #990000;
                   6281: }
                   6282: 
1.547     albertel 6283: .LC_docs_reinit_warn,
                   6284: .LC_docs_ext_edit {
                   6285:   font-size: x-small;
                   6286: }
                   6287: 
1.545     albertel 6288: table.LC_docs_adddocs td,
                   6289: table.LC_docs_adddocs th {
                   6290:   border: 1px solid #BBBBBB;
                   6291:   padding: 4px;
                   6292:   background: #DDDDDD;
1.543     albertel 6293: }
                   6294: 
1.584     albertel 6295: table.LC_sty_begin {
                   6296:   background: #BBFFBB;
                   6297: }
1.795     www      6298: 
1.584     albertel 6299: table.LC_sty_end {
                   6300:   background: #FFBBBB;
                   6301: }
                   6302: 
1.589     raeburn  6303: table.LC_double_column {
1.803     bisitz   6304:   border-width: 0;
1.589     raeburn  6305:   border-collapse: collapse;
                   6306:   width: 100%;
                   6307:   padding: 2px;
                   6308: }
                   6309: 
                   6310: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6311:   top: 2px;
1.589     raeburn  6312:   left: 2px;
                   6313:   width: 47%;
                   6314:   vertical-align: top;
                   6315: }
                   6316: 
                   6317: table.LC_double_column tr td.LC_right_col {
                   6318:   top: 2px;
1.779     bisitz   6319:   right: 2px;
1.589     raeburn  6320:   width: 47%;
                   6321:   vertical-align: top;
                   6322: }
                   6323: 
1.591     raeburn  6324: div.LC_left_float {
                   6325:   float: left;
                   6326:   padding-right: 5%;
1.597     albertel 6327:   padding-bottom: 4px;
1.591     raeburn  6328: }
                   6329: 
                   6330: div.LC_clear_float_header {
1.597     albertel 6331:   padding-bottom: 2px;
1.591     raeburn  6332: }
                   6333: 
                   6334: div.LC_clear_float_footer {
1.597     albertel 6335:   padding-top: 10px;
1.591     raeburn  6336:   clear: both;
                   6337: }
                   6338: 
1.597     albertel 6339: div.LC_grade_show_user {
1.941     bisitz   6340: /*  border-left: 5px solid $sidebg; */
                   6341:   border-top: 5px solid #000000;
                   6342:   margin: 50px 0 0 0;
1.936     bisitz   6343:   padding: 15px 0 5px 10px;
1.597     albertel 6344: }
1.795     www      6345: 
1.936     bisitz   6346: div.LC_grade_show_user_odd_row {
1.941     bisitz   6347: /*  border-left: 5px solid #000000; */
                   6348: }
                   6349: 
                   6350: div.LC_grade_show_user div.LC_Box {
                   6351:   margin-right: 50px;
1.597     albertel 6352: }
                   6353: 
                   6354: div.LC_grade_submissions,
                   6355: div.LC_grade_message_center,
1.936     bisitz   6356: div.LC_grade_info_links {
1.597     albertel 6357:   margin: 5px;
                   6358:   width: 99%;
                   6359:   background: #FFFFFF;
                   6360: }
1.795     www      6361: 
1.597     albertel 6362: div.LC_grade_submissions_header,
1.936     bisitz   6363: div.LC_grade_message_center_header {
1.705     tempelho 6364:   font-weight: bold;
                   6365:   font-size: large;
1.597     albertel 6366: }
1.795     www      6367: 
1.597     albertel 6368: div.LC_grade_submissions_body,
1.936     bisitz   6369: div.LC_grade_message_center_body {
1.597     albertel 6370:   border: 1px solid black;
                   6371:   width: 99%;
                   6372:   background: #FFFFFF;
                   6373: }
1.795     www      6374: 
1.613     albertel 6375: table.LC_scantron_action {
                   6376:   width: 100%;
                   6377: }
1.795     www      6378: 
1.613     albertel 6379: table.LC_scantron_action tr th {
1.698     harmsja  6380:   font-weight:bold;
                   6381:   font-style:normal;
1.613     albertel 6382: }
1.795     www      6383: 
1.779     bisitz   6384: .LC_edit_problem_header,
1.614     albertel 6385: div.LC_edit_problem_footer {
1.705     tempelho 6386:   font-weight: normal;
                   6387:   font-size:  medium;
1.602     albertel 6388:   margin: 2px;
1.1060    bisitz   6389:   background-color: $sidebg;
1.600     albertel 6390: }
1.795     www      6391: 
1.600     albertel 6392: div.LC_edit_problem_header,
1.602     albertel 6393: div.LC_edit_problem_header div,
1.614     albertel 6394: div.LC_edit_problem_footer,
                   6395: div.LC_edit_problem_footer div,
1.602     albertel 6396: div.LC_edit_problem_editxml_header,
                   6397: div.LC_edit_problem_editxml_header div {
1.600     albertel 6398:   margin-top: 5px;
                   6399: }
1.795     www      6400: 
1.600     albertel 6401: div.LC_edit_problem_header_title {
1.705     tempelho 6402:   font-weight: bold;
                   6403:   font-size: larger;
1.602     albertel 6404:   background: $tabbg;
                   6405:   padding: 3px;
1.1060    bisitz   6406:   margin: 0 0 5px 0;
1.602     albertel 6407: }
1.795     www      6408: 
1.602     albertel 6409: table.LC_edit_problem_header_title {
                   6410:   width: 100%;
1.600     albertel 6411:   background: $tabbg;
1.602     albertel 6412: }
                   6413: 
                   6414: div.LC_edit_problem_discards {
                   6415:   float: left;
                   6416:   padding-bottom: 5px;
                   6417: }
1.795     www      6418: 
1.602     albertel 6419: div.LC_edit_problem_saves {
                   6420:   float: right;
                   6421:   padding-bottom: 5px;
1.600     albertel 6422: }
1.795     www      6423: 
1.911     bisitz   6424: img.stift {
1.803     bisitz   6425:   border-width: 0;
                   6426:   vertical-align: middle;
1.677     riegler  6427: }
1.680     riegler  6428: 
1.923     bisitz   6429: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6430:   vertical-align: top;
1.777     tempelho 6431: }
1.795     www      6432: 
1.716     raeburn  6433: div.LC_createcourse {
1.911     bisitz   6434:   margin: 10px 10px 10px 10px;
1.716     raeburn  6435: }
                   6436: 
1.917     raeburn  6437: .LC_dccid {
                   6438:   margin: 0.2em 0 0 0;
                   6439:   padding: 0;
                   6440:   font-size: 90%;
                   6441:   display:none;
                   6442: }
                   6443: 
1.897     wenzelju 6444: ol.LC_primary_menu a:hover,
1.721     harmsja  6445: ol#LC_MenuBreadcrumbs a:hover,
                   6446: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6447: ul#LC_secondary_menu a:hover,
1.721     harmsja  6448: .LC_FormSectionClearButton input:hover
1.795     www      6449: ul.LC_TabContent   li:hover a {
1.952     onken    6450:   color:$button_hover;
1.911     bisitz   6451:   text-decoration:none;
1.693     droeschl 6452: }
                   6453: 
1.779     bisitz   6454: h1 {
1.911     bisitz   6455:   padding: 0;
                   6456:   line-height:130%;
1.693     droeschl 6457: }
1.698     harmsja  6458: 
1.911     bisitz   6459: h2,
                   6460: h3,
                   6461: h4,
                   6462: h5,
                   6463: h6 {
                   6464:   margin: 5px 0 5px 0;
                   6465:   padding: 0;
                   6466:   line-height:130%;
1.693     droeschl 6467: }
1.795     www      6468: 
                   6469: .LC_hcell {
1.911     bisitz   6470:   padding:3px 15px 3px 15px;
                   6471:   margin: 0;
                   6472:   background-color:$tabbg;
                   6473:   color:$fontmenu;
                   6474:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6475: }
1.795     www      6476: 
1.840     bisitz   6477: .LC_Box > .LC_hcell {
1.911     bisitz   6478:   margin: 0 -10px 10px -10px;
1.835     bisitz   6479: }
                   6480: 
1.721     harmsja  6481: .LC_noBorder {
1.911     bisitz   6482:   border: 0;
1.698     harmsja  6483: }
1.693     droeschl 6484: 
1.721     harmsja  6485: .LC_FormSectionClearButton input {
1.911     bisitz   6486:   background-color:transparent;
                   6487:   border: none;
                   6488:   cursor:pointer;
                   6489:   text-decoration:underline;
1.693     droeschl 6490: }
1.763     bisitz   6491: 
                   6492: .LC_help_open_topic {
1.911     bisitz   6493:   color: #FFFFFF;
                   6494:   background-color: #EEEEFF;
                   6495:   margin: 1px;
                   6496:   padding: 4px;
                   6497:   border: 1px solid #000033;
                   6498:   white-space: nowrap;
                   6499:   /* vertical-align: middle; */
1.759     neumanie 6500: }
1.693     droeschl 6501: 
1.911     bisitz   6502: dl,
                   6503: ul,
                   6504: div,
                   6505: fieldset {
                   6506:   margin: 10px 10px 10px 0;
                   6507:   /* overflow: hidden; */
1.693     droeschl 6508: }
1.795     www      6509: 
1.838     bisitz   6510: fieldset > legend {
1.911     bisitz   6511:   font-weight: bold;
                   6512:   padding: 0 5px 0 5px;
1.838     bisitz   6513: }
                   6514: 
1.813     bisitz   6515: #LC_nav_bar {
1.911     bisitz   6516:   float: left;
1.995     raeburn  6517:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6518:   margin: 0 0 2px 0;
1.807     droeschl 6519: }
                   6520: 
1.916     droeschl 6521: #LC_realm {
                   6522:   margin: 0.2em 0 0 0;
                   6523:   padding: 0;
                   6524:   font-weight: bold;
                   6525:   text-align: center;
1.995     raeburn  6526:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6527: }
                   6528: 
1.911     bisitz   6529: #LC_nav_bar em {
                   6530:   font-weight: bold;
                   6531:   font-style: normal;
1.807     droeschl 6532: }
                   6533: 
1.897     wenzelju 6534: ol.LC_primary_menu {
1.911     bisitz   6535:   float: right;
1.934     droeschl 6536:   margin: 0;
1.1075.2.2  raeburn  6537:   padding: 0;
1.995     raeburn  6538:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6539: }
                   6540: 
1.852     droeschl 6541: ol#LC_PathBreadcrumbs {
1.911     bisitz   6542:   margin: 0;
1.693     droeschl 6543: }
                   6544: 
1.897     wenzelju 6545: ol.LC_primary_menu li {
1.1075.2.2  raeburn  6546:   color: RGB(80, 80, 80);
                   6547:   vertical-align: middle;
                   6548:   text-align: left;
                   6549:   list-style: none;
                   6550:   float: left;
                   6551: }
                   6552: 
                   6553: ol.LC_primary_menu li a {
                   6554:   display: block;
                   6555:   margin: 0;
                   6556:   padding: 0 5px 0 10px;
                   6557:   text-decoration: none;
                   6558: }
                   6559: 
                   6560: ol.LC_primary_menu li ul {
                   6561:   display: none;
                   6562:   width: 10em;
                   6563:   background-color: $data_table_light;
                   6564: }
                   6565: 
                   6566: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
                   6567:   display: block;
                   6568:   position: absolute;
                   6569:   margin: 0;
                   6570:   padding: 0;
1.1075.2.5  raeburn  6571:   z-index: 2;
1.1075.2.2  raeburn  6572: }
                   6573: 
                   6574: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
                   6575:   font-size: 90%;
1.911     bisitz   6576:   vertical-align: top;
1.1075.2.2  raeburn  6577:   float: none;
1.1075.2.5  raeburn  6578:   border-left: 1px solid black;
                   6579:   border-right: 1px solid black;
1.1075.2.2  raeburn  6580: }
                   6581: 
                   6582: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1075.2.5  raeburn  6583:   background-color:$data_table_light;
1.1075.2.2  raeburn  6584: }
                   6585: 
                   6586: ol.LC_primary_menu li li a:hover {
                   6587:    color:$button_hover;
                   6588:    background-color:$data_table_dark;
1.693     droeschl 6589: }
                   6590: 
1.897     wenzelju 6591: ol.LC_primary_menu li img {
1.911     bisitz   6592:   vertical-align: bottom;
1.934     droeschl 6593:   height: 1.1em;
1.1075.2.3  raeburn  6594:   margin: 0.2em 0 0 0;
1.693     droeschl 6595: }
                   6596: 
1.897     wenzelju 6597: ol.LC_primary_menu a {
1.911     bisitz   6598:   color: RGB(80, 80, 80);
                   6599:   text-decoration: none;
1.693     droeschl 6600: }
1.795     www      6601: 
1.949     droeschl 6602: ol.LC_primary_menu a.LC_new_message {
                   6603:   font-weight:bold;
                   6604:   color: darkred;
                   6605: }
                   6606: 
1.975     raeburn  6607: ol.LC_docs_parameters {
                   6608:   margin-left: 0;
                   6609:   padding: 0;
                   6610:   list-style: none;
                   6611: }
                   6612: 
                   6613: ol.LC_docs_parameters li {
                   6614:   margin: 0;
                   6615:   padding-right: 20px;
                   6616:   display: inline;
                   6617: }
                   6618: 
1.976     raeburn  6619: ol.LC_docs_parameters li:before {
                   6620:   content: "\\002022 \\0020";
                   6621: }
                   6622: 
                   6623: li.LC_docs_parameters_title {
                   6624:   font-weight: bold;
                   6625: }
                   6626: 
                   6627: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6628:   content: "";
                   6629: }
                   6630: 
1.897     wenzelju 6631: ul#LC_secondary_menu {
1.1075.2.23  raeburn  6632:   clear: right;
1.911     bisitz   6633:   color: $fontmenu;
                   6634:   background: $tabbg;
                   6635:   list-style: none;
                   6636:   padding: 0;
                   6637:   margin: 0;
                   6638:   width: 100%;
1.995     raeburn  6639:   text-align: left;
1.1075.2.4  raeburn  6640:   float: left;
1.808     droeschl 6641: }
                   6642: 
1.897     wenzelju 6643: ul#LC_secondary_menu li {
1.911     bisitz   6644:   font-weight: bold;
                   6645:   line-height: 1.8em;
                   6646:   border-right: 1px solid black;
                   6647:   vertical-align: middle;
1.1075.2.4  raeburn  6648:   float: left;
                   6649: }
                   6650: 
                   6651: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   6652:   background-color: $data_table_light;
                   6653: }
                   6654: 
                   6655: ul#LC_secondary_menu li a {
                   6656:   padding: 0 0.8em;
                   6657: }
                   6658: 
                   6659: ul#LC_secondary_menu li ul {
                   6660:   display: none;
                   6661: }
                   6662: 
                   6663: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   6664:   display: block;
                   6665:   position: absolute;
                   6666:   margin: 0;
                   6667:   padding: 0;
                   6668:   list-style:none;
                   6669:   float: none;
                   6670:   background-color: $data_table_light;
1.1075.2.5  raeburn  6671:   z-index: 2;
1.1075.2.10  raeburn  6672:   margin-left: -1px;
1.1075.2.4  raeburn  6673: }
                   6674: 
                   6675: ul#LC_secondary_menu li ul li {
                   6676:   font-size: 90%;
                   6677:   vertical-align: top;
                   6678:   border-left: 1px solid black;
                   6679:   border-right: 1px solid black;
                   6680:   background-color: $data_table_light
                   6681:   list-style:none;
                   6682:   float: none;
                   6683: }
                   6684: 
                   6685: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   6686:   background-color: $data_table_dark;
1.807     droeschl 6687: }
                   6688: 
1.847     tempelho 6689: ul.LC_TabContent {
1.911     bisitz   6690:   display:block;
                   6691:   background: $sidebg;
                   6692:   border-bottom: solid 1px $lg_border_color;
                   6693:   list-style:none;
1.1020    raeburn  6694:   margin: -1px -10px 0 -10px;
1.911     bisitz   6695:   padding: 0;
1.693     droeschl 6696: }
                   6697: 
1.795     www      6698: ul.LC_TabContent li,
                   6699: ul.LC_TabContentBigger li {
1.911     bisitz   6700:   float:left;
1.741     harmsja  6701: }
1.795     www      6702: 
1.897     wenzelju 6703: ul#LC_secondary_menu li a {
1.911     bisitz   6704:   color: $fontmenu;
                   6705:   text-decoration: none;
1.693     droeschl 6706: }
1.795     www      6707: 
1.721     harmsja  6708: ul.LC_TabContent {
1.952     onken    6709:   min-height:20px;
1.721     harmsja  6710: }
1.795     www      6711: 
                   6712: ul.LC_TabContent li {
1.911     bisitz   6713:   vertical-align:middle;
1.959     onken    6714:   padding: 0 16px 0 10px;
1.911     bisitz   6715:   background-color:$tabbg;
                   6716:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6717:   border-left: solid 1px $font;
1.721     harmsja  6718: }
1.795     www      6719: 
1.847     tempelho 6720: ul.LC_TabContent .right {
1.911     bisitz   6721:   float:right;
1.847     tempelho 6722: }
                   6723: 
1.911     bisitz   6724: ul.LC_TabContent li a,
                   6725: ul.LC_TabContent li {
                   6726:   color:rgb(47,47,47);
                   6727:   text-decoration:none;
                   6728:   font-size:95%;
                   6729:   font-weight:bold;
1.952     onken    6730:   min-height:20px;
                   6731: }
                   6732: 
1.959     onken    6733: ul.LC_TabContent li a:hover,
                   6734: ul.LC_TabContent li a:focus {
1.952     onken    6735:   color: $button_hover;
1.959     onken    6736:   background:none;
                   6737:   outline:none;
1.952     onken    6738: }
                   6739: 
                   6740: ul.LC_TabContent li:hover {
                   6741:   color: $button_hover;
                   6742:   cursor:pointer;
1.721     harmsja  6743: }
1.795     www      6744: 
1.911     bisitz   6745: ul.LC_TabContent li.active {
1.952     onken    6746:   color: $font;
1.911     bisitz   6747:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6748:   border-bottom:solid 1px #FFFFFF;
                   6749:   cursor: default;
1.744     ehlerst  6750: }
1.795     www      6751: 
1.959     onken    6752: ul.LC_TabContent li.active a {
                   6753:   color:$font;
                   6754:   background:#FFFFFF;
                   6755:   outline: none;
                   6756: }
1.1047    raeburn  6757: 
                   6758: ul.LC_TabContent li.goback {
                   6759:   float: left;
                   6760:   border-left: none;
                   6761: }
                   6762: 
1.870     tempelho 6763: #maincoursedoc {
1.911     bisitz   6764:   clear:both;
1.870     tempelho 6765: }
                   6766: 
                   6767: ul.LC_TabContentBigger {
1.911     bisitz   6768:   display:block;
                   6769:   list-style:none;
                   6770:   padding: 0;
1.870     tempelho 6771: }
                   6772: 
1.795     www      6773: ul.LC_TabContentBigger li {
1.911     bisitz   6774:   vertical-align:bottom;
                   6775:   height: 30px;
                   6776:   font-size:110%;
                   6777:   font-weight:bold;
                   6778:   color: #737373;
1.841     tempelho 6779: }
                   6780: 
1.957     onken    6781: ul.LC_TabContentBigger li.active {
                   6782:   position: relative;
                   6783:   top: 1px;
                   6784: }
                   6785: 
1.870     tempelho 6786: ul.LC_TabContentBigger li a {
1.911     bisitz   6787:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6788:   height: 30px;
                   6789:   line-height: 30px;
                   6790:   text-align: center;
                   6791:   display: block;
                   6792:   text-decoration: none;
1.958     onken    6793:   outline: none;  
1.741     harmsja  6794: }
1.795     www      6795: 
1.870     tempelho 6796: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6797:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6798:   color:$font;
1.744     ehlerst  6799: }
1.795     www      6800: 
1.870     tempelho 6801: ul.LC_TabContentBigger li b {
1.911     bisitz   6802:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6803:   display: block;
                   6804:   float: left;
                   6805:   padding: 0 30px;
1.957     onken    6806:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6807: }
                   6808: 
1.956     onken    6809: ul.LC_TabContentBigger li:hover b {
                   6810:   color:$button_hover;
                   6811: }
                   6812: 
1.870     tempelho 6813: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6814:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6815:   color:$font;
1.957     onken    6816:   border: 0;
1.741     harmsja  6817: }
1.693     droeschl 6818: 
1.870     tempelho 6819: 
1.862     bisitz   6820: ul.LC_CourseBreadcrumbs {
                   6821:   background: $sidebg;
1.1020    raeburn  6822:   height: 2em;
1.862     bisitz   6823:   padding-left: 10px;
1.1020    raeburn  6824:   margin: 0;
1.862     bisitz   6825:   list-style-position: inside;
                   6826: }
                   6827: 
1.911     bisitz   6828: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6829: ol#LC_PathBreadcrumbs {
1.911     bisitz   6830:   padding-left: 10px;
                   6831:   margin: 0;
1.933     droeschl 6832:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6833: }
                   6834: 
1.911     bisitz   6835: ol#LC_MenuBreadcrumbs li,
                   6836: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6837: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6838:   display: inline;
1.933     droeschl 6839:   white-space: normal;  
1.693     droeschl 6840: }
                   6841: 
1.823     bisitz   6842: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6843: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6844:   text-decoration: none;
                   6845:   font-size:90%;
1.693     droeschl 6846: }
1.795     www      6847: 
1.969     droeschl 6848: ol#LC_MenuBreadcrumbs h1 {
                   6849:   display: inline;
                   6850:   font-size: 90%;
                   6851:   line-height: 2.5em;
                   6852:   margin: 0;
                   6853:   padding: 0;
                   6854: }
                   6855: 
1.795     www      6856: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6857:   text-decoration:none;
                   6858:   font-size:100%;
                   6859:   font-weight:bold;
1.693     droeschl 6860: }
1.795     www      6861: 
1.840     bisitz   6862: .LC_Box {
1.911     bisitz   6863:   border: solid 1px $lg_border_color;
                   6864:   padding: 0 10px 10px 10px;
1.746     neumanie 6865: }
1.795     www      6866: 
1.1020    raeburn  6867: .LC_DocsBox {
                   6868:   border: solid 1px $lg_border_color;
                   6869:   padding: 0 0 10px 10px;
                   6870: }
                   6871: 
1.795     www      6872: .LC_AboutMe_Image {
1.911     bisitz   6873:   float:left;
                   6874:   margin-right:10px;
1.747     neumanie 6875: }
1.795     www      6876: 
                   6877: .LC_Clear_AboutMe_Image {
1.911     bisitz   6878:   clear:left;
1.747     neumanie 6879: }
1.795     www      6880: 
1.721     harmsja  6881: dl.LC_ListStyleClean dt {
1.911     bisitz   6882:   padding-right: 5px;
                   6883:   display: table-header-group;
1.693     droeschl 6884: }
                   6885: 
1.721     harmsja  6886: dl.LC_ListStyleClean dd {
1.911     bisitz   6887:   display: table-row;
1.693     droeschl 6888: }
                   6889: 
1.721     harmsja  6890: .LC_ListStyleClean,
                   6891: .LC_ListStyleSimple,
                   6892: .LC_ListStyleNormal,
1.795     www      6893: .LC_ListStyleSpecial {
1.911     bisitz   6894:   /* display:block; */
                   6895:   list-style-position: inside;
                   6896:   list-style-type: none;
                   6897:   overflow: hidden;
                   6898:   padding: 0;
1.693     droeschl 6899: }
                   6900: 
1.721     harmsja  6901: .LC_ListStyleSimple li,
                   6902: .LC_ListStyleSimple dd,
                   6903: .LC_ListStyleNormal li,
                   6904: .LC_ListStyleNormal dd,
                   6905: .LC_ListStyleSpecial li,
1.795     www      6906: .LC_ListStyleSpecial dd {
1.911     bisitz   6907:   margin: 0;
                   6908:   padding: 5px 5px 5px 10px;
                   6909:   clear: both;
1.693     droeschl 6910: }
                   6911: 
1.721     harmsja  6912: .LC_ListStyleClean li,
                   6913: .LC_ListStyleClean dd {
1.911     bisitz   6914:   padding-top: 0;
                   6915:   padding-bottom: 0;
1.693     droeschl 6916: }
                   6917: 
1.721     harmsja  6918: .LC_ListStyleSimple dd,
1.795     www      6919: .LC_ListStyleSimple li {
1.911     bisitz   6920:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 6921: }
                   6922: 
1.721     harmsja  6923: .LC_ListStyleSpecial li,
                   6924: .LC_ListStyleSpecial dd {
1.911     bisitz   6925:   list-style-type: none;
                   6926:   background-color: RGB(220, 220, 220);
                   6927:   margin-bottom: 4px;
1.693     droeschl 6928: }
                   6929: 
1.721     harmsja  6930: table.LC_SimpleTable {
1.911     bisitz   6931:   margin:5px;
                   6932:   border:solid 1px $lg_border_color;
1.795     www      6933: }
1.693     droeschl 6934: 
1.721     harmsja  6935: table.LC_SimpleTable tr {
1.911     bisitz   6936:   padding: 0;
                   6937:   border:solid 1px $lg_border_color;
1.693     droeschl 6938: }
1.795     www      6939: 
                   6940: table.LC_SimpleTable thead {
1.911     bisitz   6941:   background:rgb(220,220,220);
1.693     droeschl 6942: }
                   6943: 
1.721     harmsja  6944: div.LC_columnSection {
1.911     bisitz   6945:   display: block;
                   6946:   clear: both;
                   6947:   overflow: hidden;
                   6948:   margin: 0;
1.693     droeschl 6949: }
                   6950: 
1.721     harmsja  6951: div.LC_columnSection>* {
1.911     bisitz   6952:   float: left;
                   6953:   margin: 10px 20px 10px 0;
                   6954:   overflow:hidden;
1.693     droeschl 6955: }
1.721     harmsja  6956: 
1.795     www      6957: table em {
1.911     bisitz   6958:   font-weight: bold;
                   6959:   font-style: normal;
1.748     schulted 6960: }
1.795     www      6961: 
1.779     bisitz   6962: table.LC_tableBrowseRes,
1.795     www      6963: table.LC_tableOfContent {
1.911     bisitz   6964:   border:none;
                   6965:   border-spacing: 1px;
                   6966:   padding: 3px;
                   6967:   background-color: #FFFFFF;
                   6968:   font-size: 90%;
1.753     droeschl 6969: }
1.789     droeschl 6970: 
1.911     bisitz   6971: table.LC_tableOfContent {
                   6972:   border-collapse: collapse;
1.789     droeschl 6973: }
                   6974: 
1.771     droeschl 6975: table.LC_tableBrowseRes a,
1.768     schulted 6976: table.LC_tableOfContent a {
1.911     bisitz   6977:   background-color: transparent;
                   6978:   text-decoration: none;
1.753     droeschl 6979: }
                   6980: 
1.795     www      6981: table.LC_tableOfContent img {
1.911     bisitz   6982:   border: none;
                   6983:   height: 1.3em;
                   6984:   vertical-align: text-bottom;
                   6985:   margin-right: 0.3em;
1.753     droeschl 6986: }
1.757     schulted 6987: 
1.795     www      6988: a#LC_content_toolbar_firsthomework {
1.911     bisitz   6989:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  6990: }
                   6991: 
1.795     www      6992: a#LC_content_toolbar_everything {
1.911     bisitz   6993:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  6994: }
                   6995: 
1.795     www      6996: a#LC_content_toolbar_uncompleted {
1.911     bisitz   6997:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  6998: }
                   6999: 
1.795     www      7000: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7001:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7002: }
                   7003: 
1.795     www      7004: a#LC_content_toolbar_changefolder {
1.911     bisitz   7005:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7006: }
                   7007: 
1.795     www      7008: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7009:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7010: }
                   7011: 
1.1043    raeburn  7012: a#LC_content_toolbar_edittoplevel {
                   7013:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7014: }
                   7015: 
1.795     www      7016: ul#LC_toolbar li a:hover {
1.911     bisitz   7017:   background-position: bottom center;
1.757     schulted 7018: }
                   7019: 
1.795     www      7020: ul#LC_toolbar {
1.911     bisitz   7021:   padding: 0;
                   7022:   margin: 2px;
                   7023:   list-style:none;
                   7024:   position:relative;
                   7025:   background-color:white;
1.1075.2.9  raeburn  7026:   overflow: auto;
1.757     schulted 7027: }
                   7028: 
1.795     www      7029: ul#LC_toolbar li {
1.911     bisitz   7030:   border:1px solid white;
                   7031:   padding: 0;
                   7032:   margin: 0;
                   7033:   float: left;
                   7034:   display:inline;
                   7035:   vertical-align:middle;
1.1075.2.9  raeburn  7036:   white-space: nowrap;
1.911     bisitz   7037: }
1.757     schulted 7038: 
1.783     amueller 7039: 
1.795     www      7040: a.LC_toolbarItem {
1.911     bisitz   7041:   display:block;
                   7042:   padding: 0;
                   7043:   margin: 0;
                   7044:   height: 32px;
                   7045:   width: 32px;
                   7046:   color:white;
                   7047:   border: none;
                   7048:   background-repeat:no-repeat;
                   7049:   background-color:transparent;
1.757     schulted 7050: }
                   7051: 
1.915     droeschl 7052: ul.LC_funclist {
                   7053:     margin: 0;
                   7054:     padding: 0.5em 1em 0.5em 0;
                   7055: }
                   7056: 
1.933     droeschl 7057: ul.LC_funclist > li:first-child {
                   7058:     font-weight:bold; 
                   7059:     margin-left:0.8em;
                   7060: }
                   7061: 
1.915     droeschl 7062: ul.LC_funclist + ul.LC_funclist {
                   7063:     /* 
                   7064:        left border as a seperator if we have more than
                   7065:        one list 
                   7066:     */
                   7067:     border-left: 1px solid $sidebg;
                   7068:     /* 
                   7069:        this hides the left border behind the border of the 
                   7070:        outer box if element is wrapped to the next 'line' 
                   7071:     */
                   7072:     margin-left: -1px;
                   7073: }
                   7074: 
1.843     bisitz   7075: ul.LC_funclist li {
1.915     droeschl 7076:   display: inline;
1.782     bisitz   7077:   white-space: nowrap;
1.915     droeschl 7078:   margin: 0 0 0 25px;
                   7079:   line-height: 150%;
1.782     bisitz   7080: }
                   7081: 
1.974     wenzelju 7082: .LC_hidden {
                   7083:   display: none;
                   7084: }
                   7085: 
1.1030    www      7086: .LCmodal-overlay {
                   7087: 		position:fixed;
                   7088: 		top:0;
                   7089: 		right:0;
                   7090: 		bottom:0;
                   7091: 		left:0;
                   7092: 		height:100%;
                   7093: 		width:100%;
                   7094: 		margin:0;
                   7095: 		padding:0;
                   7096: 		background:#999;
                   7097: 		opacity:.75;
                   7098: 		filter: alpha(opacity=75);
                   7099: 		-moz-opacity: 0.75;
                   7100: 		z-index:101;
                   7101: }
                   7102: 
                   7103: * html .LCmodal-overlay {   
                   7104: 		position: absolute;
                   7105: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7106: }
                   7107: 
                   7108: .LCmodal-window {
                   7109: 		position:fixed;
                   7110: 		top:50%;
                   7111: 		left:50%;
                   7112: 		margin:0;
                   7113: 		padding:0;
                   7114: 		z-index:102;
                   7115: 	}
                   7116: 
                   7117: * html .LCmodal-window {
                   7118: 		position:absolute;
                   7119: }
                   7120: 
                   7121: .LCclose-window {
                   7122: 		position:absolute;
                   7123: 		width:32px;
                   7124: 		height:32px;
                   7125: 		right:8px;
                   7126: 		top:8px;
                   7127: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7128: 		text-indent:-99999px;
                   7129: 		overflow:hidden;
                   7130: 		cursor:pointer;
                   7131: }
                   7132: 
1.1075.2.17  raeburn  7133: /*
                   7134:   styles used by TTH when "Default set of options to pass to tth/m
                   7135:   when converting TeX" in course settings has been set
                   7136: 
                   7137:   option passed: -t
                   7138: 
                   7139: */
                   7140: 
                   7141: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7142: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7143: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7144: td div.norm {line-height:normal;}
                   7145: 
                   7146: /*
                   7147:   option passed -y3
                   7148: */
                   7149: 
                   7150: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7151: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7152: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7153: 
1.343     albertel 7154: END
                   7155: }
                   7156: 
1.306     albertel 7157: =pod
                   7158: 
                   7159: =item * &headtag()
                   7160: 
                   7161: Returns a uniform footer for LON-CAPA web pages.
                   7162: 
1.307     albertel 7163: Inputs: $title - optional title for the head
                   7164:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7165:         $args - optional arguments
1.319     albertel 7166:             force_register - if is true call registerurl so the remote is 
                   7167:                              informed
1.415     albertel 7168:             redirect       -> array ref of
                   7169:                                    1- seconds before redirect occurs
                   7170:                                    2- url to redirect to
                   7171:                                    3- whether the side effect should occur
1.315     albertel 7172:                            (side effect of setting 
                   7173:                                $env{'internal.head.redirect'} to the url 
                   7174:                                redirected too)
1.352     albertel 7175:             domain         -> force to color decorate a page for a specific
                   7176:                                domain
                   7177:             function       -> force usage of a specific rolish color scheme
                   7178:             bgcolor        -> override the default page bgcolor
1.460     albertel 7179:             no_auto_mt_title
                   7180:                            -> prevent &mt()ing the title arg
1.464     albertel 7181: 
1.306     albertel 7182: =cut
                   7183: 
                   7184: sub headtag {
1.313     albertel 7185:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7186:     
1.363     albertel 7187:     my $function = $args->{'function'} || &get_users_function();
                   7188:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7189:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.418     albertel 7190:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7191: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7192: 		   #time(),
1.418     albertel 7193: 		   $env{'environment.color.timestamp'},
1.363     albertel 7194: 		   $function,$domain,$bgcolor);
                   7195: 
1.369     www      7196:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7197: 
1.308     albertel 7198:     my $result =
                   7199: 	'<head>'.
1.461     albertel 7200: 	&font_settings();
1.319     albertel 7201: 
1.1064    raeburn  7202:     my $inhibitprint = &print_suppression();
                   7203: 
1.461     albertel 7204:     if (!$args->{'frameset'}) {
                   7205: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7206:     }
1.1075.2.12  raeburn  7207:     if ($args->{'force_register'}) {
                   7208:         $result .= &Apache::lonmenu::registerurl(1);
1.319     albertel 7209:     }
1.436     albertel 7210:     if (!$args->{'no_nav_bar'} 
                   7211: 	&& !$args->{'only_body'}
                   7212: 	&& !$args->{'frameset'}) {
                   7213: 	$result .= &help_menu_js();
1.1032    www      7214:         $result.=&modal_window();
1.1038    www      7215:         $result.=&togglebox_script();
1.1034    www      7216:         $result.=&wishlist_window();
1.1041    www      7217:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7218:     } else {
                   7219:         if ($args->{'add_modal'}) {
                   7220:            $result.=&modal_window();
                   7221:         }
                   7222:         if ($args->{'add_wishlist'}) {
                   7223:            $result.=&wishlist_window();
                   7224:         }
1.1038    www      7225:         if ($args->{'add_togglebox'}) {
                   7226:            $result.=&togglebox_script();
                   7227:         }
1.1041    www      7228:         if ($args->{'add_progressbar'}) {
                   7229:            $result.=&LCprogressbarUpdate_script();
                   7230:         }
1.436     albertel 7231:     }
1.314     albertel 7232:     if (ref($args->{'redirect'})) {
1.414     albertel 7233: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7234: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7235: 	if (!$inhibit_continue) {
                   7236: 	    $env{'internal.head.redirect'} = $url;
                   7237: 	}
1.313     albertel 7238: 	$result.=<<ADDMETA
                   7239: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7240: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7241: ADDMETA
                   7242:     }
1.306     albertel 7243:     if (!defined($title)) {
                   7244: 	$title = 'The LearningOnline Network with CAPA';
                   7245:     }
1.460     albertel 7246:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7247:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 7248: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
1.1064    raeburn  7249:         .$inhibitprint
1.414     albertel 7250: 	.$head_extra;
1.962     droeschl 7251:     return $result.'</head>';
1.306     albertel 7252: }
                   7253: 
                   7254: =pod
                   7255: 
1.340     albertel 7256: =item * &font_settings()
                   7257: 
                   7258: Returns neccessary <meta> to set the proper encoding
                   7259: 
                   7260: Inputs: none
                   7261: 
                   7262: =cut
                   7263: 
                   7264: sub font_settings {
                   7265:     my $headerstring='';
1.647     www      7266:     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340     albertel 7267: 	$headerstring.=
                   7268: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   7269:     }
                   7270:     return $headerstring;
                   7271: }
                   7272: 
1.341     albertel 7273: =pod
                   7274: 
1.1064    raeburn  7275: =item * &print_suppression()
                   7276: 
                   7277: In course context returns css which causes the body to be blank when media="print",
                   7278: if printout generation is unavailable for the current resource.
                   7279: 
                   7280: This could be because:
                   7281: 
                   7282: (a) printstartdate is in the future
                   7283: 
                   7284: (b) printenddate is in the past
                   7285: 
                   7286: (c) there is an active exam block with "printout"
                   7287: functionality blocked
                   7288: 
                   7289: Users with pav, pfo or evb privileges are exempt.
                   7290: 
                   7291: Inputs: none
                   7292: 
                   7293: =cut
                   7294: 
                   7295: 
                   7296: sub print_suppression {
                   7297:     my $noprint;
                   7298:     if ($env{'request.course.id'}) {
                   7299:         my $scope = $env{'request.course.id'};
                   7300:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7301:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7302:             return;
                   7303:         }
                   7304:         if ($env{'request.course.sec'} ne '') {
                   7305:             $scope .= "/$env{'request.course.sec'}";
                   7306:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7307:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7308:                 return;
1.1064    raeburn  7309:             }
                   7310:         }
                   7311:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7312:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1065    raeburn  7313:         my $blocked = &blocking_status('printout',$cnum,$cdom);
1.1064    raeburn  7314:         if ($blocked) {
                   7315:             my $checkrole = "cm./$cdom/$cnum";
                   7316:             if ($env{'request.course.sec'} ne '') {
                   7317:                 $checkrole .= "/$env{'request.course.sec'}";
                   7318:             }
                   7319:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7320:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7321:                 $noprint = 1;
                   7322:             }
                   7323:         }
                   7324:         unless ($noprint) {
                   7325:             my $symb = &Apache::lonnet::symbread();
                   7326:             if ($symb ne '') {
                   7327:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7328:                 if (ref($navmap)) {
                   7329:                     my $res = $navmap->getBySymb($symb);
                   7330:                     if (ref($res)) {
                   7331:                         if (!$res->resprintable()) {
                   7332:                             $noprint = 1;
                   7333:                         }
                   7334:                     }
                   7335:                 }
                   7336:             }
                   7337:         }
                   7338:         if ($noprint) {
                   7339:             return <<"ENDSTYLE";
                   7340: <style type="text/css" media="print">
                   7341:     body { display:none }
                   7342: </style>
                   7343: ENDSTYLE
                   7344:         }
                   7345:     }
                   7346:     return;
                   7347: }
                   7348: 
                   7349: =pod
                   7350: 
1.341     albertel 7351: =item * &xml_begin()
                   7352: 
                   7353: Returns the needed doctype and <html>
                   7354: 
                   7355: Inputs: none
                   7356: 
                   7357: =cut
                   7358: 
                   7359: sub xml_begin {
                   7360:     my $output='';
                   7361: 
                   7362:     if ($env{'browser.mathml'}) {
                   7363: 	$output='<?xml version="1.0"?>'
                   7364:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7365: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7366:             
                   7367: #	    .'<!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">] >'
                   7368: 	    .'<!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">'
                   7369:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7370: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   7371:     } else {
1.849     bisitz   7372: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
                   7373:            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341     albertel 7374:     }
                   7375:     return $output;
                   7376: }
1.340     albertel 7377: 
                   7378: =pod
                   7379: 
1.306     albertel 7380: =item * &start_page()
                   7381: 
                   7382: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7383: 
1.648     raeburn  7384: Inputs:
                   7385: 
                   7386: =over 4
                   7387: 
                   7388: $title - optional title for the page
                   7389: 
                   7390: $head_extra - optional extra HTML to incude inside the <head>
                   7391: 
                   7392: $args - additional optional args supported are:
                   7393: 
                   7394: =over 8
                   7395: 
                   7396:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 7397:                                     arg on
1.814     bisitz   7398:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  7399:              add_entries    -> additional attributes to add to the  <body>
                   7400:              domain         -> force to color decorate a page for a 
1.317     albertel 7401:                                     specific domain
1.648     raeburn  7402:              function       -> force usage of a specific rolish color
1.317     albertel 7403:                                     scheme
1.648     raeburn  7404:              redirect       -> see &headtag()
                   7405:              bgcolor        -> override the default page bg color
                   7406:              js_ready       -> return a string ready for being used in 
1.317     albertel 7407:                                     a javascript writeln
1.648     raeburn  7408:              html_encode    -> return a string ready for being used in 
1.320     albertel 7409:                                     a html attribute
1.648     raeburn  7410:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 7411:                                     $forcereg arg
1.648     raeburn  7412:              frameset       -> if true will start with a <frameset>
1.330     albertel 7413:                                     rather than <body>
1.648     raeburn  7414:              skip_phases    -> hash ref of 
1.338     albertel 7415:                                     head -> skip the <html><head> generation
                   7416:                                     body -> skip all <body> generation
1.1075.2.12  raeburn  7417:              no_inline_link -> if true and in remote mode, don't show the
                   7418:                                     'Switch To Inline Menu' link
1.648     raeburn  7419:              no_auto_mt_title -> prevent &mt()ing the title arg
                   7420:              inherit_jsmath -> when creating popup window in a page,
                   7421:                                     should it have jsmath forced on by the
                   7422:                                     current page
1.867     kalberla 7423:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  7424:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1075.2.15  raeburn  7425:              group          -> includes the current group, if page is for a
                   7426:                                specific group
1.361     albertel 7427: 
1.648     raeburn  7428: =back
1.460     albertel 7429: 
1.648     raeburn  7430: =back
1.562     albertel 7431: 
1.306     albertel 7432: =cut
                   7433: 
                   7434: sub start_page {
1.309     albertel 7435:     my ($title,$head_extra,$args) = @_;
1.318     albertel 7436:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 7437: 
1.315     albertel 7438:     $env{'internal.start_page'}++;
1.1075.2.15  raeburn  7439:     my ($result,@advtools);
1.964     droeschl 7440: 
1.338     albertel 7441:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1030    www      7442:         $result .= &xml_begin() . &headtag($title, $head_extra, $args);
1.338     albertel 7443:     }
                   7444:     
                   7445:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   7446: 	if ($args->{'frameset'}) {
                   7447: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   7448: 						$args->{'add_entries'});
                   7449: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   7450:         } else {
                   7451:             $result .=
                   7452:                 &bodytag($title, 
                   7453:                          $args->{'function'},       $args->{'add_entries'},
                   7454:                          $args->{'only_body'},      $args->{'domain'},
                   7455:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12  raeburn  7456:                          $args->{'bgcolor'},        $args->{'no_inline_link'},
1.1075.2.15  raeburn  7457:                          $args,                     \@advtools);
1.831     bisitz   7458:         }
1.330     albertel 7459:     }
1.338     albertel 7460: 
1.315     albertel 7461:     if ($args->{'js_ready'}) {
1.713     kaisler  7462: 		$result = &js_ready($result);
1.315     albertel 7463:     }
1.320     albertel 7464:     if ($args->{'html_encode'}) {
1.713     kaisler  7465: 		$result = &html_encode($result);
                   7466:     }
                   7467: 
1.813     bisitz   7468:     # Preparation for new and consistent functionlist at top of screen
                   7469:     # if ($args->{'functionlist'}) {
                   7470:     #            $result .= &build_functionlist();
                   7471:     #}
                   7472: 
1.964     droeschl 7473:     # Don't add anything more if only_body wanted or in const space
                   7474:     return $result if    $args->{'only_body'} 
                   7475:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   7476: 
                   7477:     #Breadcrumbs
1.758     kaisler  7478:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   7479: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   7480: 		#if any br links exists, add them to the breadcrumbs
                   7481: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   7482: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   7483: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   7484: 			}
                   7485: 		}
1.1075.2.19  raeburn  7486:                 # if @advtools array contains items add then to the breadcrumbs
                   7487:                 if (@advtools > 0) {
                   7488:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   7489:                 }
1.758     kaisler  7490: 
                   7491: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   7492: 		if(exists($args->{'bread_crumbs_component'})){
                   7493: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   7494: 		}else{
                   7495: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   7496: 		}
1.1075.2.24  raeburn  7497:     } elsif (($env{'environment.remote'} eq 'on') &&
                   7498:              ($env{'form.inhibitmenu'} ne 'yes') &&
                   7499:              ($env{'request.noversionuri'} =~ m{^/res/}) &&
                   7500:              ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21  raeburn  7501:         $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320     albertel 7502:     }
1.315     albertel 7503:     return $result;
1.306     albertel 7504: }
                   7505: 
                   7506: sub end_page {
1.315     albertel 7507:     my ($args) = @_;
                   7508:     $env{'internal.end_page'}++;
1.330     albertel 7509:     my $result;
1.335     albertel 7510:     if ($args->{'discussion'}) {
                   7511: 	my ($target,$parser);
                   7512: 	if (ref($args->{'discussion'})) {
                   7513: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   7514: 				$args->{'discussion'}{'parser'});
                   7515: 	}
                   7516: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   7517:     }
1.330     albertel 7518:     if ($args->{'frameset'}) {
                   7519: 	$result .= '</frameset>';
                   7520:     } else {
1.635     raeburn  7521: 	$result .= &endbodytag($args);
1.330     albertel 7522:     }
1.1075.2.6  raeburn  7523:     unless ($args->{'notbody'}) {
                   7524:         $result .= "\n</html>";
                   7525:     }
1.330     albertel 7526: 
1.315     albertel 7527:     if ($args->{'js_ready'}) {
1.317     albertel 7528: 	$result = &js_ready($result);
1.315     albertel 7529:     }
1.335     albertel 7530: 
1.320     albertel 7531:     if ($args->{'html_encode'}) {
                   7532: 	$result = &html_encode($result);
                   7533:     }
1.335     albertel 7534: 
1.315     albertel 7535:     return $result;
                   7536: }
                   7537: 
1.1034    www      7538: sub wishlist_window {
                   7539:     return(<<'ENDWISHLIST');
1.1046    raeburn  7540: <script type="text/javascript">
1.1034    www      7541: // <![CDATA[
                   7542: // <!-- BEGIN LON-CAPA Internal
                   7543: function set_wishlistlink(title, path) {
                   7544:     if (!title) {
                   7545:         title = document.title;
                   7546:         title = title.replace(/^LON-CAPA /,'');
                   7547:     }
                   7548:     if (!path) {
                   7549:         path = location.pathname;
                   7550:     }
                   7551:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   7552:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   7553: }
                   7554: // END LON-CAPA Internal -->
                   7555: // ]]>
                   7556: </script>
                   7557: ENDWISHLIST
                   7558: }
                   7559: 
1.1030    www      7560: sub modal_window {
                   7561:     return(<<'ENDMODAL');
1.1046    raeburn  7562: <script type="text/javascript">
1.1030    www      7563: // <![CDATA[
                   7564: // <!-- BEGIN LON-CAPA Internal
                   7565: var modalWindow = {
                   7566: 	parent:"body",
                   7567: 	windowId:null,
                   7568: 	content:null,
                   7569: 	width:null,
                   7570: 	height:null,
                   7571: 	close:function()
                   7572: 	{
                   7573: 	        $(".LCmodal-window").remove();
                   7574: 	        $(".LCmodal-overlay").remove();
                   7575: 	},
                   7576: 	open:function()
                   7577: 	{
                   7578: 		var modal = "";
                   7579: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7580: 		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;\">";
                   7581: 		modal += this.content;
                   7582: 		modal += "</div>";	
                   7583: 
                   7584: 		$(this.parent).append(modal);
                   7585: 
                   7586: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7587: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7588: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7589: 	}
                   7590: };
1.1031    www      7591: 	var openMyModal = function(source,width,height,scrolling)
1.1030    www      7592: 	{
                   7593: 		modalWindow.windowId = "myModal";
                   7594: 		modalWindow.width = width;
                   7595: 		modalWindow.height = height;
1.1031    www      7596: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='true' src='" + source + "'>&lt/iframe>";
1.1030    www      7597: 		modalWindow.open();
                   7598: 	};	
                   7599: // END LON-CAPA Internal -->
                   7600: // ]]>
                   7601: </script>
                   7602: ENDMODAL
                   7603: }
                   7604: 
                   7605: sub modal_link {
1.1052    www      7606:     my ($link,$linktext,$width,$height,$target,$scrolling,$title)=@_;
1.1030    www      7607:     unless ($width) { $width=480; }
                   7608:     unless ($height) { $height=400; }
1.1031    www      7609:     unless ($scrolling) { $scrolling='yes'; }
1.1074    raeburn  7610:     my $target_attr;
                   7611:     if (defined($target)) {
                   7612:         $target_attr = 'target="'.$target.'"';
                   7613:     }
                   7614:     return <<"ENDLINK";
                   7615: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling'); return false;">
                   7616:            $linktext</a>
                   7617: ENDLINK
1.1030    www      7618: }
                   7619: 
1.1032    www      7620: sub modal_adhoc_script {
                   7621:     my ($funcname,$width,$height,$content)=@_;
                   7622:     return (<<ENDADHOC);
1.1046    raeburn  7623: <script type="text/javascript">
1.1032    www      7624: // <![CDATA[
                   7625:         var $funcname = function()
                   7626:         {
                   7627:                 modalWindow.windowId = "myModal";
                   7628:                 modalWindow.width = $width;
                   7629:                 modalWindow.height = $height;
                   7630:                 modalWindow.content = '$content';
                   7631:                 modalWindow.open();
                   7632:         };  
                   7633: // ]]>
                   7634: </script>
                   7635: ENDADHOC
                   7636: }
                   7637: 
1.1041    www      7638: sub modal_adhoc_inner {
                   7639:     my ($funcname,$width,$height,$content)=@_;
                   7640:     my $innerwidth=$width-20;
                   7641:     $content=&js_ready(
1.1042    www      7642:                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1041    www      7643:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px').
                   7644:                     $content.
                   7645:                  &end_scrollbox().
                   7646:                &end_page()
                   7647:              );
                   7648:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   7649: }
                   7650: 
                   7651: sub modal_adhoc_window {
                   7652:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7653:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   7654:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7655: }
                   7656: 
                   7657: sub modal_adhoc_launch {
                   7658:     my ($funcname,$width,$height,$content)=@_;
                   7659:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   7660: <script type="text/javascript">
                   7661: // <![CDATA[
                   7662: $funcname();
                   7663: // ]]>
                   7664: </script>
                   7665: ENDLAUNCH
                   7666: }
                   7667: 
                   7668: sub modal_adhoc_close {
                   7669:     return (<<ENDCLOSE);
                   7670: <script type="text/javascript">
                   7671: // <![CDATA[
                   7672: modalWindow.close();
                   7673: // ]]>
                   7674: </script>
                   7675: ENDCLOSE
                   7676: }
                   7677: 
1.1038    www      7678: sub togglebox_script {
                   7679:    return(<<ENDTOGGLE);
                   7680: <script type="text/javascript"> 
                   7681: // <![CDATA[
                   7682: function LCtoggleDisplay(id,hidetext,showtext) {
                   7683:    link = document.getElementById(id + "link").childNodes[0];
                   7684:    with (document.getElementById(id).style) {
                   7685:       if (display == "none" ) {
                   7686:           display = "inline";
                   7687:           link.nodeValue = hidetext;
                   7688:         } else {
                   7689:           display = "none";
                   7690:           link.nodeValue = showtext;
                   7691:        }
                   7692:    }
                   7693: }
                   7694: // ]]>
                   7695: </script>
                   7696: ENDTOGGLE
                   7697: }
                   7698: 
1.1039    www      7699: sub start_togglebox {
                   7700:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7701:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7702:     unless ($showtext) { $showtext=&mt('show'); }
                   7703:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7704:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7705:     return &start_data_table().
                   7706:            &start_data_table_header_row().
                   7707:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7708:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7709:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7710:            &end_data_table_header_row().
                   7711:            '<tr id="'.$id.'" style="display:none""><td>';
                   7712: }
                   7713: 
                   7714: sub end_togglebox {
                   7715:     return '</td></tr>'.&end_data_table();
                   7716: }
                   7717: 
1.1041    www      7718: sub LCprogressbar_script {
1.1045    www      7719:    my ($id)=@_;
1.1041    www      7720:    return(<<ENDPROGRESS);
                   7721: <script type="text/javascript">
                   7722: // <![CDATA[
1.1045    www      7723: \$('#progressbar$id').progressbar({
1.1041    www      7724:   value: 0,
                   7725:   change: function(event, ui) {
                   7726:     var newVal = \$(this).progressbar('option', 'value');
                   7727:     \$('.pblabel', this).text(LCprogressTxt);
                   7728:   }
                   7729: });
                   7730: // ]]>
                   7731: </script>
                   7732: ENDPROGRESS
                   7733: }
                   7734: 
                   7735: sub LCprogressbarUpdate_script {
                   7736:    return(<<ENDPROGRESSUPDATE);
                   7737: <style type="text/css">
                   7738: .ui-progressbar { position:relative; }
                   7739: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   7740: </style>
                   7741: <script type="text/javascript">
                   7742: // <![CDATA[
1.1045    www      7743: var LCprogressTxt='---';
                   7744: 
                   7745: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      7746:    LCprogressTxt=progresstext;
1.1045    www      7747:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      7748: }
                   7749: // ]]>
                   7750: </script>
                   7751: ENDPROGRESSUPDATE
                   7752: }
                   7753: 
1.1042    www      7754: my $LClastpercent;
1.1045    www      7755: my $LCidcnt;
                   7756: my $LCcurrentid;
1.1042    www      7757: 
1.1041    www      7758: sub LCprogressbar {
1.1042    www      7759:     my ($r)=(@_);
                   7760:     $LClastpercent=0;
1.1045    www      7761:     $LCidcnt++;
                   7762:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      7763:     my $starting=&mt('Starting');
                   7764:     my $content=(<<ENDPROGBAR);
                   7765: <p>
1.1045    www      7766:   <div id="progressbar$LCcurrentid">
1.1041    www      7767:     <span class="pblabel">$starting</span>
                   7768:   </div>
                   7769: </p>
                   7770: ENDPROGBAR
1.1045    www      7771:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      7772: }
                   7773: 
                   7774: sub LCprogressbarUpdate {
1.1042    www      7775:     my ($r,$val,$text)=@_;
                   7776:     unless ($val) { 
                   7777:        if ($LClastpercent) {
                   7778:            $val=$LClastpercent;
                   7779:        } else {
                   7780:            $val=0;
                   7781:        }
                   7782:     }
1.1041    www      7783:     if ($val<0) { $val=0; }
                   7784:     if ($val>100) { $val=0; }
1.1042    www      7785:     $LClastpercent=$val;
1.1041    www      7786:     unless ($text) { $text=$val.'%'; }
                   7787:     $text=&js_ready($text);
1.1044    www      7788:     &r_print($r,<<ENDUPDATE);
1.1041    www      7789: <script type="text/javascript">
                   7790: // <![CDATA[
1.1045    www      7791: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      7792: // ]]>
                   7793: </script>
                   7794: ENDUPDATE
1.1035    www      7795: }
                   7796: 
1.1042    www      7797: sub LCprogressbarClose {
                   7798:     my ($r)=@_;
                   7799:     $LClastpercent=0;
1.1044    www      7800:     &r_print($r,<<ENDCLOSE);
1.1042    www      7801: <script type="text/javascript">
                   7802: // <![CDATA[
1.1045    www      7803: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      7804: // ]]>
                   7805: </script>
                   7806: ENDCLOSE
1.1044    www      7807: }
                   7808: 
                   7809: sub r_print {
                   7810:     my ($r,$to_print)=@_;
                   7811:     if ($r) {
                   7812:       $r->print($to_print);
                   7813:       $r->rflush();
                   7814:     } else {
                   7815:       print($to_print);
                   7816:     }
1.1042    www      7817: }
                   7818: 
1.320     albertel 7819: sub html_encode {
                   7820:     my ($result) = @_;
                   7821: 
1.322     albertel 7822:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7823:     
                   7824:     return $result;
                   7825: }
1.1044    www      7826: 
1.317     albertel 7827: sub js_ready {
                   7828:     my ($result) = @_;
                   7829: 
1.323     albertel 7830:     $result =~ s/[\n\r]/ /xmsg;
                   7831:     $result =~ s/\\/\\\\/xmsg;
                   7832:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7833:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7834:     
                   7835:     return $result;
                   7836: }
                   7837: 
1.315     albertel 7838: sub validate_page {
                   7839:     if (  exists($env{'internal.start_page'})
1.316     albertel 7840: 	  &&     $env{'internal.start_page'} > 1) {
                   7841: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7842: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7843: 				 $ENV{'request.filename'});
1.315     albertel 7844:     }
                   7845:     if (  exists($env{'internal.end_page'})
1.316     albertel 7846: 	  &&     $env{'internal.end_page'} > 1) {
                   7847: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7848: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7849: 				 $env{'request.filename'});
1.315     albertel 7850:     }
                   7851:     if (     exists($env{'internal.start_page'})
                   7852: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7853: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7854: 				 $env{'request.filename'});
1.315     albertel 7855:     }
                   7856:     if (   ! exists($env{'internal.start_page'})
                   7857: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7858: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7859: 				 $env{'request.filename'});
1.315     albertel 7860:     }
1.306     albertel 7861: }
1.315     albertel 7862: 
1.996     www      7863: 
                   7864: sub start_scrollbox {
1.1075    raeburn  7865:     my ($outerwidth,$width,$height,$id,$bgcolor)=@_;
1.998     raeburn  7866:     unless ($outerwidth) { $outerwidth='520px'; }
                   7867:     unless ($width) { $width='500px'; }
                   7868:     unless ($height) { $height='200px'; }
1.1075    raeburn  7869:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  7870:     if ($id ne '') {
1.1020    raeburn  7871:         $table_id = " id='table_$id'";
                   7872:         $div_id = " id='div_$id'";
1.1018    raeburn  7873:     }
1.1075    raeburn  7874:     if ($bgcolor ne '') {
                   7875:         $tdcol = "background-color: $bgcolor;";
                   7876:     }
                   7877:     return <<"END";
                   7878: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol"><div style="overflow:auto; width:$width; height: $height;"$div_id>
                   7879: END
1.996     www      7880: }
                   7881: 
                   7882: sub end_scrollbox {
1.1036    www      7883:     return '</div></td></tr></table>';
1.996     www      7884: }
                   7885: 
1.318     albertel 7886: sub simple_error_page {
                   7887:     my ($r,$title,$msg) = @_;
                   7888:     my $page =
                   7889: 	&Apache::loncommon::start_page($title).
1.1075.2.15  raeburn  7890: 	'<p class="LC_error">'.&mt($msg).'</p>'.
1.318     albertel 7891: 	&Apache::loncommon::end_page();
                   7892:     if (ref($r)) {
                   7893: 	$r->print($page);
1.327     albertel 7894: 	return;
1.318     albertel 7895:     }
                   7896:     return $page;
                   7897: }
1.347     albertel 7898: 
                   7899: {
1.610     albertel 7900:     my @row_count;
1.961     onken    7901: 
                   7902:     sub start_data_table_count {
                   7903:         unshift(@row_count, 0);
                   7904:         return;
                   7905:     }
                   7906: 
                   7907:     sub end_data_table_count {
                   7908:         shift(@row_count);
                   7909:         return;
                   7910:     }
                   7911: 
1.347     albertel 7912:     sub start_data_table {
1.1018    raeburn  7913: 	my ($add_class,$id) = @_;
1.422     albertel 7914: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  7915:         my $table_id;
                   7916:         if (defined($id)) {
                   7917:             $table_id = ' id="'.$id.'"';
                   7918:         }
1.961     onken    7919: 	&start_data_table_count();
1.1018    raeburn  7920: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 7921:     }
                   7922: 
                   7923:     sub end_data_table {
1.961     onken    7924: 	&end_data_table_count();
1.389     albertel 7925: 	return '</table>'."\n";;
1.347     albertel 7926:     }
                   7927: 
                   7928:     sub start_data_table_row {
1.974     wenzelju 7929: 	my ($add_class, $id) = @_;
1.610     albertel 7930: 	$row_count[0]++;
                   7931: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   7932: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 7933:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7934:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 7935:     }
1.471     banghart 7936:     
                   7937:     sub continue_data_table_row {
1.974     wenzelju 7938: 	my ($add_class, $id) = @_;
1.610     albertel 7939: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 7940: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   7941:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7942:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 7943:     }
1.347     albertel 7944: 
                   7945:     sub end_data_table_row {
1.389     albertel 7946: 	return '</tr>'."\n";;
1.347     albertel 7947:     }
1.367     www      7948: 
1.421     albertel 7949:     sub start_data_table_empty_row {
1.707     bisitz   7950: #	$row_count[0]++;
1.421     albertel 7951: 	return  '<tr class="LC_empty_row" >'."\n";;
                   7952:     }
                   7953: 
                   7954:     sub end_data_table_empty_row {
                   7955: 	return '</tr>'."\n";;
                   7956:     }
                   7957: 
1.367     www      7958:     sub start_data_table_header_row {
1.389     albertel 7959: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      7960:     }
                   7961: 
                   7962:     sub end_data_table_header_row {
1.389     albertel 7963: 	return '</tr>'."\n";;
1.367     www      7964:     }
1.890     droeschl 7965: 
                   7966:     sub data_table_caption {
                   7967:         my $caption = shift;
                   7968:         return "<caption class=\"LC_caption\">$caption</caption>";
                   7969:     }
1.347     albertel 7970: }
                   7971: 
1.548     albertel 7972: =pod
                   7973: 
                   7974: =item * &inhibit_menu_check($arg)
                   7975: 
                   7976: Checks for a inhibitmenu state and generates output to preserve it
                   7977: 
                   7978: Inputs:         $arg - can be any of
                   7979:                      - undef - in which case the return value is a string 
                   7980:                                to add  into arguments list of a uri
                   7981:                      - 'input' - in which case the return value is a HTML
                   7982:                                  <form> <input> field of type hidden to
                   7983:                                  preserve the value
                   7984:                      - a url - in which case the return value is the url with
                   7985:                                the neccesary cgi args added to preserve the
                   7986:                                inhibitmenu state
                   7987:                      - a ref to a url - no return value, but the string is
                   7988:                                         updated to include the neccessary cgi
                   7989:                                         args to preserve the inhibitmenu state
                   7990: 
                   7991: =cut
                   7992: 
                   7993: sub inhibit_menu_check {
                   7994:     my ($arg) = @_;
                   7995:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   7996:     if ($arg eq 'input') {
                   7997: 	if ($env{'form.inhibitmenu'}) {
                   7998: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   7999: 	} else {
                   8000: 	    return
                   8001: 	}
                   8002:     }
                   8003:     if ($env{'form.inhibitmenu'}) {
                   8004: 	if (ref($arg)) {
                   8005: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8006: 	} elsif ($arg eq '') {
                   8007: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8008: 	} else {
                   8009: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8010: 	}
                   8011:     }
                   8012:     if (!ref($arg)) {
                   8013: 	return $arg;
                   8014:     }
                   8015: }
                   8016: 
1.251     albertel 8017: ###############################################
1.182     matthew  8018: 
                   8019: =pod
                   8020: 
1.549     albertel 8021: =back
                   8022: 
                   8023: =head1 User Information Routines
                   8024: 
                   8025: =over 4
                   8026: 
1.405     albertel 8027: =item * &get_users_function()
1.182     matthew  8028: 
                   8029: Used by &bodytag to determine the current users primary role.
                   8030: Returns either 'student','coordinator','admin', or 'author'.
                   8031: 
                   8032: =cut
                   8033: 
                   8034: ###############################################
                   8035: sub get_users_function {
1.815     tempelho 8036:     my $function = 'norole';
1.818     tempelho 8037:     if ($env{'request.role'}=~/^(st)/) {
                   8038:         $function='student';
                   8039:     }
1.907     raeburn  8040:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8041:         $function='coordinator';
                   8042:     }
1.258     albertel 8043:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8044:         $function='admin';
                   8045:     }
1.826     bisitz   8046:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8047:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8048:         $function='author';
                   8049:     }
                   8050:     return $function;
1.54      www      8051: }
1.99      www      8052: 
                   8053: ###############################################
                   8054: 
1.233     raeburn  8055: =pod
                   8056: 
1.821     raeburn  8057: =item * &show_course()
                   8058: 
                   8059: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8060: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8061: 
                   8062: Inputs:
                   8063: None
                   8064: 
                   8065: Outputs:
                   8066: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8067: 
                   8068: =cut
                   8069: 
                   8070: ###############################################
                   8071: sub show_course {
                   8072:     my $course = !$env{'user.adv'};
                   8073:     if (!$env{'user.adv'}) {
                   8074:         foreach my $env (keys(%env)) {
                   8075:             next if ($env !~ m/^user\.priv\./);
                   8076:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8077:                 $course = 0;
                   8078:                 last;
                   8079:             }
                   8080:         }
                   8081:     }
                   8082:     return $course;
                   8083: }
                   8084: 
                   8085: ###############################################
                   8086: 
                   8087: =pod
                   8088: 
1.542     raeburn  8089: =item * &check_user_status()
1.274     raeburn  8090: 
                   8091: Determines current status of supplied role for a
                   8092: specific user. Roles can be active, previous or future.
                   8093: 
                   8094: Inputs: 
                   8095: user's domain, user's username, course's domain,
1.375     raeburn  8096: course's number, optional section ID.
1.274     raeburn  8097: 
                   8098: Outputs:
                   8099: role status: active, previous or future. 
                   8100: 
                   8101: =cut
                   8102: 
                   8103: sub check_user_status {
1.412     raeburn  8104:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8105:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274     raeburn  8106:     my @uroles = keys %userinfo;
                   8107:     my $srchstr;
                   8108:     my $active_chk = 'none';
1.412     raeburn  8109:     my $now = time;
1.274     raeburn  8110:     if (@uroles > 0) {
1.908     raeburn  8111:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8112:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8113:         } else {
1.412     raeburn  8114:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8115:         }
                   8116:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8117:             my $role_end = 0;
                   8118:             my $role_start = 0;
                   8119:             $active_chk = 'active';
1.412     raeburn  8120:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8121:                 $role_end = $1;
                   8122:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8123:                     $role_start = $1;
1.274     raeburn  8124:                 }
                   8125:             }
                   8126:             if ($role_start > 0) {
1.412     raeburn  8127:                 if ($now < $role_start) {
1.274     raeburn  8128:                     $active_chk = 'future';
                   8129:                 }
                   8130:             }
                   8131:             if ($role_end > 0) {
1.412     raeburn  8132:                 if ($now > $role_end) {
1.274     raeburn  8133:                     $active_chk = 'previous';
                   8134:                 }
                   8135:             }
                   8136:         }
                   8137:     }
                   8138:     return $active_chk;
                   8139: }
                   8140: 
                   8141: ###############################################
                   8142: 
                   8143: =pod
                   8144: 
1.405     albertel 8145: =item * &get_sections()
1.233     raeburn  8146: 
                   8147: Determines all the sections for a course including
                   8148: sections with students and sections containing other roles.
1.419     raeburn  8149: Incoming parameters: 
                   8150: 
                   8151: 1. domain
                   8152: 2. course number 
                   8153: 3. reference to array containing roles for which sections should 
                   8154: be gathered (optional).
                   8155: 4. reference to array containing status types for which sections 
                   8156: should be gathered (optional).
                   8157: 
                   8158: If the third argument is undefined, sections are gathered for any role. 
                   8159: If the fourth argument is undefined, sections are gathered for any status.
                   8160: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  8161:  
1.374     raeburn  8162: Returns section hash (keys are section IDs, values are
                   8163: number of users in each section), subject to the
1.419     raeburn  8164: optional roles filter, optional status filter 
1.233     raeburn  8165: 
                   8166: =cut
                   8167: 
                   8168: ###############################################
                   8169: sub get_sections {
1.419     raeburn  8170:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 8171:     if (!defined($cdom) || !defined($cnum)) {
                   8172:         my $cid =  $env{'request.course.id'};
                   8173: 
                   8174: 	return if (!defined($cid));
                   8175: 
                   8176:         $cdom = $env{'course.'.$cid.'.domain'};
                   8177:         $cnum = $env{'course.'.$cid.'.num'};
                   8178:     }
                   8179: 
                   8180:     my %sectioncount;
1.419     raeburn  8181:     my $now = time;
1.240     albertel 8182: 
1.366     albertel 8183:     if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276     albertel 8184: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 8185: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   8186: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  8187:         my $start_index = &Apache::loncoursedata::CL_START();
                   8188:         my $end_index = &Apache::loncoursedata::CL_END();
                   8189:         my $status;
1.366     albertel 8190: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  8191: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   8192: 				                     $data->[$status_index],
                   8193:                                                      $data->[$start_index],
                   8194:                                                      $data->[$end_index]);
                   8195:             if ($stu_status eq 'Active') {
                   8196:                 $status = 'active';
                   8197:             } elsif ($end < $now) {
                   8198:                 $status = 'previous';
                   8199:             } elsif ($start > $now) {
                   8200:                 $status = 'future';
                   8201:             } 
                   8202: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   8203:                 if ((!defined($possible_status)) || (($status ne '') && 
                   8204:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   8205: 		    $sectioncount{$section}++;
                   8206:                 }
1.240     albertel 8207: 	    }
                   8208: 	}
                   8209:     }
                   8210:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8211:     foreach my $user (sort(keys(%courseroles))) {
                   8212: 	if ($user !~ /^(\w{2})/) { next; }
                   8213: 	my ($role) = ($user =~ /^(\w{2})/);
                   8214: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  8215: 	my ($section,$status);
1.240     albertel 8216: 	if ($role eq 'cr' &&
                   8217: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   8218: 	    $section=$1;
                   8219: 	}
                   8220: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   8221: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  8222:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   8223:         if ($end == -1 && $start == -1) {
                   8224:             next; #deleted role
                   8225:         }
                   8226:         if (!defined($possible_status)) { 
                   8227:             $sectioncount{$section}++;
                   8228:         } else {
                   8229:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   8230:                 $status = 'active';
                   8231:             } elsif ($end < $now) {
                   8232:                 $status = 'future';
                   8233:             } elsif ($start > $now) {
                   8234:                 $status = 'previous';
                   8235:             }
                   8236:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   8237:                 $sectioncount{$section}++;
                   8238:             }
                   8239:         }
1.233     raeburn  8240:     }
1.366     albertel 8241:     return %sectioncount;
1.233     raeburn  8242: }
                   8243: 
1.274     raeburn  8244: ###############################################
1.294     raeburn  8245: 
                   8246: =pod
1.405     albertel 8247: 
                   8248: =item * &get_course_users()
                   8249: 
1.275     raeburn  8250: Retrieves usernames:domains for users in the specified course
                   8251: with specific role(s), and access status. 
                   8252: 
                   8253: Incoming parameters:
1.277     albertel 8254: 1. course domain
                   8255: 2. course number
                   8256: 3. access status: users must have - either active, 
1.275     raeburn  8257: previous, future, or all.
1.277     albertel 8258: 4. reference to array of permissible roles
1.288     raeburn  8259: 5. reference to array of section restrictions (optional)
                   8260: 6. reference to results object (hash of hashes).
                   8261: 7. reference to optional userdata hash
1.609     raeburn  8262: 8. reference to optional statushash
1.630     raeburn  8263: 9. flag if privileged users (except those set to unhide in
                   8264:    course settings) should be excluded    
1.609     raeburn  8265: Keys of top level results hash are roles.
1.275     raeburn  8266: Keys of inner hashes are username:domain, with 
                   8267: values set to access type.
1.288     raeburn  8268: Optional userdata hash returns an array with arguments in the 
                   8269: same order as loncoursedata::get_classlist() for student data.
                   8270: 
1.609     raeburn  8271: Optional statushash returns
                   8272: 
1.288     raeburn  8273: Entries for end, start, section and status are blank because
                   8274: of the possibility of multiple values for non-student roles.
                   8275: 
1.275     raeburn  8276: =cut
1.405     albertel 8277: 
1.275     raeburn  8278: ###############################################
1.405     albertel 8279: 
1.275     raeburn  8280: sub get_course_users {
1.630     raeburn  8281:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  8282:     my %idx = ();
1.419     raeburn  8283:     my %seclists;
1.288     raeburn  8284: 
                   8285:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   8286:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   8287:     $idx{end} = &Apache::loncoursedata::CL_END();
                   8288:     $idx{start} = &Apache::loncoursedata::CL_START();
                   8289:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   8290:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   8291:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   8292:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   8293: 
1.290     albertel 8294:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 8295:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  8296:         my $now = time;
1.277     albertel 8297:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  8298:             my $match = 0;
1.412     raeburn  8299:             my $secmatch = 0;
1.419     raeburn  8300:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  8301:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  8302:             if ($section eq '') {
                   8303:                 $section = 'none';
                   8304:             }
1.291     albertel 8305:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8306:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8307:                     $secmatch = 1;
                   8308:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 8309:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8310:                         $secmatch = 1;
                   8311:                     }
                   8312:                 } else {  
1.419     raeburn  8313: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  8314: 		        $secmatch = 1;
                   8315:                     }
1.290     albertel 8316: 		}
1.412     raeburn  8317:                 if (!$secmatch) {
                   8318:                     next;
                   8319:                 }
1.419     raeburn  8320:             }
1.275     raeburn  8321:             if (defined($$types{'active'})) {
1.288     raeburn  8322:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  8323:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  8324:                     $match = 1;
1.275     raeburn  8325:                 }
                   8326:             }
                   8327:             if (defined($$types{'previous'})) {
1.609     raeburn  8328:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  8329:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  8330:                     $match = 1;
1.275     raeburn  8331:                 }
                   8332:             }
                   8333:             if (defined($$types{'future'})) {
1.609     raeburn  8334:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  8335:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  8336:                     $match = 1;
1.275     raeburn  8337:                 }
                   8338:             }
1.609     raeburn  8339:             if ($match) {
                   8340:                 push(@{$seclists{$student}},$section);
                   8341:                 if (ref($userdata) eq 'HASH') {
                   8342:                     $$userdata{$student} = $$classlist{$student};
                   8343:                 }
                   8344:                 if (ref($statushash) eq 'HASH') {
                   8345:                     $statushash->{$student}{'st'}{$section} = $status;
                   8346:                 }
1.288     raeburn  8347:             }
1.275     raeburn  8348:         }
                   8349:     }
1.412     raeburn  8350:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  8351:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8352:         my $now = time;
1.609     raeburn  8353:         my %displaystatus = ( previous => 'Expired',
                   8354:                               active   => 'Active',
                   8355:                               future   => 'Future',
                   8356:                             );
1.630     raeburn  8357:         my %nothide;
                   8358:         if ($hidepriv) {
                   8359:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   8360:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   8361:                 if ($user !~ /:/) {
                   8362:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   8363:                 } else {
                   8364:                     $nothide{$user} = 1;
                   8365:                 }
                   8366:             }
                   8367:         }
1.439     raeburn  8368:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  8369:             my $match = 0;
1.412     raeburn  8370:             my $secmatch = 0;
1.439     raeburn  8371:             my $status;
1.412     raeburn  8372:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  8373:             $user =~ s/:$//;
1.439     raeburn  8374:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   8375:             if ($end == -1 || $start == -1) {
                   8376:                 next;
                   8377:             }
                   8378:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   8379:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  8380:                 my ($uname,$udom) = split(/:/,$user);
                   8381:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8382:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8383:                         $secmatch = 1;
                   8384:                     } elsif ($usec eq '') {
1.420     albertel 8385:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8386:                             $secmatch = 1;
                   8387:                         }
                   8388:                     } else {
                   8389:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   8390:                             $secmatch = 1;
                   8391:                         }
                   8392:                     }
                   8393:                     if (!$secmatch) {
                   8394:                         next;
                   8395:                     }
1.288     raeburn  8396:                 }
1.419     raeburn  8397:                 if ($usec eq '') {
                   8398:                     $usec = 'none';
                   8399:                 }
1.275     raeburn  8400:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  8401:                     if ($hidepriv) {
                   8402:                         if ((&Apache::lonnet::privileged($uname,$udom)) &&
                   8403:                             (!$nothide{$uname.':'.$udom})) {
                   8404:                             next;
                   8405:                         }
                   8406:                     }
1.503     raeburn  8407:                     if ($end > 0 && $end < $now) {
1.439     raeburn  8408:                         $status = 'previous';
                   8409:                     } elsif ($start > $now) {
                   8410:                         $status = 'future';
                   8411:                     } else {
                   8412:                         $status = 'active';
                   8413:                     }
1.277     albertel 8414:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  8415:                         if ($status eq $type) {
1.420     albertel 8416:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  8417:                                 push(@{$$users{$role}{$user}},$type);
                   8418:                             }
1.288     raeburn  8419:                             $match = 1;
                   8420:                         }
                   8421:                     }
1.419     raeburn  8422:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   8423:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   8424: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   8425:                         }
1.420     albertel 8426:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  8427:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   8428:                         }
1.609     raeburn  8429:                         if (ref($statushash) eq 'HASH') {
                   8430:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   8431:                         }
1.275     raeburn  8432:                     }
                   8433:                 }
                   8434:             }
                   8435:         }
1.290     albertel 8436:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  8437:             if ((defined($cdom)) && (defined($cnum))) {
                   8438:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   8439:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   8440:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  8441:                     next if ($owner eq '');
                   8442:                     my ($ownername,$ownerdom);
                   8443:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   8444:                         $ownername = $1;
                   8445:                         $ownerdom = $2;
                   8446:                     } else {
                   8447:                         $ownername = $owner;
                   8448:                         $ownerdom = $cdom;
                   8449:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  8450:                     }
                   8451:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 8452:                     if (defined($userdata) && 
1.609     raeburn  8453: 			!exists($$userdata{$owner})) {
                   8454: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   8455:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   8456:                             push(@{$seclists{$owner}},'none');
                   8457:                         }
                   8458:                         if (ref($statushash) eq 'HASH') {
                   8459:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  8460:                         }
1.290     albertel 8461: 		    }
1.279     raeburn  8462:                 }
                   8463:             }
                   8464:         }
1.419     raeburn  8465:         foreach my $user (keys(%seclists)) {
                   8466:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   8467:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   8468:         }
1.275     raeburn  8469:     }
                   8470:     return;
                   8471: }
                   8472: 
1.288     raeburn  8473: sub get_user_info {
                   8474:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 8475:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   8476: 	&plainname($uname,$udom,'lastname');
1.291     albertel 8477:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  8478:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  8479:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   8480:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  8481:     return;
                   8482: }
1.275     raeburn  8483: 
1.472     raeburn  8484: ###############################################
                   8485: 
                   8486: =pod
                   8487: 
                   8488: =item * &get_user_quota()
                   8489: 
                   8490: Retrieves quota assigned for storage of portfolio files for a user  
                   8491: 
                   8492: Incoming parameters:
                   8493: 1. user's username
                   8494: 2. user's domain
                   8495: 
                   8496: Returns:
1.536     raeburn  8497: 1. Disk quota (in Mb) assigned to student.
                   8498: 2. (Optional) Type of setting: custom or default
                   8499:    (individually assigned or default for user's 
                   8500:    institutional status).
                   8501: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   8502:    or student - types as defined in localenroll::inst_usertypes 
                   8503:    for user's domain, which determines default quota for user.
                   8504: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  8505: 
                   8506: If a value has been stored in the user's environment, 
1.536     raeburn  8507: it will return that, otherwise it returns the maximal default
                   8508: defined for the user's instituional status(es) in the domain.
1.472     raeburn  8509: 
                   8510: =cut
                   8511: 
                   8512: ###############################################
                   8513: 
                   8514: 
                   8515: sub get_user_quota {
                   8516:     my ($uname,$udom) = @_;
1.536     raeburn  8517:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  8518:     if (!defined($udom)) {
                   8519:         $udom = $env{'user.domain'};
                   8520:     }
                   8521:     if (!defined($uname)) {
                   8522:         $uname = $env{'user.name'};
                   8523:     }
                   8524:     if (($udom eq '' || $uname eq '') ||
                   8525:         ($udom eq 'public') && ($uname eq 'public')) {
                   8526:         $quota = 0;
1.536     raeburn  8527:         $quotatype = 'default';
                   8528:         $defquota = 0; 
1.472     raeburn  8529:     } else {
1.536     raeburn  8530:         my $inststatus;
1.472     raeburn  8531:         if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   8532:             $quota = $env{'environment.portfolioquota'};
1.536     raeburn  8533:             $inststatus = $env{'environment.inststatus'};
1.472     raeburn  8534:         } else {
1.536     raeburn  8535:             my %userenv = 
                   8536:                 &Apache::lonnet::get('environment',['portfolioquota',
                   8537:                                      'inststatus'],$udom,$uname);
1.472     raeburn  8538:             my ($tmp) = keys(%userenv);
                   8539:             if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8540:                 $quota = $userenv{'portfolioquota'};
1.536     raeburn  8541:                 $inststatus = $userenv{'inststatus'};
1.472     raeburn  8542:             } else {
                   8543:                 undef(%userenv);
                   8544:             }
                   8545:         }
1.536     raeburn  8546:         ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472     raeburn  8547:         if ($quota eq '') {
1.536     raeburn  8548:             $quota = $defquota;
                   8549:             $quotatype = 'default';
                   8550:         } else {
                   8551:             $quotatype = 'custom';
1.472     raeburn  8552:         }
                   8553:     }
1.536     raeburn  8554:     if (wantarray) {
                   8555:         return ($quota,$quotatype,$settingstatus,$defquota);
                   8556:     } else {
                   8557:         return $quota;
                   8558:     }
1.472     raeburn  8559: }
                   8560: 
                   8561: ###############################################
                   8562: 
                   8563: =pod
                   8564: 
                   8565: =item * &default_quota()
                   8566: 
1.536     raeburn  8567: Retrieves default quota assigned for storage of user portfolio files,
                   8568: given an (optional) user's institutional status.
1.472     raeburn  8569: 
                   8570: Incoming parameters:
                   8571: 1. domain
1.536     raeburn  8572: 2. (Optional) institutional status(es).  This is a : separated list of 
                   8573:    status types (e.g., faculty, staff, student etc.)
                   8574:    which apply to the user for whom the default is being retrieved.
                   8575:    If the institutional status string in undefined, the domain
                   8576:    default quota will be returned. 
1.472     raeburn  8577: 
                   8578: Returns:
                   8579: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  8580: 2. (Optional) institutional type which determined the value of the
                   8581:    default quota.
1.472     raeburn  8582: 
                   8583: If a value has been stored in the domain's configuration db,
                   8584: it will return that, otherwise it returns 20 (for backwards 
                   8585: compatibility with domains which have not set up a configuration
                   8586: db file; the original statically defined portfolio quota was 20 Mb). 
                   8587: 
1.536     raeburn  8588: If the user's status includes multiple types (e.g., staff and student),
                   8589: the largest default quota which applies to the user determines the
                   8590: default quota returned.
                   8591: 
1.780     raeburn  8592: =back
                   8593: 
1.472     raeburn  8594: =cut
                   8595: 
                   8596: ###############################################
                   8597: 
                   8598: 
                   8599: sub default_quota {
1.536     raeburn  8600:     my ($udom,$inststatus) = @_;
                   8601:     my ($defquota,$settingstatus);
                   8602:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  8603:                                             ['quotas'],$udom);
                   8604:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  8605:         if ($inststatus ne '') {
1.765     raeburn  8606:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  8607:             foreach my $item (@statuses) {
1.711     raeburn  8608:                 if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   8609:                     if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
                   8610:                         if ($defquota eq '') {
                   8611:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   8612:                             $settingstatus = $item;
                   8613:                         } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
                   8614:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   8615:                             $settingstatus = $item;
                   8616:                         }
                   8617:                     }
                   8618:                 } else {
                   8619:                     if ($quotahash{'quotas'}{$item} ne '') {
                   8620:                         if ($defquota eq '') {
                   8621:                             $defquota = $quotahash{'quotas'}{$item};
                   8622:                             $settingstatus = $item;
                   8623:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   8624:                             $defquota = $quotahash{'quotas'}{$item};
                   8625:                             $settingstatus = $item;
                   8626:                         }
1.536     raeburn  8627:                     }
                   8628:                 }
                   8629:             }
                   8630:         }
                   8631:         if ($defquota eq '') {
1.711     raeburn  8632:             if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   8633:                 $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
                   8634:             } else {
                   8635:                 $defquota = $quotahash{'quotas'}{'default'};
                   8636:             }
1.536     raeburn  8637:             $settingstatus = 'default';
                   8638:         }
                   8639:     } else {
                   8640:         $settingstatus = 'default';
                   8641:         $defquota = 20;
                   8642:     }
                   8643:     if (wantarray) {
                   8644:         return ($defquota,$settingstatus);
1.472     raeburn  8645:     } else {
1.536     raeburn  8646:         return $defquota;
1.472     raeburn  8647:     }
                   8648: }
                   8649: 
1.384     raeburn  8650: sub get_secgrprole_info {
                   8651:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   8652:     my %sections_count = &get_sections($cdom,$cnum);
                   8653:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   8654:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   8655:     my @groups = sort(keys(%curr_groups));
                   8656:     my $allroles = [];
                   8657:     my $rolehash;
                   8658:     my $accesshash = {
                   8659:                      active => 'Currently has access',
                   8660:                      future => 'Will have future access',
                   8661:                      previous => 'Previously had access',
                   8662:                   };
                   8663:     if ($needroles) {
                   8664:         $rolehash = {'all' => 'all'};
1.385     albertel 8665:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8666: 	if (&Apache::lonnet::error(%user_roles)) {
                   8667: 	    undef(%user_roles);
                   8668: 	}
                   8669:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  8670:             my ($role)=split(/\:/,$item,2);
                   8671:             if ($role eq 'cr') { next; }
                   8672:             if ($role =~ /^cr/) {
                   8673:                 $$rolehash{$role} = (split('/',$role))[3];
                   8674:             } else {
                   8675:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   8676:             }
                   8677:         }
                   8678:         foreach my $key (sort(keys(%{$rolehash}))) {
                   8679:             push(@{$allroles},$key);
                   8680:         }
                   8681:         push (@{$allroles},'st');
                   8682:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   8683:     }
                   8684:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   8685: }
                   8686: 
1.555     raeburn  8687: sub user_picker {
1.994     raeburn  8688:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  8689:     my $currdom = $dom;
                   8690:     my %curr_selected = (
                   8691:                         srchin => 'dom',
1.580     raeburn  8692:                         srchby => 'lastname',
1.555     raeburn  8693:                       );
                   8694:     my $srchterm;
1.625     raeburn  8695:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  8696:         if ($srch->{'srchby'} ne '') {
                   8697:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   8698:         }
                   8699:         if ($srch->{'srchin'} ne '') {
                   8700:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   8701:         }
                   8702:         if ($srch->{'srchtype'} ne '') {
                   8703:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   8704:         }
                   8705:         if ($srch->{'srchdomain'} ne '') {
                   8706:             $currdom = $srch->{'srchdomain'};
                   8707:         }
                   8708:         $srchterm = $srch->{'srchterm'};
                   8709:     }
                   8710:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  8711:                     'usr'       => 'Search criteria',
1.563     raeburn  8712:                     'doma'      => 'Domain/institution to search',
1.558     albertel 8713:                     'uname'     => 'username',
                   8714:                     'lastname'  => 'last name',
1.555     raeburn  8715:                     'lastfirst' => 'last name, first name',
1.558     albertel 8716:                     'crs'       => 'in this course',
1.576     raeburn  8717:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 8718:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  8719:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 8720:                     'exact'     => 'is',
                   8721:                     'contains'  => 'contains',
1.569     raeburn  8722:                     'begins'    => 'begins with',
1.571     raeburn  8723:                     'youm'      => "You must include some text to search for.",
                   8724:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   8725:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   8726:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   8727:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   8728:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   8729:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   8730:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  8731:                                        );
1.563     raeburn  8732:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   8733:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  8734: 
                   8735:     my @srchins = ('crs','dom','alc','instd');
                   8736: 
                   8737:     foreach my $option (@srchins) {
                   8738:         # FIXME 'alc' option unavailable until 
                   8739:         #       loncreateuser::print_user_query_page()
                   8740:         #       has been completed.
                   8741:         next if ($option eq 'alc');
1.880     raeburn  8742:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  8743:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  8744:         if ($curr_selected{'srchin'} eq $option) {
                   8745:             $srchinsel .= ' 
                   8746:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8747:         } else {
                   8748:             $srchinsel .= '
                   8749:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8750:         }
1.555     raeburn  8751:     }
1.563     raeburn  8752:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  8753: 
                   8754:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  8755:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  8756:         if ($curr_selected{'srchby'} eq $option) {
                   8757:             $srchbysel .= '
                   8758:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8759:         } else {
                   8760:             $srchbysel .= '
                   8761:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8762:          }
                   8763:     }
                   8764:     $srchbysel .= "\n  </select>\n";
                   8765: 
                   8766:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  8767:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  8768:         if ($curr_selected{'srchtype'} eq $option) {
                   8769:             $srchtypesel .= '
                   8770:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8771:         } else {
                   8772:             $srchtypesel .= '
                   8773:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8774:         }
                   8775:     }
                   8776:     $srchtypesel .= "\n  </select>\n";
                   8777: 
1.558     albertel 8778:     my ($newuserscript,$new_user_create);
1.994     raeburn  8779:     my $context_dom = $env{'request.role.domain'};
                   8780:     if ($context eq 'requestcrs') {
                   8781:         if ($env{'form.coursedom'} ne '') { 
                   8782:             $context_dom = $env{'form.coursedom'};
                   8783:         }
                   8784:     }
1.556     raeburn  8785:     if ($forcenewuser) {
1.576     raeburn  8786:         if (ref($srch) eq 'HASH') {
1.994     raeburn  8787:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  8788:                 if ($cancreate) {
                   8789:                     $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>';
                   8790:                 } else {
1.799     bisitz   8791:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  8792:                     my %usertypetext = (
                   8793:                         official   => 'institutional',
                   8794:                         unofficial => 'non-institutional',
                   8795:                     );
1.799     bisitz   8796:                     $new_user_create = '<p class="LC_warning">'
                   8797:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   8798:                                       .' '
                   8799:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   8800:                                           ,'<a href="'.$helplink.'">','</a>')
                   8801:                                       .'</p><br />';
1.627     raeburn  8802:                 }
1.576     raeburn  8803:             }
                   8804:         }
                   8805: 
1.556     raeburn  8806:         $newuserscript = <<"ENDSCRIPT";
                   8807: 
1.570     raeburn  8808: function setSearch(createnew,callingForm) {
1.556     raeburn  8809:     if (createnew == 1) {
1.570     raeburn  8810:         for (var i=0; i<callingForm.srchby.length; i++) {
                   8811:             if (callingForm.srchby.options[i].value == 'uname') {
                   8812:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  8813:             }
                   8814:         }
1.570     raeburn  8815:         for (var i=0; i<callingForm.srchin.length; i++) {
                   8816:             if ( callingForm.srchin.options[i].value == 'dom') {
                   8817: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  8818:             }
                   8819:         }
1.570     raeburn  8820:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   8821:             if (callingForm.srchtype.options[i].value == 'exact') {
                   8822:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  8823:             }
                   8824:         }
1.570     raeburn  8825:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  8826:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  8827:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  8828:             }
                   8829:         }
                   8830:     }
                   8831: }
                   8832: ENDSCRIPT
1.558     albertel 8833: 
1.556     raeburn  8834:     }
                   8835: 
1.555     raeburn  8836:     my $output = <<"END_BLOCK";
1.556     raeburn  8837: <script type="text/javascript">
1.824     bisitz   8838: // <![CDATA[
1.570     raeburn  8839: function validateEntry(callingForm) {
1.558     albertel 8840: 
1.556     raeburn  8841:     var checkok = 1;
1.558     albertel 8842:     var srchin;
1.570     raeburn  8843:     for (var i=0; i<callingForm.srchin.length; i++) {
                   8844: 	if ( callingForm.srchin[i].checked ) {
                   8845: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 8846: 	}
                   8847:     }
                   8848: 
1.570     raeburn  8849:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   8850:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   8851:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   8852:     var srchterm =  callingForm.srchterm.value;
                   8853:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  8854:     var msg = "";
                   8855: 
                   8856:     if (srchterm == "") {
                   8857:         checkok = 0;
1.571     raeburn  8858:         msg += "$lt{'youm'}\\n";
1.556     raeburn  8859:     }
                   8860: 
1.569     raeburn  8861:     if (srchtype== 'begins') {
                   8862:         if (srchterm.length < 2) {
                   8863:             checkok = 0;
1.571     raeburn  8864:             msg += "$lt{'thte'}\\n";
1.569     raeburn  8865:         }
                   8866:     }
                   8867: 
1.556     raeburn  8868:     if (srchtype== 'contains') {
                   8869:         if (srchterm.length < 3) {
                   8870:             checkok = 0;
1.571     raeburn  8871:             msg += "$lt{'thet'}\\n";
1.556     raeburn  8872:         }
                   8873:     }
                   8874:     if (srchin == 'instd') {
                   8875:         if (srchdomain == '') {
                   8876:             checkok = 0;
1.571     raeburn  8877:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  8878:         }
                   8879:     }
                   8880:     if (srchin == 'dom') {
                   8881:         if (srchdomain == '') {
                   8882:             checkok = 0;
1.571     raeburn  8883:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  8884:         }
                   8885:     }
                   8886:     if (srchby == 'lastfirst') {
                   8887:         if (srchterm.indexOf(",") == -1) {
                   8888:             checkok = 0;
1.571     raeburn  8889:             msg += "$lt{'whus'}\\n";
1.556     raeburn  8890:         }
                   8891:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   8892:             checkok = 0;
1.571     raeburn  8893:             msg += "$lt{'whse'}\\n";
1.556     raeburn  8894:         }
                   8895:     }
                   8896:     if (checkok == 0) {
1.571     raeburn  8897:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  8898:         return;
                   8899:     }
                   8900:     if (checkok == 1) {
1.570     raeburn  8901:         callingForm.submit();
1.556     raeburn  8902:     }
                   8903: }
                   8904: 
                   8905: $newuserscript
                   8906: 
1.824     bisitz   8907: // ]]>
1.556     raeburn  8908: </script>
1.558     albertel 8909: 
                   8910: $new_user_create
                   8911: 
1.555     raeburn  8912: END_BLOCK
1.558     albertel 8913: 
1.876     raeburn  8914:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   8915:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   8916:                $domform.
                   8917:                &Apache::lonhtmlcommon::row_closure().
                   8918:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   8919:                $srchbysel.
                   8920:                $srchtypesel. 
                   8921:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   8922:                $srchinsel.
                   8923:                &Apache::lonhtmlcommon::row_closure(1). 
                   8924:                &Apache::lonhtmlcommon::end_pick_box().
                   8925:                '<br />';
1.555     raeburn  8926:     return $output;
                   8927: }
                   8928: 
1.612     raeburn  8929: sub user_rule_check {
1.615     raeburn  8930:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  8931:     my $response;
                   8932:     if (ref($usershash) eq 'HASH') {
                   8933:         foreach my $user (keys(%{$usershash})) {
                   8934:             my ($uname,$udom) = split(/:/,$user);
                   8935:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  8936:             my ($id,$newuser);
1.612     raeburn  8937:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  8938:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  8939:                 $id = $usershash->{$user}->{'id'};
                   8940:             }
                   8941:             my $inst_response;
                   8942:             if (ref($checks) eq 'HASH') {
                   8943:                 if (defined($checks->{'username'})) {
1.615     raeburn  8944:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  8945:                         &Apache::lonnet::get_instuser($udom,$uname);
                   8946:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  8947:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  8948:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   8949:                 }
1.615     raeburn  8950:             } else {
                   8951:                 ($inst_response,%{$inst_results->{$user}}) =
                   8952:                     &Apache::lonnet::get_instuser($udom,$uname);
                   8953:                 return;
1.612     raeburn  8954:             }
1.615     raeburn  8955:             if (!$got_rules->{$udom}) {
1.612     raeburn  8956:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   8957:                                                   ['usercreation'],$udom);
                   8958:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  8959:                     foreach my $item ('username','id') {
1.612     raeburn  8960:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   8961:                             $$curr_rules{$udom}{$item} = 
                   8962:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  8963:                         }
                   8964:                     }
                   8965:                 }
1.615     raeburn  8966:                 $got_rules->{$udom} = 1;  
1.585     raeburn  8967:             }
1.612     raeburn  8968:             foreach my $item (keys(%{$checks})) {
                   8969:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   8970:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   8971:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   8972:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   8973:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   8974:                                 if ($rule_check{$rule}) {
                   8975:                                     $$rulematch{$user}{$item} = $rule;
                   8976:                                     if ($inst_response eq 'ok') {
1.615     raeburn  8977:                                         if (ref($inst_results) eq 'HASH') {
                   8978:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   8979:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   8980:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   8981:                                                 }
1.612     raeburn  8982:                                             }
                   8983:                                         }
1.615     raeburn  8984:                                     }
                   8985:                                     last;
1.585     raeburn  8986:                                 }
                   8987:                             }
                   8988:                         }
                   8989:                     }
                   8990:                 }
                   8991:             }
                   8992:         }
                   8993:     }
1.612     raeburn  8994:     return;
                   8995: }
                   8996: 
                   8997: sub user_rule_formats {
                   8998:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   8999:     my %text = ( 
                   9000:                  'username' => 'Usernames',
                   9001:                  'id'       => 'IDs',
                   9002:                );
                   9003:     my $output;
                   9004:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   9005:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   9006:         if (@{$ruleorder} > 0) {
1.1075.2.20  raeburn  9007:             $output = '<br />'.
                   9008:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   9009:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   9010:                       ' <ul>';
1.612     raeburn  9011:             foreach my $rule (@{$ruleorder}) {
                   9012:                 if (ref($curr_rules) eq 'ARRAY') {
                   9013:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   9014:                         if (ref($rules->{$rule}) eq 'HASH') {
                   9015:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   9016:                                         $rules->{$rule}{'desc'}.'</li>';
                   9017:                         }
                   9018:                     }
                   9019:                 }
                   9020:             }
                   9021:             $output .= '</ul>';
                   9022:         }
                   9023:     }
                   9024:     return $output;
                   9025: }
                   9026: 
                   9027: sub instrule_disallow_msg {
1.615     raeburn  9028:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  9029:     my $response;
                   9030:     my %text = (
                   9031:                   item   => 'username',
                   9032:                   items  => 'usernames',
                   9033:                   match  => 'matches',
                   9034:                   do     => 'does',
                   9035:                   action => 'a username',
                   9036:                   one    => 'one',
                   9037:                );
                   9038:     if ($count > 1) {
                   9039:         $text{'item'} = 'usernames';
                   9040:         $text{'match'} ='match';
                   9041:         $text{'do'} = 'do';
                   9042:         $text{'action'} = 'usernames',
                   9043:         $text{'one'} = 'ones';
                   9044:     }
                   9045:     if ($checkitem eq 'id') {
                   9046:         $text{'items'} = 'IDs';
                   9047:         $text{'item'} = 'ID';
                   9048:         $text{'action'} = 'an ID';
1.615     raeburn  9049:         if ($count > 1) {
                   9050:             $text{'item'} = 'IDs';
                   9051:             $text{'action'} = 'IDs';
                   9052:         }
1.612     raeburn  9053:     }
1.674     bisitz   9054:     $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  9055:     if ($mode eq 'upload') {
                   9056:         if ($checkitem eq 'username') {
                   9057:             $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'}.");
                   9058:         } elsif ($checkitem eq 'id') {
1.674     bisitz   9059:             $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  9060:         }
1.669     raeburn  9061:     } elsif ($mode eq 'selfcreate') {
                   9062:         if ($checkitem eq 'id') {
                   9063:             $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.");
                   9064:         }
1.615     raeburn  9065:     } else {
                   9066:         if ($checkitem eq 'username') {
                   9067:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   9068:         } elsif ($checkitem eq 'id') {
                   9069:             $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.");
                   9070:         }
1.612     raeburn  9071:     }
                   9072:     return $response;
1.585     raeburn  9073: }
                   9074: 
1.624     raeburn  9075: sub personal_data_fieldtitles {
                   9076:     my %fieldtitles = &Apache::lonlocal::texthash (
                   9077:                         id => 'Student/Employee ID',
                   9078:                         permanentemail => 'E-mail address',
                   9079:                         lastname => 'Last Name',
                   9080:                         firstname => 'First Name',
                   9081:                         middlename => 'Middle Name',
                   9082:                         generation => 'Generation',
                   9083:                         gen => 'Generation',
1.765     raeburn  9084:                         inststatus => 'Affiliation',
1.624     raeburn  9085:                    );
                   9086:     return %fieldtitles;
                   9087: }
                   9088: 
1.642     raeburn  9089: sub sorted_inst_types {
                   9090:     my ($dom) = @_;
                   9091:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   9092:     my $othertitle = &mt('All users');
                   9093:     if ($env{'request.course.id'}) {
1.668     raeburn  9094:         $othertitle  = &mt('Any users');
1.642     raeburn  9095:     }
                   9096:     my @types;
                   9097:     if (ref($order) eq 'ARRAY') {
                   9098:         @types = @{$order};
                   9099:     }
                   9100:     if (@types == 0) {
                   9101:         if (ref($usertypes) eq 'HASH') {
                   9102:             @types = sort(keys(%{$usertypes}));
                   9103:         }
                   9104:     }
                   9105:     if (keys(%{$usertypes}) > 0) {
                   9106:         $othertitle = &mt('Other users');
                   9107:     }
                   9108:     return ($othertitle,$usertypes,\@types);
                   9109: }
                   9110: 
1.645     raeburn  9111: sub get_institutional_codes {
                   9112:     my ($settings,$allcourses,$LC_code) = @_;
                   9113: # Get complete list of course sections to update
                   9114:     my @currsections = ();
                   9115:     my @currxlists = ();
                   9116:     my $coursecode = $$settings{'internal.coursecode'};
                   9117: 
                   9118:     if ($$settings{'internal.sectionnums'} ne '') {
                   9119:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   9120:     }
                   9121: 
                   9122:     if ($$settings{'internal.crosslistings'} ne '') {
                   9123:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   9124:     }
                   9125: 
                   9126:     if (@currxlists > 0) {
                   9127:         foreach (@currxlists) {
                   9128:             if (m/^([^:]+):(\w*)$/) {
                   9129:                 unless (grep/^$1$/,@{$allcourses}) {
                   9130:                     push @{$allcourses},$1;
                   9131:                     $$LC_code{$1} = $2;
                   9132:                 }
                   9133:             }
                   9134:         }
                   9135:     }
                   9136:  
                   9137:     if (@currsections > 0) {
                   9138:         foreach (@currsections) {
                   9139:             if (m/^(\w+):(\w*)$/) {
                   9140:                 my $sec = $coursecode.$1;
                   9141:                 my $lc_sec = $2;
                   9142:                 unless (grep/^$sec$/,@{$allcourses}) {
                   9143:                     push @{$allcourses},$sec;
                   9144:                     $$LC_code{$sec} = $lc_sec;
                   9145:                 }
                   9146:             }
                   9147:         }
                   9148:     }
                   9149:     return;
                   9150: }
                   9151: 
1.971     raeburn  9152: sub get_standard_codeitems {
                   9153:     return ('Year','Semester','Department','Number','Section');
                   9154: }
                   9155: 
1.112     bowersj2 9156: =pod
                   9157: 
1.780     raeburn  9158: =head1 Slot Helpers
                   9159: 
                   9160: =over 4
                   9161: 
                   9162: =item * sorted_slots()
                   9163: 
1.1040    raeburn  9164: Sorts an array of slot names in order of an optional sort key,
                   9165: default sort is by slot start time (earliest first). 
1.780     raeburn  9166: 
                   9167: Inputs:
                   9168: 
                   9169: =over 4
                   9170: 
                   9171: slotsarr  - Reference to array of unsorted slot names.
                   9172: 
                   9173: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   9174: 
1.1040    raeburn  9175: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   9176: 
1.549     albertel 9177: =back
                   9178: 
1.780     raeburn  9179: Returns:
                   9180: 
                   9181: =over 4
                   9182: 
1.1040    raeburn  9183: sorted   - An array of slot names sorted by a specified sort key 
                   9184:            (default sort key is start time of the slot).
1.780     raeburn  9185: 
                   9186: =back
                   9187: 
                   9188: =cut
                   9189: 
                   9190: 
                   9191: sub sorted_slots {
1.1040    raeburn  9192:     my ($slotsarr,$slots,$sortkey) = @_;
                   9193:     if ($sortkey eq '') {
                   9194:         $sortkey = 'starttime';
                   9195:     }
1.780     raeburn  9196:     my @sorted;
                   9197:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   9198:         @sorted =
                   9199:             sort {
                   9200:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  9201:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  9202:                      }
                   9203:                      if (ref($slots->{$a})) { return -1;}
                   9204:                      if (ref($slots->{$b})) { return 1;}
                   9205:                      return 0;
                   9206:                  } @{$slotsarr};
                   9207:     }
                   9208:     return @sorted;
                   9209: }
                   9210: 
1.1040    raeburn  9211: =pod
                   9212: 
                   9213: =item * get_future_slots()
                   9214: 
                   9215: Inputs:
                   9216: 
                   9217: =over 4
                   9218: 
                   9219: cnum - course number
                   9220: 
                   9221: cdom - course domain
                   9222: 
                   9223: now - current UNIX time
                   9224: 
                   9225: symb - optional symb
                   9226: 
                   9227: =back
                   9228: 
                   9229: Returns:
                   9230: 
                   9231: =over 4
                   9232: 
                   9233: sorted_reservable - ref to array of student_schedulable slots currently 
                   9234:                     reservable, ordered by end date of reservation period.
                   9235: 
                   9236: reservable_now - ref to hash of student_schedulable slots currently
                   9237:                  reservable.
                   9238: 
                   9239:     Keys in inner hash are:
                   9240:     (a) symb: either blank or symb to which slot use is restricted.
                   9241:     (b) endreserve: end date of reservation period. 
                   9242: 
                   9243: sorted_future - ref to array of student_schedulable slots reservable in
                   9244:                 the future, ordered by start date of reservation period.
                   9245: 
                   9246: future_reservable - ref to hash of student_schedulable slots reservable
                   9247:                     in the future.
                   9248: 
                   9249:     Keys in inner hash are:
                   9250:     (a) symb: either blank or symb to which slot use is restricted.
                   9251:     (b) startreserve:  start date of reservation period.
                   9252: 
                   9253: =back
                   9254: 
                   9255: =cut
                   9256: 
                   9257: sub get_future_slots {
                   9258:     my ($cnum,$cdom,$now,$symb) = @_;
                   9259:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   9260:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   9261:     foreach my $slot (keys(%slots)) {
                   9262:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   9263:         if ($symb) {
                   9264:             next if (($slots{$slot}->{'symb'} ne '') && 
                   9265:                      ($slots{$slot}->{'symb'} ne $symb));
                   9266:         }
                   9267:         if (($slots{$slot}->{'starttime'} > $now) &&
                   9268:             ($slots{$slot}->{'endtime'} > $now)) {
                   9269:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   9270:                 my $userallowed = 0;
                   9271:                 if ($slots{$slot}->{'allowedsections'}) {
                   9272:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   9273:                     if (!defined($env{'request.role.sec'})
                   9274:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   9275:                         $userallowed=1;
                   9276:                     } else {
                   9277:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   9278:                             $userallowed=1;
                   9279:                         }
                   9280:                     }
                   9281:                     unless ($userallowed) {
                   9282:                         if (defined($env{'request.course.groups'})) {
                   9283:                             my @groups = split(/:/,$env{'request.course.groups'});
                   9284:                             foreach my $group (@groups) {
                   9285:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   9286:                                     $userallowed=1;
                   9287:                                     last;
                   9288:                                 }
                   9289:                             }
                   9290:                         }
                   9291:                     }
                   9292:                 }
                   9293:                 if ($slots{$slot}->{'allowedusers'}) {
                   9294:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   9295:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   9296:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   9297:                         $userallowed = 1;
                   9298:                     }
                   9299:                 }
                   9300:                 next unless($userallowed);
                   9301:             }
                   9302:             my $startreserve = $slots{$slot}->{'startreserve'};
                   9303:             my $endreserve = $slots{$slot}->{'endreserve'};
                   9304:             my $symb = $slots{$slot}->{'symb'};
                   9305:             if (($startreserve < $now) &&
                   9306:                 (!$endreserve || $endreserve > $now)) {
                   9307:                 my $lastres = $endreserve;
                   9308:                 if (!$lastres) {
                   9309:                     $lastres = $slots{$slot}->{'starttime'};
                   9310:                 }
                   9311:                 $reservable_now{$slot} = {
                   9312:                                            symb       => $symb,
                   9313:                                            endreserve => $lastres
                   9314:                                          };
                   9315:             } elsif (($startreserve > $now) &&
                   9316:                      (!$endreserve || $endreserve > $startreserve)) {
                   9317:                 $future_reservable{$slot} = {
                   9318:                                               symb         => $symb,
                   9319:                                               startreserve => $startreserve
                   9320:                                             };
                   9321:             }
                   9322:         }
                   9323:     }
                   9324:     my @unsorted_reservable = keys(%reservable_now);
                   9325:     if (@unsorted_reservable > 0) {
                   9326:         @sorted_reservable = 
                   9327:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   9328:     }
                   9329:     my @unsorted_future = keys(%future_reservable);
                   9330:     if (@unsorted_future > 0) {
                   9331:         @sorted_future =
                   9332:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   9333:     }
                   9334:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   9335: }
1.780     raeburn  9336: 
                   9337: =pod
                   9338: 
1.1057    foxr     9339: =back
                   9340: 
1.549     albertel 9341: =head1 HTTP Helpers
                   9342: 
                   9343: =over 4
                   9344: 
1.648     raeburn  9345: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 9346: 
1.258     albertel 9347: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 9348: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 9349: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 9350: 
                   9351: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   9352: $possible_names is an ref to an array of form element names.  As an example:
                   9353: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 9354: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 9355: 
                   9356: =cut
1.1       albertel 9357: 
1.6       albertel 9358: sub get_unprocessed_cgi {
1.25      albertel 9359:   my ($query,$possible_names)= @_;
1.26      matthew  9360:   # $Apache::lonxml::debug=1;
1.356     albertel 9361:   foreach my $pair (split(/&/,$query)) {
                   9362:     my ($name, $value) = split(/=/,$pair);
1.369     www      9363:     $name = &unescape($name);
1.25      albertel 9364:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   9365:       $value =~ tr/+/ /;
                   9366:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 9367:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 9368:     }
1.16      harris41 9369:   }
1.6       albertel 9370: }
                   9371: 
1.112     bowersj2 9372: =pod
                   9373: 
1.648     raeburn  9374: =item * &cacheheader() 
1.112     bowersj2 9375: 
                   9376: returns cache-controlling header code
                   9377: 
                   9378: =cut
                   9379: 
1.7       albertel 9380: sub cacheheader {
1.258     albertel 9381:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 9382:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   9383:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 9384:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   9385:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 9386:     return $output;
1.7       albertel 9387: }
                   9388: 
1.112     bowersj2 9389: =pod
                   9390: 
1.648     raeburn  9391: =item * &no_cache($r) 
1.112     bowersj2 9392: 
                   9393: specifies header code to not have cache
                   9394: 
                   9395: =cut
                   9396: 
1.9       albertel 9397: sub no_cache {
1.216     albertel 9398:     my ($r) = @_;
                   9399:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 9400: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 9401:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   9402:     $r->no_cache(1);
                   9403:     $r->header_out("Expires" => $date);
                   9404:     $r->header_out("Pragma" => "no-cache");
1.123     www      9405: }
                   9406: 
                   9407: sub content_type {
1.181     albertel 9408:     my ($r,$type,$charset) = @_;
1.299     foxr     9409:     if ($r) {
                   9410: 	#  Note that printout.pl calls this with undef for $r.
                   9411: 	&no_cache($r);
                   9412:     }
1.258     albertel 9413:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 9414:     unless ($charset) {
                   9415: 	$charset=&Apache::lonlocal::current_encoding;
                   9416:     }
                   9417:     if ($charset) { $type.='; charset='.$charset; }
                   9418:     if ($r) {
                   9419: 	$r->content_type($type);
                   9420:     } else {
                   9421: 	print("Content-type: $type\n\n");
                   9422:     }
1.9       albertel 9423: }
1.25      albertel 9424: 
1.112     bowersj2 9425: =pod
                   9426: 
1.648     raeburn  9427: =item * &add_to_env($name,$value) 
1.112     bowersj2 9428: 
1.258     albertel 9429: adds $name to the %env hash with value
1.112     bowersj2 9430: $value, if $name already exists, the entry is converted to an array
                   9431: reference and $value is added to the array.
                   9432: 
                   9433: =cut
                   9434: 
1.25      albertel 9435: sub add_to_env {
                   9436:   my ($name,$value)=@_;
1.258     albertel 9437:   if (defined($env{$name})) {
                   9438:     if (ref($env{$name})) {
1.25      albertel 9439:       #already have multiple values
1.258     albertel 9440:       push(@{ $env{$name} },$value);
1.25      albertel 9441:     } else {
                   9442:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 9443:       my $first=$env{$name};
                   9444:       undef($env{$name});
                   9445:       push(@{ $env{$name} },$first,$value);
1.25      albertel 9446:     }
                   9447:   } else {
1.258     albertel 9448:     $env{$name}=$value;
1.25      albertel 9449:   }
1.31      albertel 9450: }
1.149     albertel 9451: 
                   9452: =pod
                   9453: 
1.648     raeburn  9454: =item * &get_env_multiple($name) 
1.149     albertel 9455: 
1.258     albertel 9456: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 9457: values may be defined and end up as an array ref.
                   9458: 
                   9459: returns an array of values
                   9460: 
                   9461: =cut
                   9462: 
                   9463: sub get_env_multiple {
                   9464:     my ($name) = @_;
                   9465:     my @values;
1.258     albertel 9466:     if (defined($env{$name})) {
1.149     albertel 9467:         # exists is it an array
1.258     albertel 9468:         if (ref($env{$name})) {
                   9469:             @values=@{ $env{$name} };
1.149     albertel 9470:         } else {
1.258     albertel 9471:             $values[0]=$env{$name};
1.149     albertel 9472:         }
                   9473:     }
                   9474:     return(@values);
                   9475: }
                   9476: 
1.660     raeburn  9477: sub ask_for_embedded_content {
                   9478:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  9479:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11  raeburn  9480:         %currsubfile,%unused,$rem);
1.1071    raeburn  9481:     my $counter = 0;
                   9482:     my $numnew = 0;
1.987     raeburn  9483:     my $numremref = 0;
                   9484:     my $numinvalid = 0;
                   9485:     my $numpathchg = 0;
                   9486:     my $numexisting = 0;
1.1071    raeburn  9487:     my $numunused = 0;
                   9488:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
                   9489:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path);
                   9490:     my $heading = &mt('Upload embedded files');
                   9491:     my $buttontext = &mt('Upload');
                   9492: 
1.1075.2.11  raeburn  9493:     my $navmap;
                   9494:     if ($env{'request.course.id'}) {
                   9495:         $navmap = Apache::lonnavmaps::navmap->new();
                   9496:     }
1.984     raeburn  9497:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9498:         my $current_path='/';
                   9499:         if ($env{'form.currentpath'}) {
                   9500:             $current_path = $env{'form.currentpath'};
                   9501:         }
                   9502:         if ($actionurl eq '/adm/coursegrp_portfolio') {
                   9503:             $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9504:             $uname = $env{'course.'.$env{'request.course.id'}.'.num'};
                   9505:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   9506:         } else {
                   9507:             $udom = $env{'user.domain'};
                   9508:             $uname = $env{'user.name'};
                   9509:             $url = '/userfiles/portfolio';
                   9510:         }
1.987     raeburn  9511:         $toplevel = $url.'/';
1.984     raeburn  9512:         $url .= $current_path;
                   9513:         $getpropath = 1;
1.987     raeburn  9514:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   9515:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      9516:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  9517:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  9518:         $toplevel = $url;
1.984     raeburn  9519:         if ($rest ne '') {
1.987     raeburn  9520:             $url .= $rest;
                   9521:         }
                   9522:     } elsif ($actionurl eq '/adm/coursedocs') {
                   9523:         if (ref($args) eq 'HASH') {
1.1071    raeburn  9524:             $url = $args->{'docs_url'};
                   9525:             $toplevel = $url;
1.1075.2.11  raeburn  9526:             if ($args->{'context'} eq 'paste') {
                   9527:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   9528:                 ($path) =
                   9529:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9530:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9531:                 $fileloc =~ s{^/}{};
                   9532:             }
1.1071    raeburn  9533:         }
                   9534:     } elsif ($actionurl eq '/adm/dependencies') {
                   9535:         if ($env{'request.course.id'} ne '') {
                   9536:             $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9537:             $cnum =  $env{'course.'.$env{'request.course.id'}.'.num'};
                   9538:             if (ref($args) eq 'HASH') {
                   9539:                 $url = $args->{'docs_url'};
                   9540:                 $title = $args->{'docs_title'};
                   9541:                 $toplevel = "/$url";
1.1075.2.11  raeburn  9542:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1071    raeburn  9543:                 ($path) =  
                   9544:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9545:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9546:                 $fileloc =~ s{^/}{};
                   9547:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   9548:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   9549:             }
1.987     raeburn  9550:         }
                   9551:     }
                   9552:     my $now = time();
                   9553:     foreach my $embed_file (keys(%{$allfiles})) {
                   9554:         my $absolutepath;
                   9555:         if ($embed_file =~ m{^\w+://}) {
                   9556:             $newfiles{$embed_file} = 1;
                   9557:             $mapping{$embed_file} = $embed_file;
                   9558:         } else {
                   9559:             if ($embed_file =~ m{^/}) {
                   9560:                 $absolutepath = $embed_file;
                   9561:                 $embed_file =~ s{^(/+)}{};
                   9562:             }
                   9563:             if ($embed_file =~ m{/}) {
                   9564:                 my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
                   9565:                 $path = &check_for_traversal($path,$url,$toplevel);
                   9566:                 my $item = $fname;
                   9567:                 if ($path ne '') {
                   9568:                     $item = $path.'/'.$fname;
                   9569:                     $subdependencies{$path}{$fname} = 1;
                   9570:                 } else {
                   9571:                     $dependencies{$item} = 1;
                   9572:                 }
                   9573:                 if ($absolutepath) {
                   9574:                     $mapping{$item} = $absolutepath;
                   9575:                 } else {
                   9576:                     $mapping{$item} = $embed_file;
                   9577:                 }
                   9578:             } else {
                   9579:                 $dependencies{$embed_file} = 1;
                   9580:                 if ($absolutepath) {
                   9581:                     $mapping{$embed_file} = $absolutepath;
                   9582:                 } else {
                   9583:                     $mapping{$embed_file} = $embed_file;
                   9584:                 }
                   9585:             }
1.984     raeburn  9586:         }
                   9587:     }
1.1071    raeburn  9588:     my $dirptr = 16384;
1.984     raeburn  9589:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  9590:         $currsubfile{$path} = {};
1.984     raeburn  9591:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  9592:             my ($sublistref,$listerror) =
                   9593:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   9594:             if (ref($sublistref) eq 'ARRAY') {
                   9595:                 foreach my $line (@{$sublistref}) {
                   9596:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  9597:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  9598:                 }
1.984     raeburn  9599:             }
1.987     raeburn  9600:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9601:             if (opendir(my $dir,$url.'/'.$path)) {
                   9602:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  9603:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   9604:             }
1.1075.2.11  raeburn  9605:         } elsif (($actionurl eq '/adm/dependencies') ||
                   9606:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   9607:                   ($args->{'context'} eq 'paste'))) {
1.1071    raeburn  9608:             if ($env{'request.course.id'} ne '') {
                   9609:                 my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9610:                 if ($dir ne '') {
                   9611:                     my ($sublistref,$listerror) =
                   9612:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   9613:                     if (ref($sublistref) eq 'ARRAY') {
                   9614:                         foreach my $line (@{$sublistref}) {
                   9615:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   9616:                                 undef,$mtime)=split(/\&/,$line,12);
                   9617:                             unless (($testdir&$dirptr) ||
                   9618:                                     ($file_name =~ /^\.\.?$/)) {
                   9619:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   9620:                             }
                   9621:                         }
                   9622:                     }
                   9623:                 }
1.984     raeburn  9624:             }
                   9625:         }
                   9626:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  9627:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  9628:                 my $item = $path.'/'.$file;
                   9629:                 unless ($mapping{$item} eq $item) {
                   9630:                     $pathchanges{$item} = 1;
                   9631:                 }
                   9632:                 $existing{$item} = 1;
                   9633:                 $numexisting ++;
                   9634:             } else {
                   9635:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  9636:             }
                   9637:         }
1.1071    raeburn  9638:         if ($actionurl eq '/adm/dependencies') {
                   9639:             foreach my $path (keys(%currsubfile)) {
                   9640:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   9641:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   9642:                          unless ($subdependencies{$path}{$file}) {
1.1075.2.11  raeburn  9643:                              next if (($rem ne '') &&
                   9644:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   9645:                                        (ref($navmap) &&
                   9646:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   9647:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   9648:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  9649:                              $unused{$path.'/'.$file} = 1; 
                   9650:                          }
                   9651:                     }
                   9652:                 }
                   9653:             }
                   9654:         }
1.984     raeburn  9655:     }
1.987     raeburn  9656:     my %currfile;
1.984     raeburn  9657:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  9658:         my ($dirlistref,$listerror) =
                   9659:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   9660:         if (ref($dirlistref) eq 'ARRAY') {
                   9661:             foreach my $line (@{$dirlistref}) {
                   9662:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   9663:                 $currfile{$file_name} = 1;
                   9664:             }
1.984     raeburn  9665:         }
1.987     raeburn  9666:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9667:         if (opendir(my $dir,$url)) {
1.987     raeburn  9668:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  9669:             map {$currfile{$_} = 1;} @dir_list;
                   9670:         }
1.1075.2.11  raeburn  9671:     } elsif (($actionurl eq '/adm/dependencies') ||
                   9672:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   9673:               ($args->{'context'} eq 'paste'))) {
1.1071    raeburn  9674:         if ($env{'request.course.id'} ne '') {
                   9675:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9676:             if ($dir ne '') {
                   9677:                 my ($dirlistref,$listerror) =
                   9678:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   9679:                 if (ref($dirlistref) eq 'ARRAY') {
                   9680:                     foreach my $line (@{$dirlistref}) {
                   9681:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   9682:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   9683:                         unless (($testdir&$dirptr) ||
                   9684:                                 ($file_name =~ /^\.\.?$/)) {
                   9685:                             $currfile{$file_name} = [$size,$mtime];
                   9686:                         }
                   9687:                     }
                   9688:                 }
                   9689:             }
                   9690:         }
1.984     raeburn  9691:     }
                   9692:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  9693:         if (exists($currfile{$file})) {
1.987     raeburn  9694:             unless ($mapping{$file} eq $file) {
                   9695:                 $pathchanges{$file} = 1;
                   9696:             }
                   9697:             $existing{$file} = 1;
                   9698:             $numexisting ++;
                   9699:         } else {
1.984     raeburn  9700:             $newfiles{$file} = 1;
                   9701:         }
                   9702:     }
1.1071    raeburn  9703:     foreach my $file (keys(%currfile)) {
                   9704:         unless (($file eq $filename) ||
                   9705:                 ($file eq $filename.'.bak') ||
                   9706:                 ($dependencies{$file})) {
1.1075.2.11  raeburn  9707:             if ($actionurl eq '/adm/dependencies') {
                   9708:                 next if (($rem ne '') &&
                   9709:                          (($env{"httpref.$rem".$file} ne '') ||
                   9710:                           (ref($navmap) &&
                   9711:                           (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   9712:                            (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   9713:                             ($navmap->getResourceByUrl($rem.$1)))))));
                   9714:             }
1.1071    raeburn  9715:             $unused{$file} = 1;
                   9716:         }
                   9717:     }
1.1075.2.11  raeburn  9718:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   9719:         ($args->{'context'} eq 'paste')) {
                   9720:         $counter = scalar(keys(%existing));
                   9721:         $numpathchg = scalar(keys(%pathchanges));
                   9722:         return ($output,$counter,$numpathchg,\%existing);
                   9723:     }
1.984     raeburn  9724:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  9725:         if ($actionurl eq '/adm/dependencies') {
                   9726:             next if ($embed_file =~ m{^\w+://});
                   9727:         }
1.660     raeburn  9728:         $upload_output .= &start_data_table_row().
1.1071    raeburn  9729:                           '<td><img src="'.&icon($embed_file).'" />&nbsp;'.
                   9730:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  9731:         unless ($mapping{$embed_file} eq $embed_file) {
                   9732:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.&mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
                   9733:         }
                   9734:         $upload_output .= '</td><td>';
1.1071    raeburn  9735:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.660     raeburn  9736:             $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
1.987     raeburn  9737:             $numremref++;
1.660     raeburn  9738:         } elsif ($args->{'error_on_invalid_names'}
                   9739:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.987     raeburn  9740:             $upload_output.='<span class="LC_warning">'.&mt('Invalid characters').'</span>';
                   9741:             $numinvalid++;
1.660     raeburn  9742:         } else {
1.1071    raeburn  9743:             $upload_output .= &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  9744:                                                      $embed_file,\%mapping,
1.1071    raeburn  9745:                                                      $allfiles,$codebase,'upload');
                   9746:             $counter ++;
                   9747:             $numnew ++;
1.987     raeburn  9748:         }
                   9749:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   9750:     }
                   9751:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  9752:         if ($actionurl eq '/adm/dependencies') {
                   9753:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   9754:             $modify_output .= &start_data_table_row().
                   9755:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   9756:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   9757:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   9758:                               '<td>'.$size.'</td>'.
                   9759:                               '<td>'.$mtime.'</td>'.
                   9760:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   9761:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   9762:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   9763:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   9764:                               &embedded_file_element('upload_embedded',$counter,
                   9765:                                                      $embed_file,\%mapping,
                   9766:                                                      $allfiles,$codebase,'modify').
                   9767:                               '</div></td>'.
                   9768:                               &end_data_table_row()."\n";
                   9769:             $counter ++;
                   9770:         } else {
                   9771:             $upload_output .= &start_data_table_row().
                   9772:                               '<td><span class="LC_filename">'.$embed_file.'</span></td>';
                   9773:                               '<td><span class="LC_warning">'.&mt('Already exists').'</span></td>'.
                   9774:                               &Apache::loncommon::end_data_table_row()."\n";
                   9775:         }
                   9776:     }
                   9777:     my $delidx = $counter;
                   9778:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   9779:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   9780:         $delete_output .= &start_data_table_row().
                   9781:                           '<td><img src="'.&icon($oldfile).'" />'.
                   9782:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   9783:                           '<td>'.$size.'</td>'.
                   9784:                           '<td>'.$mtime.'</td>'.
                   9785:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   9786:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   9787:                           &embedded_file_element('upload_embedded',$delidx,
                   9788:                                                  $oldfile,\%mapping,$allfiles,
                   9789:                                                  $codebase,'delete').'</td>'.
                   9790:                           &end_data_table_row()."\n"; 
                   9791:         $numunused ++;
                   9792:         $delidx ++;
1.987     raeburn  9793:     }
                   9794:     if ($upload_output) {
                   9795:         $upload_output = &start_data_table().
                   9796:                          $upload_output.
                   9797:                          &end_data_table()."\n";
                   9798:     }
1.1071    raeburn  9799:     if ($modify_output) {
                   9800:         $modify_output = &start_data_table().
                   9801:                          &start_data_table_header_row().
                   9802:                          '<th>'.&mt('File').'</th>'.
                   9803:                          '<th>'.&mt('Size (KB)').'</th>'.
                   9804:                          '<th>'.&mt('Modified').'</th>'.
                   9805:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   9806:                          &end_data_table_header_row().
                   9807:                          $modify_output.
                   9808:                          &end_data_table()."\n";
                   9809:     }
                   9810:     if ($delete_output) {
                   9811:         $delete_output = &start_data_table().
                   9812:                          &start_data_table_header_row().
                   9813:                          '<th>'.&mt('File').'</th>'.
                   9814:                          '<th>'.&mt('Size (KB)').'</th>'.
                   9815:                          '<th>'.&mt('Modified').'</th>'.
                   9816:                          '<th>'.&mt('Delete?').'</th>'.
                   9817:                          &end_data_table_header_row().
                   9818:                          $delete_output.
                   9819:                          &end_data_table()."\n";
                   9820:     }
1.987     raeburn  9821:     my $applies = 0;
                   9822:     if ($numremref) {
                   9823:         $applies ++;
                   9824:     }
                   9825:     if ($numinvalid) {
                   9826:         $applies ++;
                   9827:     }
                   9828:     if ($numexisting) {
                   9829:         $applies ++;
                   9830:     }
1.1071    raeburn  9831:     if ($counter || $numunused) {
1.987     raeburn  9832:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   9833:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  9834:                   $state.'<h3>'.$heading.'</h3>'; 
                   9835:         if ($actionurl eq '/adm/dependencies') {
                   9836:             if ($numnew) {
                   9837:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   9838:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   9839:                            $upload_output.'<br />'."\n";
                   9840:             }
                   9841:             if ($numexisting) {
                   9842:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   9843:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   9844:                            $modify_output.'<br />'."\n";
                   9845:                            $buttontext = &mt('Save changes');
                   9846:             }
                   9847:             if ($numunused) {
                   9848:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   9849:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   9850:                            $delete_output.'<br />'."\n";
                   9851:                            $buttontext = &mt('Save changes');
                   9852:             }
                   9853:         } else {
                   9854:             $output .= $upload_output.'<br />'."\n";
                   9855:         }
                   9856:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   9857:                    $counter.'" />'."\n";
                   9858:         if ($actionurl eq '/adm/dependencies') { 
                   9859:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   9860:                        $numnew.'" />'."\n";
                   9861:         } elsif ($actionurl eq '') {
1.987     raeburn  9862:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   9863:         }
                   9864:     } elsif ($applies) {
                   9865:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   9866:         if ($applies > 1) {
                   9867:             $output .=  
                   9868:                 &mt('No files need to be uploaded, as one of the following applies to each reference:').'<ul>';
                   9869:             if ($numremref) {
                   9870:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   9871:             }
                   9872:             if ($numinvalid) {
                   9873:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   9874:             }
                   9875:             if ($numexisting) {
                   9876:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   9877:             }
                   9878:             $output .= '</ul><br />';
                   9879:         } elsif ($numremref) {
                   9880:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   9881:         } elsif ($numinvalid) {
                   9882:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   9883:         } elsif ($numexisting) {
                   9884:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   9885:         }
                   9886:         $output .= $upload_output.'<br />';
                   9887:     }
                   9888:     my ($pathchange_output,$chgcount);
1.1071    raeburn  9889:     $chgcount = $counter;
1.987     raeburn  9890:     if (keys(%pathchanges) > 0) {
                   9891:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  9892:             if ($counter) {
1.987     raeburn  9893:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   9894:                                                   $embed_file,\%mapping,
1.1071    raeburn  9895:                                                   $allfiles,$codebase,'change');
1.987     raeburn  9896:             } else {
                   9897:                 $pathchange_output .= 
                   9898:                     &start_data_table_row().
                   9899:                     '<td><input type ="checkbox" name="namechange" value="'.
                   9900:                     $chgcount.'" checked="checked" /></td>'.
                   9901:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   9902:                     '<td>'.$embed_file.
                   9903:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  9904:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  9905:                     '</td>'.&end_data_table_row();
1.660     raeburn  9906:             }
1.987     raeburn  9907:             $numpathchg ++;
                   9908:             $chgcount ++;
1.660     raeburn  9909:         }
                   9910:     }
1.1071    raeburn  9911:     if ($counter) {
1.987     raeburn  9912:         if ($numpathchg) {
                   9913:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   9914:                        $numpathchg.'" />'."\n";
                   9915:         }
                   9916:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   9917:             ($actionurl eq '/adm/imsimport')) {
                   9918:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   9919:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   9920:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  9921:         } elsif ($actionurl eq '/adm/dependencies') {
                   9922:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  9923:         }
1.1071    raeburn  9924:         $output .=  '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  9925:     } elsif ($numpathchg) {
                   9926:         my %pathchange = ();
                   9927:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   9928:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9929:             $output .= '<p>'.&mt('or').'</p>'; 
                   9930:         } 
                   9931:     }
1.1071    raeburn  9932:     return ($output,$counter,$numpathchg);
1.987     raeburn  9933: }
                   9934: 
                   9935: sub embedded_file_element {
1.1071    raeburn  9936:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  9937:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   9938:                    (ref($codebase) eq 'HASH'));
                   9939:     my $output;
1.1071    raeburn  9940:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  9941:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   9942:     }
                   9943:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   9944:                &escape($embed_file).'" />';
                   9945:     unless (($context eq 'upload_embedded') && 
                   9946:             ($mapping->{$embed_file} eq $embed_file)) {
                   9947:         $output .='
                   9948:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   9949:     }
                   9950:     my $attrib;
                   9951:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   9952:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   9953:     }
                   9954:     $output .=
                   9955:         "\n\t\t".
                   9956:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   9957:         $attrib.'" />';
                   9958:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   9959:         $output .=
                   9960:             "\n\t\t".
                   9961:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   9962:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  9963:     }
1.987     raeburn  9964:     return $output;
1.660     raeburn  9965: }
                   9966: 
1.1071    raeburn  9967: sub get_dependency_details {
                   9968:     my ($currfile,$currsubfile,$embed_file) = @_;
                   9969:     my ($size,$mtime,$showsize,$showmtime);
                   9970:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   9971:         if ($embed_file =~ m{/}) {
                   9972:             my ($path,$fname) = split(/\//,$embed_file);
                   9973:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   9974:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   9975:             }
                   9976:         } else {
                   9977:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   9978:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   9979:             }
                   9980:         }
                   9981:         $showsize = $size/1024.0;
                   9982:         $showsize = sprintf("%.1f",$showsize);
                   9983:         if ($mtime > 0) {
                   9984:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   9985:         }
                   9986:     }
                   9987:     return ($showsize,$showmtime);
                   9988: }
                   9989: 
                   9990: sub ask_embedded_js {
                   9991:     return <<"END";
                   9992: <script type="text/javascript"">
                   9993: // <![CDATA[
                   9994: function toggleBrowse(counter) {
                   9995:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   9996:     var fileid = document.getElementById('embedded_item_'+counter);
                   9997:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   9998:     if (chkboxid.checked == true) {
                   9999:         uploaddivid.style.display='block';
                   10000:     } else {
                   10001:         uploaddivid.style.display='none';
                   10002:         fileid.value = '';
                   10003:     }
                   10004: }
                   10005: // ]]>
                   10006: </script>
                   10007: 
                   10008: END
                   10009: }
                   10010: 
1.661     raeburn  10011: sub upload_embedded {
                   10012:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  10013:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   10014:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  10015:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   10016:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   10017:         my $orig_uploaded_filename =
                   10018:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  10019:         foreach my $type ('orig','ref','attrib','codebase') {
                   10020:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   10021:                 $env{'form.embedded_'.$type.'_'.$i} =
                   10022:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   10023:             }
                   10024:         }
1.661     raeburn  10025:         my ($path,$fname) =
                   10026:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   10027:         # no path, whole string is fname
                   10028:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   10029:         $fname = &Apache::lonnet::clean_filename($fname);
                   10030:         # See if there is anything left
                   10031:         next if ($fname eq '');
                   10032: 
                   10033:         # Check if file already exists as a file or directory.
                   10034:         my ($state,$msg);
                   10035:         if ($context eq 'portfolio') {
                   10036:             my $port_path = $dirpath;
                   10037:             if ($group ne '') {
                   10038:                 $port_path = "groups/$group/$port_path";
                   10039:             }
1.987     raeburn  10040:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   10041:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  10042:                                               $dir_root,$port_path,$disk_quota,
                   10043:                                               $current_disk_usage,$uname,$udom);
                   10044:             if ($state eq 'will_exceed_quota'
1.984     raeburn  10045:                 || $state eq 'file_locked') {
1.661     raeburn  10046:                 $output .= $msg;
                   10047:                 next;
                   10048:             }
                   10049:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   10050:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   10051:             if ($state eq 'exists') {
                   10052:                 $output .= $msg;
                   10053:                 next;
                   10054:             }
                   10055:         }
                   10056:         # Check if extension is valid
                   10057:         if (($fname =~ /\.(\w+)$/) &&
                   10058:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.987     raeburn  10059:             $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  10060:             next;
                   10061:         } elsif (($fname =~ /\.(\w+)$/) &&
                   10062:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  10063:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  10064:             next;
                   10065:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.987     raeburn  10066:             $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'<br />';
1.661     raeburn  10067:             next;
                   10068:         }
                   10069:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
                   10070:         if ($context eq 'portfolio') {
1.984     raeburn  10071:             my $result;
                   10072:             if ($state eq 'existingfile') {
                   10073:                 $result=
                   10074:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.987     raeburn  10075:                                                     $dirpath.$env{'form.currentpath'}.$path);
1.661     raeburn  10076:             } else {
1.984     raeburn  10077:                 $result=
                   10078:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  10079:                                                     $dirpath.
                   10080:                                                     $env{'form.currentpath'}.$path);
1.984     raeburn  10081:                 if ($result !~ m|^/uploaded/|) {
                   10082:                     $output .= '<span class="LC_error">'
                   10083:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10084:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10085:                                .'</span><br />';
                   10086:                     next;
                   10087:                 } else {
1.987     raeburn  10088:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10089:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  10090:                 }
1.661     raeburn  10091:             }
1.987     raeburn  10092:         } elsif ($context eq 'coursedoc') {
                   10093:             my $result =
                   10094:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',
                   10095:                                                 $dirpath.'/'.$path);
                   10096:             if ($result !~ m|^/uploaded/|) {
                   10097:                 $output .= '<span class="LC_error">'
                   10098:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10099:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10100:                            .'</span><br />';
                   10101:                     next;
                   10102:             } else {
                   10103:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10104:                            $path.$fname.'</span>').'<br />';
                   10105:             }
1.661     raeburn  10106:         } else {
                   10107: # Save the file
                   10108:             my $target = $env{'form.embedded_item_'.$i};
                   10109:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   10110:             my $dest = $fullpath.$fname;
                   10111:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  10112:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  10113:             my $count;
                   10114:             my $filepath = $dir_root;
1.1027    raeburn  10115:             foreach my $subdir (@parts) {
                   10116:                 $filepath .= "/$subdir";
                   10117:                 if (!-e $filepath) {
1.661     raeburn  10118:                     mkdir($filepath,0770);
                   10119:                 }
                   10120:             }
                   10121:             my $fh;
                   10122:             if (!open($fh,'>'.$dest)) {
                   10123:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   10124:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  10125:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   10126:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10127:                            '</span><br />';
                   10128:             } else {
                   10129:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   10130:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   10131:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  10132:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   10133:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10134:                               '</span><br />';
                   10135:                 } else {
1.987     raeburn  10136:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10137:                                $url.'</span>').'<br />';
                   10138:                     unless ($context eq 'testbank') {
                   10139:                         $footer .= &mt('View embedded file: [_1]',
                   10140:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   10141:                     }
                   10142:                 }
                   10143:                 close($fh);
                   10144:             }
                   10145:         }
                   10146:         if ($env{'form.embedded_ref_'.$i}) {
                   10147:             $pathchange{$i} = 1;
                   10148:         }
                   10149:     }
                   10150:     if ($output) {
                   10151:         $output = '<p>'.$output.'</p>';
                   10152:     }
                   10153:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   10154:     $returnflag = 'ok';
1.1071    raeburn  10155:     my $numpathchgs = scalar(keys(%pathchange));
                   10156:     if ($numpathchgs > 0) {
1.987     raeburn  10157:         if ($context eq 'portfolio') {
                   10158:             $output .= '<p>'.&mt('or').'</p>';
                   10159:         } elsif ($context eq 'testbank') {
1.1071    raeburn  10160:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   10161:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  10162:             $returnflag = 'modify_orightml';
                   10163:         }
                   10164:     }
1.1071    raeburn  10165:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  10166: }
                   10167: 
                   10168: sub modify_html_form {
                   10169:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   10170:     my $end = 0;
                   10171:     my $modifyform;
                   10172:     if ($context eq 'upload_embedded') {
                   10173:         return unless (ref($pathchange) eq 'HASH');
                   10174:         if ($env{'form.number_embedded_items'}) {
                   10175:             $end += $env{'form.number_embedded_items'};
                   10176:         }
                   10177:         if ($env{'form.number_pathchange_items'}) {
                   10178:             $end += $env{'form.number_pathchange_items'};
                   10179:         }
                   10180:         if ($end) {
                   10181:             for (my $i=0; $i<$end; $i++) {
                   10182:                 if ($i < $env{'form.number_embedded_items'}) {
                   10183:                     next unless($pathchange->{$i});
                   10184:                 }
                   10185:                 $modifyform .=
                   10186:                     &start_data_table_row().
                   10187:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   10188:                     'checked="checked" /></td>'.
                   10189:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   10190:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   10191:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   10192:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   10193:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   10194:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   10195:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   10196:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   10197:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   10198:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   10199:                     &end_data_table_row();
1.1071    raeburn  10200:             }
1.987     raeburn  10201:         }
                   10202:     } else {
                   10203:         $modifyform = $pathchgtable;
                   10204:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   10205:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   10206:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10207:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   10208:         }
                   10209:     }
                   10210:     if ($modifyform) {
1.1071    raeburn  10211:         if ($actionurl eq '/adm/dependencies') {
                   10212:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   10213:         }
1.987     raeburn  10214:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   10215:                '<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".
                   10216:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   10217:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   10218:                '</ol></p>'."\n".'<p>'.
                   10219:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   10220:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   10221:                &start_data_table()."\n".
                   10222:                &start_data_table_header_row().
                   10223:                '<th>'.&mt('Change?').'</th>'.
                   10224:                '<th>'.&mt('Current reference').'</th>'.
                   10225:                '<th>'.&mt('Required reference').'</th>'.
                   10226:                &end_data_table_header_row()."\n".
                   10227:                $modifyform.
                   10228:                &end_data_table().'<br />'."\n".$hiddenstate.
                   10229:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   10230:                '</form>'."\n";
                   10231:     }
                   10232:     return;
                   10233: }
                   10234: 
                   10235: sub modify_html_refs {
                   10236:     my ($context,$dirpath,$uname,$udom,$dir_root) = @_;
                   10237:     my $container;
                   10238:     if ($context eq 'portfolio') {
                   10239:         $container = $env{'form.container'};
                   10240:     } elsif ($context eq 'coursedoc') {
                   10241:         $container = $env{'form.primaryurl'};
1.1071    raeburn  10242:     } elsif ($context eq 'manage_dependencies') {
                   10243:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   10244:         $container = "/$container";
1.987     raeburn  10245:     } else {
1.1027    raeburn  10246:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  10247:     }
                   10248:     my (%allfiles,%codebase,$output,$content);
                   10249:     my @changes = &get_env_multiple('form.namechange');
1.1071    raeburn  10250:     unless (@changes > 0) {
                   10251:         if (wantarray) {
                   10252:             return ('',0,0); 
                   10253:         } else {
                   10254:             return;
                   10255:         }
                   10256:     }
                   10257:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
                   10258:         ($context eq 'manage_dependencies')) {
                   10259:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   10260:             if (wantarray) {
                   10261:                 return ('',0,0);
                   10262:             } else {
                   10263:                 return;
                   10264:             }
                   10265:         } 
1.987     raeburn  10266:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  10267:         if ($content eq '-1') {
                   10268:             if (wantarray) {
                   10269:                 return ('',0,0);
                   10270:             } else {
                   10271:                 return;
                   10272:             }
                   10273:         }
1.987     raeburn  10274:     } else {
1.1071    raeburn  10275:         unless ($container =~ /^\Q$dir_root\E/) {
                   10276:             if (wantarray) {
                   10277:                 return ('',0,0);
                   10278:             } else {
                   10279:                 return;
                   10280:             }
                   10281:         } 
1.987     raeburn  10282:         if (open(my $fh,"<$container")) {
                   10283:             $content = join('', <$fh>);
                   10284:             close($fh);
                   10285:         } else {
1.1071    raeburn  10286:             if (wantarray) {
                   10287:                 return ('',0,0);
                   10288:             } else {
                   10289:                 return;
                   10290:             }
1.987     raeburn  10291:         }
                   10292:     }
                   10293:     my ($count,$codebasecount) = (0,0);
                   10294:     my $mm = new File::MMagic;
                   10295:     my $mime_type = $mm->checktype_contents($content);
                   10296:     if ($mime_type eq 'text/html') {
                   10297:         my $parse_result = 
                   10298:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   10299:                                                     \%codebase,\$content);
                   10300:         if ($parse_result eq 'ok') {
                   10301:             foreach my $i (@changes) {
                   10302:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   10303:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   10304:                 if ($allfiles{$ref}) {
                   10305:                     my $newname =  $orig;
                   10306:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  10307:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  10308:                     if ($attrib_regexp =~ /:/) {
                   10309:                         $attrib_regexp =~ s/\:/|/g;
                   10310:                     }
                   10311:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10312:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10313:                         $count += $numchg;
                   10314:                     }
                   10315:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  10316:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  10317:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   10318:                         $codebasecount ++;
                   10319:                     }
                   10320:                 }
                   10321:             }
                   10322:             if ($count || $codebasecount) {
                   10323:                 my $saveresult;
1.1071    raeburn  10324:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
                   10325:                     ($context eq 'manage_dependencies')) {
1.987     raeburn  10326:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10327:                     if ($url eq $container) {
                   10328:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   10329:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10330:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  10331:                                             $fname.'</span>').'</p>';
1.987     raeburn  10332:                     } else {
                   10333:                          $output = '<p class="LC_error">'.
                   10334:                                    &mt('Error: update failed for: [_1].',
                   10335:                                    '<span class="LC_filename">'.
                   10336:                                    $container.'</span>').'</p>';
                   10337:                     }
                   10338:                 } else {
                   10339:                     if (open(my $fh,">$container")) {
                   10340:                         print $fh $content;
                   10341:                         close($fh);
                   10342:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10343:                                   $count,'<span class="LC_filename">'.
                   10344:                                   $container.'</span>').'</p>';
1.661     raeburn  10345:                     } else {
1.987     raeburn  10346:                          $output = '<p class="LC_error">'.
                   10347:                                    &mt('Error: could not update [_1].',
                   10348:                                    '<span class="LC_filename">'.
                   10349:                                    $container.'</span>').'</p>';
1.661     raeburn  10350:                     }
                   10351:                 }
                   10352:             }
1.987     raeburn  10353:         } else {
                   10354:             &logthis('Failed to parse '.$container.
                   10355:                      ' to modify references: '.$parse_result);
1.661     raeburn  10356:         }
                   10357:     }
1.1071    raeburn  10358:     if (wantarray) {
                   10359:         return ($output,$count,$codebasecount);
                   10360:     } else {
                   10361:         return $output;
                   10362:     }
1.661     raeburn  10363: }
                   10364: 
                   10365: sub check_for_existing {
                   10366:     my ($path,$fname,$element) = @_;
                   10367:     my ($state,$msg);
                   10368:     if (-d $path.'/'.$fname) {
                   10369:         $state = 'exists';
                   10370:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10371:     } elsif (-e $path.'/'.$fname) {
                   10372:         $state = 'exists';
                   10373:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10374:     }
                   10375:     if ($state eq 'exists') {
                   10376:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   10377:     }
                   10378:     return ($state,$msg);
                   10379: }
                   10380: 
                   10381: sub check_for_upload {
                   10382:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   10383:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  10384:     my $filesize = length($env{'form.'.$element});
                   10385:     if (!$filesize) {
                   10386:         my $msg = '<span class="LC_error">'.
                   10387:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   10388:                       '<span class="LC_filename">'.$fname.'</span>',
                   10389:                       $filesize).'<br />'.
1.1007    raeburn  10390:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  10391:                   '</span>';
                   10392:         return ('zero_bytes',$msg);
                   10393:     }
                   10394:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  10395:     my $getpropath = 1;
1.1021    raeburn  10396:     my ($dirlistref,$listerror) =
                   10397:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  10398:     my $found_file = 0;
                   10399:     my $locked_file = 0;
1.991     raeburn  10400:     my @lockers;
                   10401:     my $navmap;
                   10402:     if ($env{'request.course.id'}) {
                   10403:         $navmap = Apache::lonnavmaps::navmap->new();
                   10404:     }
1.1021    raeburn  10405:     if (ref($dirlistref) eq 'ARRAY') {
                   10406:         foreach my $line (@{$dirlistref}) {
                   10407:             my ($file_name,$rest)=split(/\&/,$line,2);
                   10408:             if ($file_name eq $fname){
                   10409:                 $file_name = $path.$file_name;
                   10410:                 if ($group ne '') {
                   10411:                     $file_name = $group.$file_name;
                   10412:                 }
                   10413:                 $found_file = 1;
                   10414:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   10415:                     foreach my $lock (@lockers) {
                   10416:                         if (ref($lock) eq 'ARRAY') {
                   10417:                             my ($symb,$crsid) = @{$lock};
                   10418:                             if ($crsid eq $env{'request.course.id'}) {
                   10419:                                 if (ref($navmap)) {
                   10420:                                     my $res = $navmap->getBySymb($symb);
                   10421:                                     foreach my $part (@{$res->parts()}) { 
                   10422:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   10423:                                         unless (($slot_status == $res->RESERVED) ||
                   10424:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   10425:                                             $locked_file = 1;
                   10426:                                         }
1.991     raeburn  10427:                                     }
1.1021    raeburn  10428:                                 } else {
                   10429:                                     $locked_file = 1;
1.991     raeburn  10430:                                 }
                   10431:                             } else {
                   10432:                                 $locked_file = 1;
                   10433:                             }
                   10434:                         }
1.1021    raeburn  10435:                    }
                   10436:                 } else {
                   10437:                     my @info = split(/\&/,$rest);
                   10438:                     my $currsize = $info[6]/1000;
                   10439:                     if ($currsize < $filesize) {
                   10440:                         my $extra = $filesize - $currsize;
                   10441:                         if (($current_disk_usage + $extra) > $disk_quota) {
                   10442:                             my $msg = '<span class="LC_error">'.
                   10443:                                       &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.',
                   10444:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
                   10445:                                       '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   10446:                                                    $disk_quota,$current_disk_usage);
                   10447:                             return ('will_exceed_quota',$msg);
                   10448:                         }
1.984     raeburn  10449:                     }
                   10450:                 }
1.661     raeburn  10451:             }
                   10452:         }
                   10453:     }
                   10454:     if (($current_disk_usage + $filesize) > $disk_quota){
                   10455:         my $msg = '<span class="LC_error">'.
                   10456:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   10457:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   10458:         return ('will_exceed_quota',$msg);
                   10459:     } elsif ($found_file) {
                   10460:         if ($locked_file) {
                   10461:             my $msg = '<span class="LC_error">';
                   10462:             $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>');
                   10463:             $msg .= '</span><br />';
                   10464:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   10465:             return ('file_locked',$msg);
                   10466:         } else {
                   10467:             my $msg = '<span class="LC_error">';
1.984     raeburn  10468:             $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  10469:             $msg .= '</span>';
1.984     raeburn  10470:             return ('existingfile',$msg);
1.661     raeburn  10471:         }
                   10472:     }
                   10473: }
                   10474: 
1.987     raeburn  10475: sub check_for_traversal {
                   10476:     my ($path,$url,$toplevel) = @_;
                   10477:     my @parts=split(/\//,$path);
                   10478:     my $cleanpath;
                   10479:     my $fullpath = $url;
                   10480:     for (my $i=0;$i<@parts;$i++) {
                   10481:         next if ($parts[$i] eq '.');
                   10482:         if ($parts[$i] eq '..') {
                   10483:             $fullpath =~ s{([^/]+/)$}{};
                   10484:         } else {
                   10485:             $fullpath .= $parts[$i].'/';
                   10486:         }
                   10487:     }
                   10488:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   10489:         $cleanpath = $1;
                   10490:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   10491:         my $curr_toprel = $1;
                   10492:         my @parts = split(/\//,$curr_toprel);
                   10493:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   10494:         my @urlparts = split(/\//,$url_toprel);
                   10495:         my $doubledots;
                   10496:         my $startdiff = -1;
                   10497:         for (my $i=0; $i<@urlparts; $i++) {
                   10498:             if ($startdiff == -1) {
                   10499:                 unless ($urlparts[$i] eq $parts[$i]) {
                   10500:                     $startdiff = $i;
                   10501:                     $doubledots .= '../';
                   10502:                 }
                   10503:             } else {
                   10504:                 $doubledots .= '../';
                   10505:             }
                   10506:         }
                   10507:         if ($startdiff > -1) {
                   10508:             $cleanpath = $doubledots;
                   10509:             for (my $i=$startdiff; $i<@parts; $i++) {
                   10510:                 $cleanpath .= $parts[$i].'/';
                   10511:             }
                   10512:         }
                   10513:     }
                   10514:     $cleanpath =~ s{(/)$}{};
                   10515:     return $cleanpath;
                   10516: }
1.31      albertel 10517: 
1.1053    raeburn  10518: sub is_archive_file {
                   10519:     my ($mimetype) = @_;
                   10520:     if (($mimetype eq 'application/octet-stream') ||
                   10521:         ($mimetype eq 'application/x-stuffit') ||
                   10522:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   10523:         return 1;
                   10524:     }
                   10525:     return;
                   10526: }
                   10527: 
                   10528: sub decompress_form {
1.1065    raeburn  10529:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  10530:     my %lt = &Apache::lonlocal::texthash (
                   10531:         this => 'This file is an archive file.',
1.1067    raeburn  10532:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  10533:         itsc => 'Its contents are as follows:',
1.1053    raeburn  10534:         youm => 'You may wish to extract its contents.',
                   10535:         extr => 'Extract contents',
1.1067    raeburn  10536:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   10537:         proa => 'Process automatically?',
1.1053    raeburn  10538:         yes  => 'Yes',
                   10539:         no   => 'No',
1.1067    raeburn  10540:         fold => 'Title for folder containing movie',
                   10541:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  10542:     );
1.1065    raeburn  10543:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  10544:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  10545:     my $info = &list_archive_contents($fileloc,\@paths);
                   10546:     if (@paths) {
                   10547:         foreach my $path (@paths) {
                   10548:             $path =~ s{^/}{};
1.1067    raeburn  10549:             if ($path =~ m{^([^/]+)/$}) {
                   10550:                 $topdir = $1;
                   10551:             }
1.1065    raeburn  10552:             if ($path =~ m{^([^/]+)/}) {
                   10553:                 $toplevel{$1} = $path;
                   10554:             } else {
                   10555:                 $toplevel{$path} = $path;
                   10556:             }
                   10557:         }
                   10558:     }
1.1067    raeburn  10559:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
                   10560:         my @camtasia = ("$topdir/","$topdir/index.html",
                   10561:                         "$topdir/media/",
                   10562:                         "$topdir/media/$topdir.mp4",
                   10563:                         "$topdir/media/FirstFrame.png",
                   10564:                         "$topdir/media/player.swf",
                   10565:                         "$topdir/media/swfobject.js",
                   10566:                         "$topdir/media/expressInstall.swf");
                   10567:         my @diffs = &compare_arrays(\@paths,\@camtasia);
                   10568:         if (@diffs == 0) {
                   10569:             $is_camtasia = 1;
                   10570:         }
                   10571:     }
                   10572:     my $output;
                   10573:     if ($is_camtasia) {
                   10574:         $output = <<"ENDCAM";
                   10575: <script type="text/javascript" language="Javascript">
                   10576: // <![CDATA[
                   10577: 
                   10578: function camtasiaToggle() {
                   10579:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   10580:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
                   10581:             if (document.uploaded_decompress.autoextract_camtasia[i].value == 1) {
                   10582: 
                   10583:                 document.getElementById('camtasia_titles').style.display='block';
                   10584:             } else {
                   10585:                 document.getElementById('camtasia_titles').style.display='none';
                   10586:             }
                   10587:         }
                   10588:     }
                   10589:     return;
                   10590: }
                   10591: 
                   10592: // ]]>
                   10593: </script>
                   10594: <p>$lt{'camt'}</p>
                   10595: ENDCAM
1.1065    raeburn  10596:     } else {
1.1067    raeburn  10597:         $output = '<p>'.$lt{'this'};
                   10598:         if ($info eq '') {
                   10599:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   10600:         } else {
                   10601:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   10602:                        '<div><pre>'.$info.'</pre></div>';
                   10603:         }
1.1065    raeburn  10604:     }
1.1067    raeburn  10605:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  10606:     my $duplicates;
                   10607:     my $num = 0;
                   10608:     if (ref($dirlist) eq 'ARRAY') {
                   10609:         foreach my $item (@{$dirlist}) {
                   10610:             if (ref($item) eq 'ARRAY') {
                   10611:                 if (exists($toplevel{$item->[0]})) {
                   10612:                     $duplicates .= 
                   10613:                         &start_data_table_row().
                   10614:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   10615:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   10616:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   10617:                         'value="1" />'.&mt('Yes').'</label>'.
                   10618:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   10619:                         '<td>'.$item->[0].'</td>';
                   10620:                     if ($item->[2]) {
                   10621:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   10622:                     } else {
                   10623:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   10624:                     }
                   10625:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   10626:                                    '<td>'.
                   10627:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   10628:                                    '</td>'.
                   10629:                                    &end_data_table_row();
                   10630:                     $num ++;
                   10631:                 }
                   10632:             }
                   10633:         }
                   10634:     }
                   10635:     my $itemcount;
                   10636:     if (@paths > 0) {
                   10637:         $itemcount = scalar(@paths);
                   10638:     } else {
                   10639:         $itemcount = 1;
                   10640:     }
1.1067    raeburn  10641:     if ($is_camtasia) {
                   10642:         $output .= $lt{'auto'}.'<br />'.
                   10643:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
                   10644:                    '<input type="radio" name="autoextract_camtasia" value="1" onclick="javascript:camtasiaToggle();" checked="checked" />'.
                   10645:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   10646:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   10647:                    $lt{'no'}.'</label></span><br />'.
                   10648:                    '<div id="camtasia_titles" style="display:block">'.
                   10649:                    &Apache::lonhtmlcommon::start_pick_box().
                   10650:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   10651:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   10652:                    &Apache::lonhtmlcommon::row_closure().
                   10653:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   10654:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   10655:                    &Apache::lonhtmlcommon::row_closure(1).
                   10656:                    &Apache::lonhtmlcommon::end_pick_box().
                   10657:                    '</div>';
                   10658:     }
1.1065    raeburn  10659:     $output .= 
                   10660:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  10661:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   10662:         "\n";
1.1065    raeburn  10663:     if ($duplicates ne '') {
                   10664:         $output .= '<p><span class="LC_warning">'.
                   10665:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   10666:                    &start_data_table().
                   10667:                    &start_data_table_header_row().
                   10668:                    '<th>'.&mt('Overwrite?').'</th>'.
                   10669:                    '<th>'.&mt('Name').'</th>'.
                   10670:                    '<th>'.&mt('Type').'</th>'.
                   10671:                    '<th>'.&mt('Size').'</th>'.
                   10672:                    '<th>'.&mt('Last modified').'</th>'.
                   10673:                    &end_data_table_header_row().
                   10674:                    $duplicates.
                   10675:                    &end_data_table().
                   10676:                    '</p>';
                   10677:     }
1.1067    raeburn  10678:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  10679:     if (ref($hiddenelements) eq 'HASH') {
                   10680:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   10681:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   10682:         }
                   10683:     }
                   10684:     $output .= <<"END";
1.1067    raeburn  10685: <br />
1.1053    raeburn  10686: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   10687: </form>
                   10688: $noextract
                   10689: END
                   10690:     return $output;
                   10691: }
                   10692: 
1.1065    raeburn  10693: sub decompression_utility {
                   10694:     my ($program) = @_;
                   10695:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   10696:     my $location;
                   10697:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   10698:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   10699:                          '/usr/sbin/') {
                   10700:             if (-x $dir.$program) {
                   10701:                 $location = $dir.$program;
                   10702:                 last;
                   10703:             }
                   10704:         }
                   10705:     }
                   10706:     return $location;
                   10707: }
                   10708: 
                   10709: sub list_archive_contents {
                   10710:     my ($file,$pathsref) = @_;
                   10711:     my (@cmd,$output);
                   10712:     my $needsregexp;
                   10713:     if ($file =~ /\.zip$/) {
                   10714:         @cmd = (&decompression_utility('unzip'),"-l");
                   10715:         $needsregexp = 1;
                   10716:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   10717:              ($file =~ /\.tgz$/)) {
                   10718:         @cmd = (&decompression_utility('tar'),"-ztf");
                   10719:     } elsif ($file =~ /\.tar\.bz2$/) {
                   10720:         @cmd = (&decompression_utility('tar'),"-jtf");
                   10721:     } elsif ($file =~ m|\.tar$|) {
                   10722:         @cmd = (&decompression_utility('tar'),"-tf");
                   10723:     }
                   10724:     if (@cmd) {
                   10725:         undef($!);
                   10726:         undef($@);
                   10727:         if (open(my $fh,"-|", @cmd, $file)) {
                   10728:             while (my $line = <$fh>) {
                   10729:                 $output .= $line;
                   10730:                 chomp($line);
                   10731:                 my $item;
                   10732:                 if ($needsregexp) {
                   10733:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   10734:                 } else {
                   10735:                     $item = $line;
                   10736:                 }
                   10737:                 if ($item ne '') {
                   10738:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   10739:                         push(@{$pathsref},$item);
                   10740:                     } 
                   10741:                 }
                   10742:             }
                   10743:             close($fh);
                   10744:         }
                   10745:     }
                   10746:     return $output;
                   10747: }
                   10748: 
1.1053    raeburn  10749: sub decompress_uploaded_file {
                   10750:     my ($file,$dir) = @_;
                   10751:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   10752:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   10753:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   10754:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   10755:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   10756:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   10757:     my $decompressed = $env{'cgi.decompressed'};
                   10758:     &Apache::lonnet::delenv('cgi.file');
                   10759:     &Apache::lonnet::delenv('cgi.dir');
                   10760:     &Apache::lonnet::delenv('cgi.decompressed');
                   10761:     return ($decompressed,$result);
                   10762: }
                   10763: 
1.1055    raeburn  10764: sub process_decompression {
                   10765:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   10766:     my ($dir,$error,$warning,$output);
                   10767:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {
                   10768:         $error = &mt('File name not a supported archive file type.').
                   10769:                  '<br />'.&mt('File name should end with one of: [_1].',
                   10770:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   10771:     } else {
                   10772:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   10773:         if ($docuhome eq 'no_host') {
                   10774:             $error = &mt('Could not determine home server for course.');
                   10775:         } else {
                   10776:             my @ids=&Apache::lonnet::current_machine_ids();
                   10777:             my $currdir = "$dir_root/$destination";
                   10778:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   10779:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   10780:                        "$dir_root/$destination";
                   10781:             } else {
                   10782:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   10783:                        "$dir_root/$docudom/$docuname/$destination";
                   10784:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   10785:                     $error = &mt('Archive file not found.');
                   10786:                 }
                   10787:             }
1.1065    raeburn  10788:             my (@to_overwrite,@to_skip);
                   10789:             if ($env{'form.archive_overwrite_total'} > 0) {
                   10790:                 my $total = $env{'form.archive_overwrite_total'};
                   10791:                 for (my $i=0; $i<$total; $i++) {
                   10792:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   10793:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   10794:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   10795:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   10796:                     }
                   10797:                 }
                   10798:             }
                   10799:             my $numskip = scalar(@to_skip);
                   10800:             if (($numskip > 0) && 
                   10801:                 ($numskip == $env{'form.archive_itemcount'})) {
                   10802:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   10803:             } elsif ($dir eq '') {
1.1055    raeburn  10804:                 $error = &mt('Directory containing archive file unavailable.');
                   10805:             } elsif (!$error) {
1.1065    raeburn  10806:                 my ($decompressed,$display);
                   10807:                 if ($numskip > 0) {
                   10808:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   10809:                     mkdir("$dir/$tempdir",0755);
                   10810:                     system("mv $dir/$file $dir/$tempdir/$file");
                   10811:                     ($decompressed,$display) = 
                   10812:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   10813:                     foreach my $item (@to_skip) {
                   10814:                         if (($item ne '') && ($item !~ /\.\./)) {
                   10815:                             if (-f "$dir/$tempdir/$item") { 
                   10816:                                 unlink("$dir/$tempdir/$item");
                   10817:                             } elsif (-d "$dir/$tempdir/$item") {
                   10818:                                 system("rm -rf $dir/$tempdir/$item");
                   10819:                             }
                   10820:                         }
                   10821:                     }
                   10822:                     system("mv $dir/$tempdir/* $dir");
                   10823:                     rmdir("$dir/$tempdir");   
                   10824:                 } else {
                   10825:                     ($decompressed,$display) = 
                   10826:                         &decompress_uploaded_file($file,$dir);
                   10827:                 }
1.1055    raeburn  10828:                 if ($decompressed eq 'ok') {
1.1065    raeburn  10829:                     $output = '<p class="LC_info">'.
                   10830:                               &mt('Files extracted successfully from archive.').
                   10831:                               '</p>'."\n";
1.1055    raeburn  10832:                     my ($warning,$result,@contents);
                   10833:                     my ($newdirlistref,$newlisterror) =
                   10834:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   10835:                                                  $docuname,1);
                   10836:                     my (%is_dir,%changes,@newitems);
                   10837:                     my $dirptr = 16384;
1.1065    raeburn  10838:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  10839:                         foreach my $dir_line (@{$newdirlistref}) {
                   10840:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  10841:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   10842:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  10843:                                 push(@newitems,$item);
                   10844:                                 if ($dirptr&$testdir) {
                   10845:                                     $is_dir{$item} = 1;
                   10846:                                 }
                   10847:                                 $changes{$item} = 1;
                   10848:                             }
                   10849:                         }
                   10850:                     }
                   10851:                     if (keys(%changes) > 0) {
                   10852:                         foreach my $item (sort(@newitems)) {
                   10853:                             if ($changes{$item}) {
                   10854:                                 push(@contents,$item);
                   10855:                             }
                   10856:                         }
                   10857:                     }
                   10858:                     if (@contents > 0) {
1.1067    raeburn  10859:                         my $wantform;
                   10860:                         unless ($env{'form.autoextract_camtasia'}) {
                   10861:                             $wantform = 1;
                   10862:                         }
1.1056    raeburn  10863:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  10864:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   10865:                                                                 $currdir,\%is_dir,
                   10866:                                                                 \%children,\%parent,
1.1056    raeburn  10867:                                                                 \@contents,\%dirorder,
                   10868:                                                                 \%titles,$wantform);
1.1055    raeburn  10869:                         if ($datatable ne '') {
                   10870:                             $output .= &archive_options_form('decompressed',$datatable,
                   10871:                                                              $count,$hiddenelem);
1.1065    raeburn  10872:                             my $startcount = 6;
1.1055    raeburn  10873:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  10874:                                                            \%titles,\%children);
1.1055    raeburn  10875:                         }
1.1067    raeburn  10876:                         if ($env{'form.autoextract_camtasia'}) {
                   10877:                             my %displayed;
                   10878:                             my $total = 1;
                   10879:                             $env{'form.archive_directory'} = [];
                   10880:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   10881:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   10882:                                 $path =~ s{/$}{};
                   10883:                                 my $item;
                   10884:                                 if ($path ne '') {
                   10885:                                     $item = "$path/$titles{$i}";
                   10886:                                 } else {
                   10887:                                     $item = $titles{$i};
                   10888:                                 }
                   10889:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   10890:                                 if ($item eq $contents[0]) {
                   10891:                                     push(@{$env{'form.archive_directory'}},$i);
                   10892:                                     $env{'form.archive_'.$i} = 'display';
                   10893:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   10894:                                     $displayed{'folder'} = $i;
                   10895:                                 } elsif ($item eq "$contents[0]/index.html") {
                   10896:                                     $env{'form.archive_'.$i} = 'display';
                   10897:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   10898:                                     $displayed{'web'} = $i;
                   10899:                                 } else {
                   10900:                                     if ($item eq "$contents[0]/media") {
                   10901:                                         push(@{$env{'form.archive_directory'}},$i);
                   10902:                                     }
                   10903:                                     $env{'form.archive_'.$i} = 'dependency';
                   10904:                                 }
                   10905:                                 $total ++;
                   10906:                             }
                   10907:                             for (my $i=1; $i<$total; $i++) {
                   10908:                                 next if ($i == $displayed{'web'});
                   10909:                                 next if ($i == $displayed{'folder'});
                   10910:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   10911:                             }
                   10912:                             $env{'form.phase'} = 'decompress_cleanup';
                   10913:                             $env{'form.archivedelete'} = 1;
                   10914:                             $env{'form.archive_count'} = $total-1;
                   10915:                             $output .=
                   10916:                                 &process_extracted_files('coursedocs',$docudom,
                   10917:                                                          $docuname,$destination,
                   10918:                                                          $dir_root,$hiddenelem);
                   10919:                         }
1.1055    raeburn  10920:                     } else {
                   10921:                         $warning = &mt('No new items extracted from archive file.');
                   10922:                     }
                   10923:                 } else {
                   10924:                     $output = $display;
                   10925:                     $error = &mt('An error occurred during extraction from the archive file.');
                   10926:                 }
                   10927:             }
                   10928:         }
                   10929:     }
                   10930:     if ($error) {
                   10931:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   10932:                    $error.'</p>'."\n";
                   10933:     }
                   10934:     if ($warning) {
                   10935:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   10936:     }
                   10937:     return $output;
                   10938: }
                   10939: 
                   10940: sub get_extracted {
1.1056    raeburn  10941:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   10942:         $titles,$wantform) = @_;
1.1055    raeburn  10943:     my $count = 0;
                   10944:     my $depth = 0;
                   10945:     my $datatable;
1.1056    raeburn  10946:     my @hierarchy;
1.1055    raeburn  10947:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  10948:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   10949:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  10950:     foreach my $item (@{$contents}) {
                   10951:         $count ++;
1.1056    raeburn  10952:         @{$dirorder->{$count}} = @hierarchy;
                   10953:         $titles->{$count} = $item;
1.1055    raeburn  10954:         &archive_hierarchy($depth,$count,$parent,$children);
                   10955:         if ($wantform) {
                   10956:             $datatable .= &archive_row($is_dir->{$item},$item,
                   10957:                                        $currdir,$depth,$count);
                   10958:         }
                   10959:         if ($is_dir->{$item}) {
                   10960:             $depth ++;
1.1056    raeburn  10961:             push(@hierarchy,$count);
                   10962:             $parent->{$depth} = $count;
1.1055    raeburn  10963:             $datatable .=
                   10964:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  10965:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   10966:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  10967:             $depth --;
1.1056    raeburn  10968:             pop(@hierarchy);
1.1055    raeburn  10969:         }
                   10970:     }
                   10971:     return ($count,$datatable);
                   10972: }
                   10973: 
                   10974: sub recurse_extracted_archive {
1.1056    raeburn  10975:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   10976:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  10977:     my $result='';
1.1056    raeburn  10978:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   10979:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   10980:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  10981:         return $result;
                   10982:     }
                   10983:     my $dirptr = 16384;
                   10984:     my ($newdirlistref,$newlisterror) =
                   10985:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   10986:     if (ref($newdirlistref) eq 'ARRAY') {
                   10987:         foreach my $dir_line (@{$newdirlistref}) {
                   10988:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   10989:             unless ($item =~ /^\.+$/) {
                   10990:                 $$count ++;
1.1056    raeburn  10991:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   10992:                 $titles->{$$count} = $item;
1.1055    raeburn  10993:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  10994: 
1.1055    raeburn  10995:                 my $is_dir;
                   10996:                 if ($dirptr&$testdir) {
                   10997:                     $is_dir = 1;
                   10998:                 }
                   10999:                 if ($wantform) {
                   11000:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   11001:                 }
                   11002:                 if ($is_dir) {
                   11003:                     $$depth ++;
1.1056    raeburn  11004:                     push(@{$hierarchy},$$count);
                   11005:                     $parent->{$$depth} = $$count;
1.1055    raeburn  11006:                     $result .=
                   11007:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   11008:                                                    $docuname,$depth,$count,
1.1056    raeburn  11009:                                                    $hierarchy,$dirorder,$children,
                   11010:                                                    $parent,$titles,$wantform);
1.1055    raeburn  11011:                     $$depth --;
1.1056    raeburn  11012:                     pop(@{$hierarchy});
1.1055    raeburn  11013:                 }
                   11014:             }
                   11015:         }
                   11016:     }
                   11017:     return $result;
                   11018: }
                   11019: 
                   11020: sub archive_hierarchy {
                   11021:     my ($depth,$count,$parent,$children) =@_;
                   11022:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   11023:         if (exists($parent->{$depth})) {
                   11024:              $children->{$parent->{$depth}} .= $count.':';
                   11025:         }
                   11026:     }
                   11027:     return;
                   11028: }
                   11029: 
                   11030: sub archive_row {
                   11031:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   11032:     my ($name) = ($item =~ m{([^/]+)$});
                   11033:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  11034:                                        'display'    => 'Add as file',
1.1055    raeburn  11035:                                        'dependency' => 'Include as dependency',
                   11036:                                        'discard'    => 'Discard',
                   11037:                                       );
                   11038:     if ($is_dir) {
1.1059    raeburn  11039:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  11040:     }
1.1056    raeburn  11041:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   11042:     my $offset = 0;
1.1055    raeburn  11043:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  11044:         $offset ++;
1.1065    raeburn  11045:         if ($action ne 'display') {
                   11046:             $offset ++;
                   11047:         }  
1.1055    raeburn  11048:         $output .= '<td><span class="LC_nobreak">'.
                   11049:                    '<label><input type="radio" name="archive_'.$count.
                   11050:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   11051:         my $text = $choices{$action};
                   11052:         if ($is_dir) {
                   11053:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   11054:             if ($action eq 'display') {
1.1059    raeburn  11055:                 $text = &mt('Add as folder');
1.1055    raeburn  11056:             }
1.1056    raeburn  11057:         } else {
                   11058:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   11059: 
                   11060:         }
                   11061:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   11062:         if ($action eq 'dependency') {
                   11063:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   11064:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   11065:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   11066:                        '<option value=""></option>'."\n".
                   11067:                        '</select>'."\n".
                   11068:                        '</div>';
1.1059    raeburn  11069:         } elsif ($action eq 'display') {
                   11070:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   11071:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   11072:                        '</div>';
1.1055    raeburn  11073:         }
1.1056    raeburn  11074:         $output .= '</td>';
1.1055    raeburn  11075:     }
                   11076:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   11077:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   11078:     for (my $i=0; $i<$depth; $i++) {
                   11079:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   11080:     }
                   11081:     if ($is_dir) {
                   11082:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   11083:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   11084:     } else {
                   11085:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   11086:     }
                   11087:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   11088:                &end_data_table_row();
                   11089:     return $output;
                   11090: }
                   11091: 
                   11092: sub archive_options_form {
1.1065    raeburn  11093:     my ($form,$display,$count,$hiddenelem) = @_;
                   11094:     my %lt = &Apache::lonlocal::texthash(
                   11095:                perm => 'Permanently remove archive file?',
                   11096:                hows => 'How should each extracted item be incorporated in the course?',
                   11097:                cont => 'Content actions for all',
                   11098:                addf => 'Add as folder/file',
                   11099:                incd => 'Include as dependency for a displayed file',
                   11100:                disc => 'Discard',
                   11101:                no   => 'No',
                   11102:                yes  => 'Yes',
                   11103:                save => 'Save',
                   11104:     );
                   11105:     my $output = <<"END";
                   11106: <form name="$form" method="post" action="">
                   11107: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   11108: <label>
                   11109:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   11110: </label>
                   11111: &nbsp;
                   11112: <label>
                   11113:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   11114: </span>
                   11115: </p>
                   11116: <input type="hidden" name="phase" value="decompress_cleanup" />
                   11117: <br />$lt{'hows'}
                   11118: <div class="LC_columnSection">
                   11119:   <fieldset>
                   11120:     <legend>$lt{'cont'}</legend>
                   11121:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   11122:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   11123:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   11124:   </fieldset>
                   11125: </div>
                   11126: END
                   11127:     return $output.
1.1055    raeburn  11128:            &start_data_table()."\n".
1.1065    raeburn  11129:            $display."\n".
1.1055    raeburn  11130:            &end_data_table()."\n".
                   11131:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   11132:            $hiddenelem.
1.1065    raeburn  11133:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  11134:            '</form>';
                   11135: }
                   11136: 
                   11137: sub archive_javascript {
1.1056    raeburn  11138:     my ($startcount,$numitems,$titles,$children) = @_;
                   11139:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  11140:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  11141:     my $scripttag = <<START;
                   11142: <script type="text/javascript">
                   11143: // <![CDATA[
                   11144: 
                   11145: function checkAll(form,prefix) {
                   11146:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   11147:     for (var i=0; i < form.elements.length; i++) {
                   11148:         var id = form.elements[i].id;
                   11149:         if ((id != '') && (id != undefined)) {
                   11150:             if (idstr.test(id)) {
                   11151:                 if (form.elements[i].type == 'radio') {
                   11152:                     form.elements[i].checked = true;
1.1056    raeburn  11153:                     var nostart = i-$startcount;
1.1059    raeburn  11154:                     var offset = nostart%7;
                   11155:                     var count = (nostart-offset)/7;    
1.1056    raeburn  11156:                     dependencyCheck(form,count,offset);
1.1055    raeburn  11157:                 }
                   11158:             }
                   11159:         }
                   11160:     }
                   11161: }
                   11162: 
                   11163: function propagateCheck(form,count) {
                   11164:     if (count > 0) {
1.1059    raeburn  11165:         var startelement = $startcount + ((count-1) * 7);
                   11166:         for (var j=1; j<6; j++) {
                   11167:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  11168:                 var item = startelement + j; 
                   11169:                 if (form.elements[item].type == 'radio') {
                   11170:                     if (form.elements[item].checked) {
                   11171:                         containerCheck(form,count,j);
                   11172:                         break;
                   11173:                     }
1.1055    raeburn  11174:                 }
                   11175:             }
                   11176:         }
                   11177:     }
                   11178: }
                   11179: 
                   11180: numitems = $numitems
1.1056    raeburn  11181: var titles = new Array(numitems);
                   11182: var parents = new Array(numitems);
1.1055    raeburn  11183: for (var i=0; i<numitems; i++) {
1.1056    raeburn  11184:     parents[i] = new Array;
1.1055    raeburn  11185: }
1.1059    raeburn  11186: var maintitle = '$maintitle';
1.1055    raeburn  11187: 
                   11188: START
                   11189: 
1.1056    raeburn  11190:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   11191:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  11192:         for (my $i=0; $i<@contents; $i ++) {
                   11193:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   11194:         }
                   11195:     }
                   11196: 
1.1056    raeburn  11197:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   11198:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   11199:     }
                   11200: 
1.1055    raeburn  11201:     $scripttag .= <<END;
                   11202: 
                   11203: function containerCheck(form,count,offset) {
                   11204:     if (count > 0) {
1.1056    raeburn  11205:         dependencyCheck(form,count,offset);
1.1059    raeburn  11206:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  11207:         form.elements[item].checked = true;
                   11208:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11209:             if (parents[count].length > 0) {
                   11210:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  11211:                     containerCheck(form,parents[count][j],offset);
                   11212:                 }
                   11213:             }
                   11214:         }
                   11215:     }
                   11216: }
                   11217: 
                   11218: function dependencyCheck(form,count,offset) {
                   11219:     if (count > 0) {
1.1059    raeburn  11220:         var chosen = (offset+$startcount)+7*(count-1);
                   11221:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  11222:         var currtype = form.elements[depitem].type;
                   11223:         if (form.elements[chosen].value == 'dependency') {
                   11224:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   11225:             form.elements[depitem].options.length = 0;
                   11226:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11  raeburn  11227:             for (var i=1; i<=numitems; i++) {
                   11228:                 if (i == count) {
                   11229:                     continue;
                   11230:                 }
1.1059    raeburn  11231:                 var startelement = $startcount + (i-1) * 7;
                   11232:                 for (var j=1; j<6; j++) {
                   11233:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  11234:                         var item = startelement + j;
                   11235:                         if (form.elements[item].type == 'radio') {
                   11236:                             if (form.elements[item].checked) {
                   11237:                                 if (form.elements[item].value == 'display') {
                   11238:                                     var n = form.elements[depitem].options.length;
                   11239:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   11240:                                 }
                   11241:                             }
                   11242:                         }
                   11243:                     }
                   11244:                 }
                   11245:             }
                   11246:         } else {
                   11247:             document.getElementById('arc_depon_'+count).style.display='none';
                   11248:             form.elements[depitem].options.length = 0;
                   11249:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   11250:         }
1.1059    raeburn  11251:         titleCheck(form,count,offset);
1.1056    raeburn  11252:     }
                   11253: }
                   11254: 
                   11255: function propagateSelect(form,count,offset) {
                   11256:     if (count > 0) {
1.1065    raeburn  11257:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  11258:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   11259:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11260:             if (parents[count].length > 0) {
                   11261:                 for (var j=0; j<parents[count].length; j++) {
                   11262:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  11263:                 }
                   11264:             }
                   11265:         }
                   11266:     }
                   11267: }
1.1056    raeburn  11268: 
                   11269: function containerSelect(form,count,offset,picked) {
                   11270:     if (count > 0) {
1.1065    raeburn  11271:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  11272:         if (form.elements[item].type == 'radio') {
                   11273:             if (form.elements[item].value == 'dependency') {
                   11274:                 if (form.elements[item+1].type == 'select-one') {
                   11275:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   11276:                         if (form.elements[item+1].options[i].value == picked) {
                   11277:                             form.elements[item+1].selectedIndex = i;
                   11278:                             break;
                   11279:                         }
                   11280:                     }
                   11281:                 }
                   11282:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11283:                     if (parents[count].length > 0) {
                   11284:                         for (var j=0; j<parents[count].length; j++) {
                   11285:                             containerSelect(form,parents[count][j],offset,picked);
                   11286:                         }
                   11287:                     }
                   11288:                 }
                   11289:             }
                   11290:         }
                   11291:     }
                   11292: }
                   11293: 
1.1059    raeburn  11294: function titleCheck(form,count,offset) {
                   11295:     if (count > 0) {
                   11296:         var chosen = (offset+$startcount)+7*(count-1);
                   11297:         var depitem = $startcount + ((count-1) * 7) + 2;
                   11298:         var currtype = form.elements[depitem].type;
                   11299:         if (form.elements[chosen].value == 'display') {
                   11300:             document.getElementById('arc_title_'+count).style.display='block';
                   11301:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   11302:                 document.getElementById('archive_title_'+count).value=maintitle;
                   11303:             }
                   11304:         } else {
                   11305:             document.getElementById('arc_title_'+count).style.display='none';
                   11306:             if (currtype == 'text') { 
                   11307:                 document.getElementById('archive_title_'+count).value='';
                   11308:             }
                   11309:         }
                   11310:     }
                   11311:     return;
                   11312: }
                   11313: 
1.1055    raeburn  11314: // ]]>
                   11315: </script>
                   11316: END
                   11317:     return $scripttag;
                   11318: }
                   11319: 
                   11320: sub process_extracted_files {
1.1067    raeburn  11321:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  11322:     my $numitems = $env{'form.archive_count'};
                   11323:     return unless ($numitems);
                   11324:     my @ids=&Apache::lonnet::current_machine_ids();
                   11325:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  11326:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  11327:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11328:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11329:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   11330:         $pathtocheck = "$dir_root/$destination";
                   11331:         $dir = $dir_root;
                   11332:         $ishome = 1;
                   11333:     } else {
                   11334:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   11335:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   11336:         $dir = "$dir_root/$docudom/$docuname";    
                   11337:     }
                   11338:     my $currdir = "$dir_root/$destination";
                   11339:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   11340:     if ($env{'form.folderpath'}) {
                   11341:         my @items = split('&',$env{'form.folderpath'});
                   11342:         $folders{'0'} = $items[-2];
1.1075.2.17  raeburn  11343:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   11344:             $containers{'0'}='page';
                   11345:         } else {
                   11346:             $containers{'0'}='sequence';
                   11347:         }
1.1055    raeburn  11348:     }
                   11349:     my @archdirs = &get_env_multiple('form.archive_directory');
                   11350:     if ($numitems) {
                   11351:         for (my $i=1; $i<=$numitems; $i++) {
                   11352:             my $path = $env{'form.archive_content_'.$i};
                   11353:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   11354:                 my $item = $1;
                   11355:                 $toplevelitems{$item} = $i;
                   11356:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   11357:                     $is_dir{$item} = 1;
                   11358:                 }
                   11359:             }
                   11360:         }
                   11361:     }
1.1067    raeburn  11362:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  11363:     if (keys(%toplevelitems) > 0) {
                   11364:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  11365:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   11366:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  11367:     }
1.1066    raeburn  11368:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  11369:     if ($numitems) {
                   11370:         for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11  raeburn  11371:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  11372:             my $path = $env{'form.archive_content_'.$i};
                   11373:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11374:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   11375:                     if ($prefix ne '' && $path ne '') {
                   11376:                         if (-e $prefix.$path) {
1.1066    raeburn  11377:                             if ((@archdirs > 0) && 
                   11378:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   11379:                                 $todeletedir{$prefix.$path} = 1;
                   11380:                             } else {
                   11381:                                 $todelete{$prefix.$path} = 1;
                   11382:                             }
1.1055    raeburn  11383:                         }
                   11384:                     }
                   11385:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  11386:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  11387:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  11388:                     $docstitle = $env{'form.archive_title_'.$i};
                   11389:                     if ($docstitle eq '') {
                   11390:                         $docstitle = $title;
                   11391:                     }
1.1055    raeburn  11392:                     $outer = 0;
1.1056    raeburn  11393:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11394:                         if (@{$dirorder{$i}} > 0) {
                   11395:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  11396:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   11397:                                     $outer = $item;
                   11398:                                     last;
                   11399:                                 }
                   11400:                             }
                   11401:                         }
                   11402:                     }
                   11403:                     my ($errtext,$fatal) = 
                   11404:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   11405:                                                '/'.$folders{$outer}.'.'.
                   11406:                                                $containers{$outer});
                   11407:                     next if ($fatal);
                   11408:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   11409:                         if ($context eq 'coursedocs') {
1.1056    raeburn  11410:                             $mapinner{$i} = time;
1.1055    raeburn  11411:                             $folders{$i} = 'default_'.$mapinner{$i};
                   11412:                             $containers{$i} = 'sequence';
                   11413:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11414:                                       $folders{$i}.'.'.$containers{$i};
                   11415:                             my $newidx = &LONCAPA::map::getresidx();
                   11416:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11417:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11418:                             push(@LONCAPA::map::order,$newidx);
                   11419:                             my ($outtext,$errtext) =
                   11420:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11421:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  11422:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  11423:                             $newseqid{$i} = $newidx;
1.1067    raeburn  11424:                             unless ($errtext) {
                   11425:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   11426:                             }
1.1055    raeburn  11427:                         }
                   11428:                     } else {
                   11429:                         if ($context eq 'coursedocs') {
                   11430:                             my $newidx=&LONCAPA::map::getresidx();
                   11431:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11432:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   11433:                                       $title;
                   11434:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   11435:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   11436:                             }
                   11437:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11438:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   11439:                             }
                   11440:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11441:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  11442:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  11443:                                 unless ($ishome) {
                   11444:                                     my $fetch = "$newdest{$i}/$title";
                   11445:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   11446:                                     $prompttofetch{$fetch} = 1;
                   11447:                                 }
1.1055    raeburn  11448:                             }
                   11449:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11450:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11451:                             push(@LONCAPA::map::order, $newidx);
                   11452:                             my ($outtext,$errtext)=
                   11453:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11454:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  11455:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  11456:                             unless ($errtext) {
                   11457:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   11458:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   11459:                                 }
                   11460:                             }
1.1055    raeburn  11461:                         }
                   11462:                     }
1.1075.2.11  raeburn  11463:                 }
                   11464:             } else {
                   11465:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
                   11466:             }
                   11467:         }
                   11468:         for (my $i=1; $i<=$numitems; $i++) {
                   11469:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   11470:             my $path = $env{'form.archive_content_'.$i};
                   11471:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11472:                 my ($title) = ($path =~ m{/([^/]+)$});
                   11473:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   11474:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   11475:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11476:                         my ($itemidx,$fullpath,$relpath);
                   11477:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   11478:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  11479:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11  raeburn  11480:                                 if ($dirorder{$i}->[$j] eq $container) {
                   11481:                                     $itemidx = $j;
1.1056    raeburn  11482:                                 }
                   11483:                             }
1.1075.2.11  raeburn  11484:                         }
                   11485:                         if ($itemidx eq '') {
                   11486:                             $itemidx =  0;
                   11487:                         }
                   11488:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   11489:                             if ($mapinner{$referrer{$i}}) {
                   11490:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   11491:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11492:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11493:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11494:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11495:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11496:                                             if (!-e $fullpath) {
                   11497:                                                 mkdir($fullpath,0755);
1.1056    raeburn  11498:                                             }
                   11499:                                         }
1.1075.2.11  raeburn  11500:                                     } else {
                   11501:                                         last;
1.1056    raeburn  11502:                                     }
1.1075.2.11  raeburn  11503:                                 }
                   11504:                             }
                   11505:                         } elsif ($newdest{$referrer{$i}}) {
                   11506:                             $fullpath = $newdest{$referrer{$i}};
                   11507:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11508:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   11509:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   11510:                                     last;
                   11511:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11512:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11513:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11514:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11515:                                         if (!-e $fullpath) {
                   11516:                                             mkdir($fullpath,0755);
1.1056    raeburn  11517:                                         }
                   11518:                                     }
1.1075.2.11  raeburn  11519:                                 } else {
                   11520:                                     last;
1.1056    raeburn  11521:                                 }
1.1075.2.11  raeburn  11522:                             }
                   11523:                         }
                   11524:                         if ($fullpath ne '') {
                   11525:                             if (-e "$prefix$path") {
                   11526:                                 system("mv $prefix$path $fullpath/$title");
                   11527:                             }
                   11528:                             if (-e "$fullpath/$title") {
                   11529:                                 my $showpath;
                   11530:                                 if ($relpath ne '') {
                   11531:                                     $showpath = "$relpath/$title";
                   11532:                                 } else {
                   11533:                                     $showpath = "/$title";
1.1056    raeburn  11534:                                 }
1.1075.2.11  raeburn  11535:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   11536:                             }
                   11537:                             unless ($ishome) {
                   11538:                                 my $fetch = "$fullpath/$title";
                   11539:                                 $fetch =~ s/^\Q$prefix$dir\E//;
                   11540:                                 $prompttofetch{$fetch} = 1;
1.1055    raeburn  11541:                             }
                   11542:                         }
                   11543:                     }
1.1075.2.11  raeburn  11544:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   11545:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   11546:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  11547:                 }
                   11548:             } else {
1.1075.2.11  raeburn  11549:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055    raeburn  11550:             }
                   11551:         }
                   11552:         if (keys(%todelete)) {
                   11553:             foreach my $key (keys(%todelete)) {
                   11554:                 unlink($key);
1.1066    raeburn  11555:             }
                   11556:         }
                   11557:         if (keys(%todeletedir)) {
                   11558:             foreach my $key (keys(%todeletedir)) {
                   11559:                 rmdir($key);
                   11560:             }
                   11561:         }
                   11562:         foreach my $dir (sort(keys(%is_dir))) {
                   11563:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   11564:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  11565:             }
                   11566:         }
1.1067    raeburn  11567:         if ($result ne '') {
                   11568:             $output .= '<ul>'."\n".
                   11569:                        $result."\n".
                   11570:                        '</ul>';
                   11571:         }
                   11572:         unless ($ishome) {
                   11573:             my $replicationfail;
                   11574:             foreach my $item (keys(%prompttofetch)) {
                   11575:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   11576:                 unless ($fetchresult eq 'ok') {
                   11577:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   11578:                 }
                   11579:             }
                   11580:             if ($replicationfail) {
                   11581:                 $output .= '<p class="LC_error">'.
                   11582:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   11583:                            $replicationfail.
                   11584:                            '</ul></p>';
                   11585:             }
                   11586:         }
1.1055    raeburn  11587:     } else {
                   11588:         $warning = &mt('No items found in archive.');
                   11589:     }
                   11590:     if ($error) {
                   11591:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11592:                    $error.'</p>'."\n";
                   11593:     }
                   11594:     if ($warning) {
                   11595:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11596:     }
                   11597:     return $output;
                   11598: }
                   11599: 
1.1066    raeburn  11600: sub cleanup_empty_dirs {
                   11601:     my ($path) = @_;
                   11602:     if (($path ne '') && (-d $path)) {
                   11603:         if (opendir(my $dirh,$path)) {
                   11604:             my @dircontents = grep(!/^\./,readdir($dirh));
                   11605:             my $numitems = 0;
                   11606:             foreach my $item (@dircontents) {
                   11607:                 if (-d "$path/$item") {
                   11608:                     &recurse_dirs("$path/$item");
                   11609:                     if (-e "$path/$item") {
                   11610:                         $numitems ++;
                   11611:                     }
                   11612:                 } else {
                   11613:                     $numitems ++;
                   11614:                 }
                   11615:             }
                   11616:             if ($numitems == 0) {
                   11617:                 rmdir($path);
                   11618:             }
                   11619:             closedir($dirh);
                   11620:         }
                   11621:     }
                   11622:     return;
                   11623: }
                   11624: 
1.41      ng       11625: =pod
1.45      matthew  11626: 
1.1068    raeburn  11627: =item &get_folder_hierarchy()
                   11628: 
                   11629: Provides hierarchy of names of folders/sub-folders containing the current
                   11630: item,
                   11631: 
                   11632: Inputs: 3
                   11633:      - $navmap - navmaps object
                   11634: 
                   11635:      - $map - url for map (either the trigger itself, or map containing
                   11636:                            the resource, which is the trigger).
                   11637: 
                   11638:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   11639: 
                   11640: Outputs: 1 @pathitems - array of folder/subfolder names.
                   11641: 
                   11642: =cut
                   11643: 
                   11644: sub get_folder_hierarchy {
                   11645:     my ($navmap,$map,$showitem) = @_;
                   11646:     my @pathitems;
                   11647:     if (ref($navmap)) {
                   11648:         my $mapres = $navmap->getResourceByUrl($map);
                   11649:         if (ref($mapres)) {
                   11650:             my $pcslist = $mapres->map_hierarchy();
                   11651:             if ($pcslist ne '') {
                   11652:                 my @pcs = split(/,/,$pcslist);
                   11653:                 foreach my $pc (@pcs) {
                   11654:                     if ($pc == 1) {
                   11655:                         push(@pathitems,&mt('Main Course Documents'));
                   11656:                     } else {
                   11657:                         my $res = $navmap->getByMapPc($pc);
                   11658:                         if (ref($res)) {
                   11659:                             my $title = $res->compTitle();
                   11660:                             $title =~ s/\W+/_/g;
                   11661:                             if ($title ne '') {
                   11662:                                 push(@pathitems,$title);
                   11663:                             }
                   11664:                         }
                   11665:                     }
                   11666:                 }
                   11667:             }
1.1071    raeburn  11668:             if ($showitem) {
                   11669:                 if ($mapres->{ID} eq '0.0') {
                   11670:                     push(@pathitems,&mt('Main Course Documents'));
                   11671:                 } else {
                   11672:                     my $maptitle = $mapres->compTitle();
                   11673:                     $maptitle =~ s/\W+/_/g;
                   11674:                     if ($maptitle ne '') {
                   11675:                         push(@pathitems,$maptitle);
                   11676:                     }
1.1068    raeburn  11677:                 }
                   11678:             }
                   11679:         }
                   11680:     }
                   11681:     return @pathitems;
                   11682: }
                   11683: 
                   11684: =pod
                   11685: 
1.1015    raeburn  11686: =item * &get_turnedin_filepath()
                   11687: 
                   11688: Determines path in a user's portfolio file for storage of files uploaded
                   11689: to a specific essayresponse or dropbox item.
                   11690: 
                   11691: Inputs: 3 required + 1 optional.
                   11692: $symb is symb for resource, $uname and $udom are for current user (required).
                   11693: $caller is optional (can be "submission", if routine is called when storing
                   11694: an upoaded file when "Submit Answer" button was pressed).
                   11695: 
                   11696: Returns array containing $path and $multiresp. 
                   11697: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   11698: than one file upload item.  Callers of routine should append partid as a 
                   11699: subdirectory to $path in cases where $multiresp is 1.
                   11700: 
                   11701: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   11702: 
                   11703: =cut
                   11704: 
                   11705: sub get_turnedin_filepath {
                   11706:     my ($symb,$uname,$udom,$caller) = @_;
                   11707:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   11708:     my $turnindir;
                   11709:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   11710:     $turnindir = $userhash{'turnindir'};
                   11711:     my ($path,$multiresp);
                   11712:     if ($turnindir eq '') {
                   11713:         if ($caller eq 'submission') {
                   11714:             $turnindir = &mt('turned in');
                   11715:             $turnindir =~ s/\W+/_/g;
                   11716:             my %newhash = (
                   11717:                             'turnindir' => $turnindir,
                   11718:                           );
                   11719:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   11720:         }
                   11721:     }
                   11722:     if ($turnindir ne '') {
                   11723:         $path = '/'.$turnindir.'/';
                   11724:         my ($multipart,$turnin,@pathitems);
                   11725:         my $navmap = Apache::lonnavmaps::navmap->new();
                   11726:         if (defined($navmap)) {
                   11727:             my $mapres = $navmap->getResourceByUrl($map);
                   11728:             if (ref($mapres)) {
                   11729:                 my $pcslist = $mapres->map_hierarchy();
                   11730:                 if ($pcslist ne '') {
                   11731:                     foreach my $pc (split(/,/,$pcslist)) {
                   11732:                         my $res = $navmap->getByMapPc($pc);
                   11733:                         if (ref($res)) {
                   11734:                             my $title = $res->compTitle();
                   11735:                             $title =~ s/\W+/_/g;
                   11736:                             if ($title ne '') {
                   11737:                                 push(@pathitems,$title);
                   11738:                             }
                   11739:                         }
                   11740:                     }
                   11741:                 }
                   11742:                 my $maptitle = $mapres->compTitle();
                   11743:                 $maptitle =~ s/\W+/_/g;
                   11744:                 if ($maptitle ne '') {
                   11745:                     push(@pathitems,$maptitle);
                   11746:                 }
                   11747:                 unless ($env{'request.state'} eq 'construct') {
                   11748:                     my $res = $navmap->getBySymb($symb);
                   11749:                     if (ref($res)) {
                   11750:                         my $partlist = $res->parts();
                   11751:                         my $totaluploads = 0;
                   11752:                         if (ref($partlist) eq 'ARRAY') {
                   11753:                             foreach my $part (@{$partlist}) {
                   11754:                                 my @types = $res->responseType($part);
                   11755:                                 my @ids = $res->responseIds($part);
                   11756:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   11757:                                     if ($types[$i] eq 'essay') {
                   11758:                                         my $partid = $part.'_'.$ids[$i];
                   11759:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   11760:                                             $totaluploads ++;
                   11761:                                         }
                   11762:                                     }
                   11763:                                 }
                   11764:                             }
                   11765:                             if ($totaluploads > 1) {
                   11766:                                 $multiresp = 1;
                   11767:                             }
                   11768:                         }
                   11769:                     }
                   11770:                 }
                   11771:             } else {
                   11772:                 return;
                   11773:             }
                   11774:         } else {
                   11775:             return;
                   11776:         }
                   11777:         my $restitle=&Apache::lonnet::gettitle($symb);
                   11778:         $restitle =~ s/\W+/_/g;
                   11779:         if ($restitle eq '') {
                   11780:             $restitle = ($resurl =~ m{/[^/]+$});
                   11781:             if ($restitle eq '') {
                   11782:                 $restitle = time;
                   11783:             }
                   11784:         }
                   11785:         push(@pathitems,$restitle);
                   11786:         $path .= join('/',@pathitems);
                   11787:     }
                   11788:     return ($path,$multiresp);
                   11789: }
                   11790: 
                   11791: =pod
                   11792: 
1.464     albertel 11793: =back
1.41      ng       11794: 
1.112     bowersj2 11795: =head1 CSV Upload/Handling functions
1.38      albertel 11796: 
1.41      ng       11797: =over 4
                   11798: 
1.648     raeburn  11799: =item * &upfile_store($r)
1.41      ng       11800: 
                   11801: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 11802: needs $env{'form.upfile'}
1.41      ng       11803: returns $datatoken to be put into hidden field
                   11804: 
                   11805: =cut
1.31      albertel 11806: 
                   11807: sub upfile_store {
                   11808:     my $r=shift;
1.258     albertel 11809:     $env{'form.upfile'}=~s/\r/\n/gs;
                   11810:     $env{'form.upfile'}=~s/\f/\n/gs;
                   11811:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   11812:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 11813: 
1.258     albertel 11814:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   11815: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 11816:     {
1.158     raeburn  11817:         my $datafile = $r->dir_config('lonDaemons').
                   11818:                            '/tmp/'.$datatoken.'.tmp';
                   11819:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 11820:             print $fh $env{'form.upfile'};
1.158     raeburn  11821:             close($fh);
                   11822:         }
1.31      albertel 11823:     }
                   11824:     return $datatoken;
                   11825: }
                   11826: 
1.56      matthew  11827: =pod
                   11828: 
1.648     raeburn  11829: =item * &load_tmp_file($r)
1.41      ng       11830: 
                   11831: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 11832: needs $env{'form.datatoken'},
                   11833: sets $env{'form.upfile'} to the contents of the file
1.41      ng       11834: 
                   11835: =cut
1.31      albertel 11836: 
                   11837: sub load_tmp_file {
                   11838:     my $r=shift;
                   11839:     my @studentdata=();
                   11840:     {
1.158     raeburn  11841:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 11842:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  11843:         if ( open(my $fh,"<$studentfile") ) {
                   11844:             @studentdata=<$fh>;
                   11845:             close($fh);
                   11846:         }
1.31      albertel 11847:     }
1.258     albertel 11848:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 11849: }
                   11850: 
1.56      matthew  11851: =pod
                   11852: 
1.648     raeburn  11853: =item * &upfile_record_sep()
1.41      ng       11854: 
                   11855: Separate uploaded file into records
                   11856: returns array of records,
1.258     albertel 11857: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       11858: 
                   11859: =cut
1.31      albertel 11860: 
                   11861: sub upfile_record_sep {
1.258     albertel 11862:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 11863:     } else {
1.248     albertel 11864: 	my @records;
1.258     albertel 11865: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 11866: 	    if ($line=~/^\s*$/) { next; }
                   11867: 	    push(@records,$line);
                   11868: 	}
                   11869: 	return @records;
1.31      albertel 11870:     }
                   11871: }
                   11872: 
1.56      matthew  11873: =pod
                   11874: 
1.648     raeburn  11875: =item * &record_sep($record)
1.41      ng       11876: 
1.258     albertel 11877: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       11878: 
                   11879: =cut
                   11880: 
1.263     www      11881: sub takeleft {
                   11882:     my $index=shift;
                   11883:     return substr('0000'.$index,-4,4);
                   11884: }
                   11885: 
1.31      albertel 11886: sub record_sep {
                   11887:     my $record=shift;
                   11888:     my %components=();
1.258     albertel 11889:     if ($env{'form.upfiletype'} eq 'xml') {
                   11890:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 11891:         my $i=0;
1.356     albertel 11892:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 11893:             $field=~s/^(\"|\')//;
                   11894:             $field=~s/(\"|\')$//;
1.263     www      11895:             $components{&takeleft($i)}=$field;
1.31      albertel 11896:             $i++;
                   11897:         }
1.258     albertel 11898:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 11899:         my $i=0;
1.356     albertel 11900:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 11901:             $field=~s/^(\"|\')//;
                   11902:             $field=~s/(\"|\')$//;
1.263     www      11903:             $components{&takeleft($i)}=$field;
1.31      albertel 11904:             $i++;
                   11905:         }
                   11906:     } else {
1.561     www      11907:         my $separator=',';
1.480     banghart 11908:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      11909:             $separator=';';
1.480     banghart 11910:         }
1.31      albertel 11911:         my $i=0;
1.561     www      11912: # the character we are looking for to indicate the end of a quote or a record 
                   11913:         my $looking_for=$separator;
                   11914: # do not add the characters to the fields
                   11915:         my $ignore=0;
                   11916: # we just encountered a separator (or the beginning of the record)
                   11917:         my $just_found_separator=1;
                   11918: # store the field we are working on here
                   11919:         my $field='';
                   11920: # work our way through all characters in record
                   11921:         foreach my $character ($record=~/(.)/g) {
                   11922:             if ($character eq $looking_for) {
                   11923:                if ($character ne $separator) {
                   11924: # Found the end of a quote, again looking for separator
                   11925:                   $looking_for=$separator;
                   11926:                   $ignore=1;
                   11927:                } else {
                   11928: # Found a separator, store away what we got
                   11929:                   $components{&takeleft($i)}=$field;
                   11930: 	          $i++;
                   11931:                   $just_found_separator=1;
                   11932:                   $ignore=0;
                   11933:                   $field='';
                   11934:                }
                   11935:                next;
                   11936:             }
                   11937: # single or double quotation marks after a separator indicate beginning of a quote
                   11938: # we are now looking for the end of the quote and need to ignore separators
                   11939:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   11940:                $looking_for=$character;
                   11941:                next;
                   11942:             }
                   11943: # ignore would be true after we reached the end of a quote
                   11944:             if ($ignore) { next; }
                   11945:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   11946:             $field.=$character;
                   11947:             $just_found_separator=0; 
1.31      albertel 11948:         }
1.561     www      11949: # catch the very last entry, since we never encountered the separator
                   11950:         $components{&takeleft($i)}=$field;
1.31      albertel 11951:     }
                   11952:     return %components;
                   11953: }
                   11954: 
1.144     matthew  11955: ######################################################
                   11956: ######################################################
                   11957: 
1.56      matthew  11958: =pod
                   11959: 
1.648     raeburn  11960: =item * &upfile_select_html()
1.41      ng       11961: 
1.144     matthew  11962: Return HTML code to select a file from the users machine and specify 
                   11963: the file type.
1.41      ng       11964: 
                   11965: =cut
                   11966: 
1.144     matthew  11967: ######################################################
                   11968: ######################################################
1.31      albertel 11969: sub upfile_select_html {
1.144     matthew  11970:     my %Types = (
                   11971:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 11972:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  11973:                  space => &mt('Space separated'),
                   11974:                  tab   => &mt('Tabulator separated'),
                   11975: #                 xml   => &mt('HTML/XML'),
                   11976:                  );
                   11977:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  11978:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  11979:     foreach my $type (sort(keys(%Types))) {
                   11980:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   11981:     }
                   11982:     $Str .= "</select>\n";
                   11983:     return $Str;
1.31      albertel 11984: }
                   11985: 
1.301     albertel 11986: sub get_samples {
                   11987:     my ($records,$toget) = @_;
                   11988:     my @samples=({});
                   11989:     my $got=0;
                   11990:     foreach my $rec (@$records) {
                   11991: 	my %temp = &record_sep($rec);
                   11992: 	if (! grep(/\S/, values(%temp))) { next; }
                   11993: 	if (%temp) {
                   11994: 	    $samples[$got]=\%temp;
                   11995: 	    $got++;
                   11996: 	    if ($got == $toget) { last; }
                   11997: 	}
                   11998:     }
                   11999:     return \@samples;
                   12000: }
                   12001: 
1.144     matthew  12002: ######################################################
                   12003: ######################################################
                   12004: 
1.56      matthew  12005: =pod
                   12006: 
1.648     raeburn  12007: =item * &csv_print_samples($r,$records)
1.41      ng       12008: 
                   12009: Prints a table of sample values from each column uploaded $r is an
                   12010: Apache Request ref, $records is an arrayref from
                   12011: &Apache::loncommon::upfile_record_sep
                   12012: 
                   12013: =cut
                   12014: 
1.144     matthew  12015: ######################################################
                   12016: ######################################################
1.31      albertel 12017: sub csv_print_samples {
                   12018:     my ($r,$records) = @_;
1.662     bisitz   12019:     my $samples = &get_samples($records,5);
1.301     albertel 12020: 
1.594     raeburn  12021:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   12022:               &start_data_table_header_row());
1.356     albertel 12023:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   12024:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  12025:     $r->print(&end_data_table_header_row());
1.301     albertel 12026:     foreach my $hash (@$samples) {
1.594     raeburn  12027: 	$r->print(&start_data_table_row());
1.356     albertel 12028: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 12029: 	    $r->print('<td>');
1.356     albertel 12030: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 12031: 	    $r->print('</td>');
                   12032: 	}
1.594     raeburn  12033: 	$r->print(&end_data_table_row());
1.31      albertel 12034:     }
1.594     raeburn  12035:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 12036: }
                   12037: 
1.144     matthew  12038: ######################################################
                   12039: ######################################################
                   12040: 
1.56      matthew  12041: =pod
                   12042: 
1.648     raeburn  12043: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       12044: 
                   12045: Prints a table to create associations between values and table columns.
1.144     matthew  12046: 
1.41      ng       12047: $r is an Apache Request ref,
                   12048: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  12049: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       12050: 
                   12051: =cut
                   12052: 
1.144     matthew  12053: ######################################################
                   12054: ######################################################
1.31      albertel 12055: sub csv_print_select_table {
                   12056:     my ($r,$records,$d) = @_;
1.301     albertel 12057:     my $i=0;
                   12058:     my $samples = &get_samples($records,1);
1.144     matthew  12059:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  12060: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  12061:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  12062:               '<th>'.&mt('Column').'</th>'.
                   12063:               &end_data_table_header_row()."\n");
1.356     albertel 12064:     foreach my $array_ref (@$d) {
                   12065: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  12066: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 12067: 
1.875     bisitz   12068: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  12069: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 12070: 	$r->print('<option value="none"></option>');
1.356     albertel 12071: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   12072: 	    $r->print('<option value="'.$sample.'"'.
                   12073:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   12074:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 12075: 	}
1.594     raeburn  12076: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 12077: 	$i++;
                   12078:     }
1.594     raeburn  12079:     $r->print(&end_data_table());
1.31      albertel 12080:     $i--;
                   12081:     return $i;
                   12082: }
1.56      matthew  12083: 
1.144     matthew  12084: ######################################################
                   12085: ######################################################
                   12086: 
1.56      matthew  12087: =pod
1.31      albertel 12088: 
1.648     raeburn  12089: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       12090: 
                   12091: Prints a table of sample values from the upload and can make associate samples to internal names.
                   12092: 
                   12093: $r is an Apache Request ref,
                   12094: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   12095: $d is an array of 2 element arrays (internal name, displayed name)
                   12096: 
                   12097: =cut
                   12098: 
1.144     matthew  12099: ######################################################
                   12100: ######################################################
1.31      albertel 12101: sub csv_samples_select_table {
                   12102:     my ($r,$records,$d) = @_;
                   12103:     my $i=0;
1.144     matthew  12104:     #
1.662     bisitz   12105:     my $max_samples = 5;
                   12106:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  12107:     $r->print(&start_data_table().
                   12108:               &start_data_table_header_row().'<th>'.
                   12109:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   12110:               &end_data_table_header_row());
1.301     albertel 12111: 
                   12112:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  12113: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  12114: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 12115: 	foreach my $option (@$d) {
                   12116: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  12117: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 12118:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  12119:                       $display.'</option>');
1.31      albertel 12120: 	}
                   12121: 	$r->print('</select></td><td>');
1.662     bisitz   12122: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 12123: 	    if (defined($samples->[$line]{$key})) { 
                   12124: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   12125: 	    }
                   12126: 	}
1.594     raeburn  12127: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 12128: 	$i++;
                   12129:     }
1.594     raeburn  12130:     $r->print(&end_data_table());
1.31      albertel 12131:     $i--;
                   12132:     return($i);
1.115     matthew  12133: }
                   12134: 
1.144     matthew  12135: ######################################################
                   12136: ######################################################
                   12137: 
1.115     matthew  12138: =pod
                   12139: 
1.648     raeburn  12140: =item * &clean_excel_name($name)
1.115     matthew  12141: 
                   12142: Returns a replacement for $name which does not contain any illegal characters.
                   12143: 
                   12144: =cut
                   12145: 
1.144     matthew  12146: ######################################################
                   12147: ######################################################
1.115     matthew  12148: sub clean_excel_name {
                   12149:     my ($name) = @_;
                   12150:     $name =~ s/[:\*\?\/\\]//g;
                   12151:     if (length($name) > 31) {
                   12152:         $name = substr($name,0,31);
                   12153:     }
                   12154:     return $name;
1.25      albertel 12155: }
1.84      albertel 12156: 
1.85      albertel 12157: =pod
                   12158: 
1.648     raeburn  12159: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 12160: 
                   12161: Returns either 1 or undef
                   12162: 
                   12163: 1 if the part is to be hidden, undef if it is to be shown
                   12164: 
                   12165: Arguments are:
                   12166: 
                   12167: $id the id of the part to be checked
                   12168: $symb, optional the symb of the resource to check
                   12169: $udom, optional the domain of the user to check for
                   12170: $uname, optional the username of the user to check for
                   12171: 
                   12172: =cut
1.84      albertel 12173: 
                   12174: sub check_if_partid_hidden {
                   12175:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 12176:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 12177: 					 $symb,$udom,$uname);
1.141     albertel 12178:     my $truth=1;
                   12179:     #if the string starts with !, then the list is the list to show not hide
                   12180:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 12181:     my @hiddenlist=split(/,/,$hiddenparts);
                   12182:     foreach my $checkid (@hiddenlist) {
1.141     albertel 12183: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 12184:     }
1.141     albertel 12185:     return !$truth;
1.84      albertel 12186: }
1.127     matthew  12187: 
1.138     matthew  12188: 
                   12189: ############################################################
                   12190: ############################################################
                   12191: 
                   12192: =pod
                   12193: 
1.157     matthew  12194: =back 
                   12195: 
1.138     matthew  12196: =head1 cgi-bin script and graphing routines
                   12197: 
1.157     matthew  12198: =over 4
                   12199: 
1.648     raeburn  12200: =item * &get_cgi_id()
1.138     matthew  12201: 
                   12202: Inputs: none
                   12203: 
                   12204: Returns an id which can be used to pass environment variables
                   12205: to various cgi-bin scripts.  These environment variables will
                   12206: be removed from the users environment after a given time by
                   12207: the routine &Apache::lonnet::transfer_profile_to_env.
                   12208: 
                   12209: =cut
                   12210: 
                   12211: ############################################################
                   12212: ############################################################
1.152     albertel 12213: my $uniq=0;
1.136     matthew  12214: sub get_cgi_id {
1.154     albertel 12215:     $uniq=($uniq+1)%100000;
1.280     albertel 12216:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  12217: }
                   12218: 
1.127     matthew  12219: ############################################################
                   12220: ############################################################
                   12221: 
                   12222: =pod
                   12223: 
1.648     raeburn  12224: =item * &DrawBarGraph()
1.127     matthew  12225: 
1.138     matthew  12226: Facilitates the plotting of data in a (stacked) bar graph.
                   12227: Puts plot definition data into the users environment in order for 
                   12228: graph.png to plot it.  Returns an <img> tag for the plot.
                   12229: The bars on the plot are labeled '1','2',...,'n'.
                   12230: 
                   12231: Inputs:
                   12232: 
                   12233: =over 4
                   12234: 
                   12235: =item $Title: string, the title of the plot
                   12236: 
                   12237: =item $xlabel: string, text describing the X-axis of the plot
                   12238: 
                   12239: =item $ylabel: string, text describing the Y-axis of the plot
                   12240: 
                   12241: =item $Max: scalar, the maximum Y value to use in the plot
                   12242: If $Max is < any data point, the graph will not be rendered.
                   12243: 
1.140     matthew  12244: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  12245: they are plotted.  If undefined, default values will be used.
                   12246: 
1.178     matthew  12247: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   12248: 
1.138     matthew  12249: =item @Values: An array of array references.  Each array reference holds data
                   12250: to be plotted in a stacked bar chart.
                   12251: 
1.239     matthew  12252: =item If the final element of @Values is a hash reference the key/value
                   12253: pairs will be added to the graph definition.
                   12254: 
1.138     matthew  12255: =back
                   12256: 
                   12257: Returns:
                   12258: 
                   12259: An <img> tag which references graph.png and the appropriate identifying
                   12260: information for the plot.
                   12261: 
1.127     matthew  12262: =cut
                   12263: 
                   12264: ############################################################
                   12265: ############################################################
1.134     matthew  12266: sub DrawBarGraph {
1.178     matthew  12267:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  12268:     #
                   12269:     if (! defined($colors)) {
                   12270:         $colors = ['#33ff00', 
                   12271:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   12272:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   12273:                   ]; 
                   12274:     }
1.228     matthew  12275:     my $extra_settings = {};
                   12276:     if (ref($Values[-1]) eq 'HASH') {
                   12277:         $extra_settings = pop(@Values);
                   12278:     }
1.127     matthew  12279:     #
1.136     matthew  12280:     my $identifier = &get_cgi_id();
                   12281:     my $id = 'cgi.'.$identifier;        
1.129     matthew  12282:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  12283:         return '';
                   12284:     }
1.225     matthew  12285:     #
                   12286:     my @Labels;
                   12287:     if (defined($labels)) {
                   12288:         @Labels = @$labels;
                   12289:     } else {
                   12290:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   12291:             push (@Labels,$i+1);
                   12292:         }
                   12293:     }
                   12294:     #
1.129     matthew  12295:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  12296:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  12297:     my %ValuesHash;
                   12298:     my $NumSets=1;
                   12299:     foreach my $array (@Values) {
                   12300:         next if (! ref($array));
1.136     matthew  12301:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  12302:             join(',',@$array);
1.129     matthew  12303:     }
1.127     matthew  12304:     #
1.136     matthew  12305:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  12306:     if ($NumBars < 3) {
                   12307:         $width = 120+$NumBars*32;
1.220     matthew  12308:         $xskip = 1;
1.225     matthew  12309:         $bar_width = 30;
                   12310:     } elsif ($NumBars < 5) {
                   12311:         $width = 120+$NumBars*20;
                   12312:         $xskip = 1;
                   12313:         $bar_width = 20;
1.220     matthew  12314:     } elsif ($NumBars < 10) {
1.136     matthew  12315:         $width = 120+$NumBars*15;
                   12316:         $xskip = 1;
                   12317:         $bar_width = 15;
                   12318:     } elsif ($NumBars <= 25) {
                   12319:         $width = 120+$NumBars*11;
                   12320:         $xskip = 5;
                   12321:         $bar_width = 8;
                   12322:     } elsif ($NumBars <= 50) {
                   12323:         $width = 120+$NumBars*8;
                   12324:         $xskip = 5;
                   12325:         $bar_width = 4;
                   12326:     } else {
                   12327:         $width = 120+$NumBars*8;
                   12328:         $xskip = 5;
                   12329:         $bar_width = 4;
                   12330:     }
                   12331:     #
1.137     matthew  12332:     $Max = 1 if ($Max < 1);
                   12333:     if ( int($Max) < $Max ) {
                   12334:         $Max++;
                   12335:         $Max = int($Max);
                   12336:     }
1.127     matthew  12337:     $Title  = '' if (! defined($Title));
                   12338:     $xlabel = '' if (! defined($xlabel));
                   12339:     $ylabel = '' if (! defined($ylabel));
1.369     www      12340:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   12341:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   12342:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  12343:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  12344:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   12345:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   12346:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   12347:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12348:     $ValuesHash{$id.'.height'}   = $height;
                   12349:     $ValuesHash{$id.'.width'}    = $width;
                   12350:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   12351:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   12352:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  12353:     #
1.228     matthew  12354:     # Deal with other parameters
                   12355:     while (my ($key,$value) = each(%$extra_settings)) {
                   12356:         $ValuesHash{$id.'.'.$key} = $value;
                   12357:     }
                   12358:     #
1.646     raeburn  12359:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  12360:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12361: }
                   12362: 
                   12363: ############################################################
                   12364: ############################################################
                   12365: 
                   12366: =pod
                   12367: 
1.648     raeburn  12368: =item * &DrawXYGraph()
1.137     matthew  12369: 
1.138     matthew  12370: Facilitates the plotting of data in an XY graph.
                   12371: Puts plot definition data into the users environment in order for 
                   12372: graph.png to plot it.  Returns an <img> tag for the plot.
                   12373: 
                   12374: Inputs:
                   12375: 
                   12376: =over 4
                   12377: 
                   12378: =item $Title: string, the title of the plot
                   12379: 
                   12380: =item $xlabel: string, text describing the X-axis of the plot
                   12381: 
                   12382: =item $ylabel: string, text describing the Y-axis of the plot
                   12383: 
                   12384: =item $Max: scalar, the maximum Y value to use in the plot
                   12385: If $Max is < any data point, the graph will not be rendered.
                   12386: 
                   12387: =item $colors: Array ref containing the hex color codes for the data to be 
                   12388: plotted in.  If undefined, default values will be used.
                   12389: 
                   12390: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12391: 
                   12392: =item $Ydata: Array ref containing Array refs.  
1.185     www      12393: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  12394: 
                   12395: =item %Values: hash indicating or overriding any default values which are 
                   12396: passed to graph.png.  
                   12397: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12398: 
                   12399: =back
                   12400: 
                   12401: Returns:
                   12402: 
                   12403: An <img> tag which references graph.png and the appropriate identifying
                   12404: information for the plot.
                   12405: 
1.137     matthew  12406: =cut
                   12407: 
                   12408: ############################################################
                   12409: ############################################################
                   12410: sub DrawXYGraph {
                   12411:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   12412:     #
                   12413:     # Create the identifier for the graph
                   12414:     my $identifier = &get_cgi_id();
                   12415:     my $id = 'cgi.'.$identifier;
                   12416:     #
                   12417:     $Title  = '' if (! defined($Title));
                   12418:     $xlabel = '' if (! defined($xlabel));
                   12419:     $ylabel = '' if (! defined($ylabel));
                   12420:     my %ValuesHash = 
                   12421:         (
1.369     www      12422:          $id.'.title'  => &escape($Title),
                   12423:          $id.'.xlabel' => &escape($xlabel),
                   12424:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  12425:          $id.'.y_max_value'=> $Max,
                   12426:          $id.'.labels'     => join(',',@$Xlabels),
                   12427:          $id.'.PlotType'   => 'XY',
                   12428:          );
                   12429:     #
                   12430:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12431:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12432:     }
                   12433:     #
                   12434:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   12435:         return '';
                   12436:     }
                   12437:     my $NumSets=1;
1.138     matthew  12438:     foreach my $array (@{$Ydata}){
1.137     matthew  12439:         next if (! ref($array));
                   12440:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   12441:     }
1.138     matthew  12442:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  12443:     #
                   12444:     # Deal with other parameters
                   12445:     while (my ($key,$value) = each(%Values)) {
                   12446:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  12447:     }
                   12448:     #
1.646     raeburn  12449:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  12450:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12451: }
                   12452: 
                   12453: ############################################################
                   12454: ############################################################
                   12455: 
                   12456: =pod
                   12457: 
1.648     raeburn  12458: =item * &DrawXYYGraph()
1.138     matthew  12459: 
                   12460: Facilitates the plotting of data in an XY graph with two Y axes.
                   12461: Puts plot definition data into the users environment in order for 
                   12462: graph.png to plot it.  Returns an <img> tag for the plot.
                   12463: 
                   12464: Inputs:
                   12465: 
                   12466: =over 4
                   12467: 
                   12468: =item $Title: string, the title of the plot
                   12469: 
                   12470: =item $xlabel: string, text describing the X-axis of the plot
                   12471: 
                   12472: =item $ylabel: string, text describing the Y-axis of the plot
                   12473: 
                   12474: =item $colors: Array ref containing the hex color codes for the data to be 
                   12475: plotted in.  If undefined, default values will be used.
                   12476: 
                   12477: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12478: 
                   12479: =item $Ydata1: The first data set
                   12480: 
                   12481: =item $Min1: The minimum value of the left Y-axis
                   12482: 
                   12483: =item $Max1: The maximum value of the left Y-axis
                   12484: 
                   12485: =item $Ydata2: The second data set
                   12486: 
                   12487: =item $Min2: The minimum value of the right Y-axis
                   12488: 
                   12489: =item $Max2: The maximum value of the left Y-axis
                   12490: 
                   12491: =item %Values: hash indicating or overriding any default values which are 
                   12492: passed to graph.png.  
                   12493: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12494: 
                   12495: =back
                   12496: 
                   12497: Returns:
                   12498: 
                   12499: An <img> tag which references graph.png and the appropriate identifying
                   12500: information for the plot.
1.136     matthew  12501: 
                   12502: =cut
                   12503: 
                   12504: ############################################################
                   12505: ############################################################
1.137     matthew  12506: sub DrawXYYGraph {
                   12507:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   12508:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  12509:     #
                   12510:     # Create the identifier for the graph
                   12511:     my $identifier = &get_cgi_id();
                   12512:     my $id = 'cgi.'.$identifier;
                   12513:     #
                   12514:     $Title  = '' if (! defined($Title));
                   12515:     $xlabel = '' if (! defined($xlabel));
                   12516:     $ylabel = '' if (! defined($ylabel));
                   12517:     my %ValuesHash = 
                   12518:         (
1.369     www      12519:          $id.'.title'  => &escape($Title),
                   12520:          $id.'.xlabel' => &escape($xlabel),
                   12521:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  12522:          $id.'.labels' => join(',',@$Xlabels),
                   12523:          $id.'.PlotType' => 'XY',
                   12524:          $id.'.NumSets' => 2,
1.137     matthew  12525:          $id.'.two_axes' => 1,
                   12526:          $id.'.y1_max_value' => $Max1,
                   12527:          $id.'.y1_min_value' => $Min1,
                   12528:          $id.'.y2_max_value' => $Max2,
                   12529:          $id.'.y2_min_value' => $Min2,
1.136     matthew  12530:          );
                   12531:     #
1.137     matthew  12532:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12533:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12534:     }
                   12535:     #
                   12536:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   12537:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  12538:         return '';
                   12539:     }
                   12540:     my $NumSets=1;
1.137     matthew  12541:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  12542:         next if (! ref($array));
                   12543:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  12544:     }
                   12545:     #
                   12546:     # Deal with other parameters
                   12547:     while (my ($key,$value) = each(%Values)) {
                   12548:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  12549:     }
                   12550:     #
1.646     raeburn  12551:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 12552:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  12553: }
                   12554: 
                   12555: ############################################################
                   12556: ############################################################
                   12557: 
                   12558: =pod
                   12559: 
1.157     matthew  12560: =back 
                   12561: 
1.139     matthew  12562: =head1 Statistics helper routines?  
                   12563: 
                   12564: Bad place for them but what the hell.
                   12565: 
1.157     matthew  12566: =over 4
                   12567: 
1.648     raeburn  12568: =item * &chartlink()
1.139     matthew  12569: 
                   12570: Returns a link to the chart for a specific student.  
                   12571: 
                   12572: Inputs:
                   12573: 
                   12574: =over 4
                   12575: 
                   12576: =item $linktext: The text of the link
                   12577: 
                   12578: =item $sname: The students username
                   12579: 
                   12580: =item $sdomain: The students domain
                   12581: 
                   12582: =back
                   12583: 
1.157     matthew  12584: =back
                   12585: 
1.139     matthew  12586: =cut
                   12587: 
                   12588: ############################################################
                   12589: ############################################################
                   12590: sub chartlink {
                   12591:     my ($linktext, $sname, $sdomain) = @_;
                   12592:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      12593:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 12594:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  12595:        '">'.$linktext.'</a>';
1.153     matthew  12596: }
                   12597: 
                   12598: #######################################################
                   12599: #######################################################
                   12600: 
                   12601: =pod
                   12602: 
                   12603: =head1 Course Environment Routines
1.157     matthew  12604: 
                   12605: =over 4
1.153     matthew  12606: 
1.648     raeburn  12607: =item * &restore_course_settings()
1.153     matthew  12608: 
1.648     raeburn  12609: =item * &store_course_settings()
1.153     matthew  12610: 
                   12611: Restores/Store indicated form parameters from the course environment.
                   12612: Will not overwrite existing values of the form parameters.
                   12613: 
                   12614: Inputs: 
                   12615: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   12616: 
                   12617: a hash ref describing the data to be stored.  For example:
                   12618:    
                   12619: %Save_Parameters = ('Status' => 'scalar',
                   12620:     'chartoutputmode' => 'scalar',
                   12621:     'chartoutputdata' => 'scalar',
                   12622:     'Section' => 'array',
1.373     raeburn  12623:     'Group' => 'array',
1.153     matthew  12624:     'StudentData' => 'array',
                   12625:     'Maps' => 'array');
                   12626: 
                   12627: Returns: both routines return nothing
                   12628: 
1.631     raeburn  12629: =back
                   12630: 
1.153     matthew  12631: =cut
                   12632: 
                   12633: #######################################################
                   12634: #######################################################
                   12635: sub store_course_settings {
1.496     albertel 12636:     return &store_settings($env{'request.course.id'},@_);
                   12637: }
                   12638: 
                   12639: sub store_settings {
1.153     matthew  12640:     # save to the environment
                   12641:     # appenv the same items, just to be safe
1.300     albertel 12642:     my $udom  = $env{'user.domain'};
                   12643:     my $uname = $env{'user.name'};
1.496     albertel 12644:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  12645:     my %SaveHash;
                   12646:     my %AppHash;
                   12647:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 12648:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 12649:         my $envname = 'environment.'.$basename;
1.258     albertel 12650:         if (exists($env{'form.'.$setting})) {
1.153     matthew  12651:             # Save this value away
                   12652:             if ($type eq 'scalar' &&
1.258     albertel 12653:                 (! exists($env{$envname}) || 
                   12654:                  $env{$envname} ne $env{'form.'.$setting})) {
                   12655:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   12656:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  12657:             } elsif ($type eq 'array') {
                   12658:                 my $stored_form;
1.258     albertel 12659:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  12660:                     $stored_form = join(',',
                   12661:                                         map {
1.369     www      12662:                                             &escape($_);
1.258     albertel 12663:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  12664:                 } else {
                   12665:                     $stored_form = 
1.369     www      12666:                         &escape($env{'form.'.$setting});
1.153     matthew  12667:                 }
                   12668:                 # Determine if the array contents are the same.
1.258     albertel 12669:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  12670:                     $SaveHash{$basename} = $stored_form;
                   12671:                     $AppHash{$envname}   = $stored_form;
                   12672:                 }
                   12673:             }
                   12674:         }
                   12675:     }
                   12676:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 12677:                                           $udom,$uname);
1.153     matthew  12678:     if ($put_result !~ /^(ok|delayed)/) {
                   12679:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   12680:                                  'got error:'.$put_result);
                   12681:     }
                   12682:     # Make sure these settings stick around in this session, too
1.646     raeburn  12683:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  12684:     return;
                   12685: }
                   12686: 
                   12687: sub restore_course_settings {
1.499     albertel 12688:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 12689: }
                   12690: 
                   12691: sub restore_settings {
                   12692:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  12693:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 12694:         next if (exists($env{'form.'.$setting}));
1.496     albertel 12695:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  12696:             '.'.$setting;
1.258     albertel 12697:         if (exists($env{$envname})) {
1.153     matthew  12698:             if ($type eq 'scalar') {
1.258     albertel 12699:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  12700:             } elsif ($type eq 'array') {
1.258     albertel 12701:                 $env{'form.'.$setting} = [ 
1.153     matthew  12702:                                            map { 
1.369     www      12703:                                                &unescape($_); 
1.258     albertel 12704:                                            } split(',',$env{$envname})
1.153     matthew  12705:                                            ];
                   12706:             }
                   12707:         }
                   12708:     }
1.127     matthew  12709: }
                   12710: 
1.618     raeburn  12711: #######################################################
                   12712: #######################################################
                   12713: 
                   12714: =pod
                   12715: 
                   12716: =head1 Domain E-mail Routines  
                   12717: 
                   12718: =over 4
                   12719: 
1.648     raeburn  12720: =item * &build_recipient_list()
1.618     raeburn  12721: 
1.884     raeburn  12722: Build recipient lists for five types of e-mail:
1.766     raeburn  12723: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884     raeburn  12724: (d) Help requests, (e) Course requests needing approval,  generated by
                   12725: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
                   12726: loncoursequeueadmin.pm respectively.
1.618     raeburn  12727: 
                   12728: Inputs:
1.619     raeburn  12729: defmail (scalar - email address of default recipient), 
1.618     raeburn  12730: mailing type (scalar - errormail, packagesmail, or helpdeskmail), 
1.619     raeburn  12731: defdom (domain for which to retrieve configuration settings),
                   12732: origmail (scalar - email address of recipient from loncapa.conf, 
                   12733: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  12734: 
1.655     raeburn  12735: Returns: comma separated list of addresses to which to send e-mail.
                   12736: 
                   12737: =back
1.618     raeburn  12738: 
                   12739: =cut
                   12740: 
                   12741: ############################################################
                   12742: ############################################################
                   12743: sub build_recipient_list {
1.619     raeburn  12744:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  12745:     my @recipients;
                   12746:     my $otheremails;
                   12747:     my %domconfig =
                   12748:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   12749:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  12750:         if (exists($domconfig{'contacts'}{$mailing})) {
                   12751:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   12752:                 my @contacts = ('adminemail','supportemail');
                   12753:                 foreach my $item (@contacts) {
                   12754:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   12755:                         my $addr = $domconfig{'contacts'}{$item}; 
                   12756:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   12757:                             push(@recipients,$addr);
                   12758:                         }
1.619     raeburn  12759:                     }
1.766     raeburn  12760:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  12761:                 }
                   12762:             }
1.766     raeburn  12763:         } elsif ($origmail ne '') {
                   12764:             push(@recipients,$origmail);
1.618     raeburn  12765:         }
1.619     raeburn  12766:     } elsif ($origmail ne '') {
                   12767:         push(@recipients,$origmail);
1.618     raeburn  12768:     }
1.688     raeburn  12769:     if (defined($defmail)) {
                   12770:         if ($defmail ne '') {
                   12771:             push(@recipients,$defmail);
                   12772:         }
1.618     raeburn  12773:     }
                   12774:     if ($otheremails) {
1.619     raeburn  12775:         my @others;
                   12776:         if ($otheremails =~ /,/) {
                   12777:             @others = split(/,/,$otheremails);
1.618     raeburn  12778:         } else {
1.619     raeburn  12779:             push(@others,$otheremails);
                   12780:         }
                   12781:         foreach my $addr (@others) {
                   12782:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   12783:                 push(@recipients,$addr);
                   12784:             }
1.618     raeburn  12785:         }
                   12786:     }
1.619     raeburn  12787:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  12788:     return $recipientlist;
                   12789: }
                   12790: 
1.127     matthew  12791: ############################################################
                   12792: ############################################################
1.154     albertel 12793: 
1.655     raeburn  12794: =pod
                   12795: 
                   12796: =head1 Course Catalog Routines
                   12797: 
                   12798: =over 4
                   12799: 
                   12800: =item * &gather_categories()
                   12801: 
                   12802: Converts category definitions - keys of categories hash stored in  
                   12803: coursecategories in configuration.db on the primary library server in a 
                   12804: domain - to an array.  Also generates javascript and idx hash used to 
                   12805: generate Domain Coordinator interface for editing Course Categories.
                   12806: 
                   12807: Inputs:
1.663     raeburn  12808: 
1.655     raeburn  12809: categories (reference to hash of category definitions).
1.663     raeburn  12810: 
1.655     raeburn  12811: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12812:       categories and subcategories).
1.663     raeburn  12813: 
1.655     raeburn  12814: idx (reference to hash of counters used in Domain Coordinator interface for 
                   12815:       editing Course Categories).
1.663     raeburn  12816: 
1.655     raeburn  12817: jsarray (reference to array of categories used to create Javascript arrays for
                   12818:          Domain Coordinator interface for editing Course Categories).
                   12819: 
                   12820: Returns: nothing
                   12821: 
                   12822: Side effects: populates cats, idx and jsarray. 
                   12823: 
                   12824: =cut
                   12825: 
                   12826: sub gather_categories {
                   12827:     my ($categories,$cats,$idx,$jsarray) = @_;
                   12828:     my %counters;
                   12829:     my $num = 0;
                   12830:     foreach my $item (keys(%{$categories})) {
                   12831:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   12832:         if ($container eq '' && $depth == 0) {
                   12833:             $cats->[$depth][$categories->{$item}] = $cat;
                   12834:         } else {
                   12835:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   12836:         }
                   12837:         my ($escitem,$tail) = split(/:/,$item,2);
                   12838:         if ($counters{$tail} eq '') {
                   12839:             $counters{$tail} = $num;
                   12840:             $num ++;
                   12841:         }
                   12842:         if (ref($idx) eq 'HASH') {
                   12843:             $idx->{$item} = $counters{$tail};
                   12844:         }
                   12845:         if (ref($jsarray) eq 'ARRAY') {
                   12846:             push(@{$jsarray->[$counters{$tail}]},$item);
                   12847:         }
                   12848:     }
                   12849:     return;
                   12850: }
                   12851: 
                   12852: =pod
                   12853: 
                   12854: =item * &extract_categories()
                   12855: 
                   12856: Used to generate breadcrumb trails for course categories.
                   12857: 
                   12858: Inputs:
1.663     raeburn  12859: 
1.655     raeburn  12860: categories (reference to hash of category definitions).
1.663     raeburn  12861: 
1.655     raeburn  12862: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12863:       categories and subcategories).
1.663     raeburn  12864: 
1.655     raeburn  12865: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  12866: 
1.655     raeburn  12867: allitems (reference to hash - key is category key 
                   12868:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  12869: 
1.655     raeburn  12870: idx (reference to hash of counters used in Domain Coordinator interface for
                   12871:       editing Course Categories).
1.663     raeburn  12872: 
1.655     raeburn  12873: jsarray (reference to array of categories used to create Javascript arrays for
                   12874:          Domain Coordinator interface for editing Course Categories).
                   12875: 
1.665     raeburn  12876: subcats (reference to hash of arrays containing all subcategories within each 
                   12877:          category, -recursive)
                   12878: 
1.655     raeburn  12879: Returns: nothing
                   12880: 
                   12881: Side effects: populates trails and allitems hash references.
                   12882: 
                   12883: =cut
                   12884: 
                   12885: sub extract_categories {
1.665     raeburn  12886:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  12887:     if (ref($categories) eq 'HASH') {
                   12888:         &gather_categories($categories,$cats,$idx,$jsarray);
                   12889:         if (ref($cats->[0]) eq 'ARRAY') {
                   12890:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   12891:                 my $name = $cats->[0][$i];
                   12892:                 my $item = &escape($name).'::0';
                   12893:                 my $trailstr;
                   12894:                 if ($name eq 'instcode') {
                   12895:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  12896:                 } elsif ($name eq 'communities') {
                   12897:                     $trailstr = &mt('Communities');
1.655     raeburn  12898:                 } else {
                   12899:                     $trailstr = $name;
                   12900:                 }
                   12901:                 if ($allitems->{$item} eq '') {
                   12902:                     push(@{$trails},$trailstr);
                   12903:                     $allitems->{$item} = scalar(@{$trails})-1;
                   12904:                 }
                   12905:                 my @parents = ($name);
                   12906:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   12907:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   12908:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  12909:                         if (ref($subcats) eq 'HASH') {
                   12910:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   12911:                         }
                   12912:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   12913:                     }
                   12914:                 } else {
                   12915:                     if (ref($subcats) eq 'HASH') {
                   12916:                         $subcats->{$item} = [];
1.655     raeburn  12917:                     }
                   12918:                 }
                   12919:             }
                   12920:         }
                   12921:     }
                   12922:     return;
                   12923: }
                   12924: 
                   12925: =pod
                   12926: 
                   12927: =item *&recurse_categories()
                   12928: 
                   12929: Recursively used to generate breadcrumb trails for course categories.
                   12930: 
                   12931: Inputs:
1.663     raeburn  12932: 
1.655     raeburn  12933: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12934:       categories and subcategories).
1.663     raeburn  12935: 
1.655     raeburn  12936: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  12937: 
                   12938: category (current course category, for which breadcrumb trail is being generated).
                   12939: 
                   12940: trails (reference to array of breadcrumb trails for each category).
                   12941: 
1.655     raeburn  12942: allitems (reference to hash - key is category key
                   12943:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  12944: 
1.655     raeburn  12945: parents (array containing containers directories for current category, 
                   12946:          back to top level). 
                   12947: 
                   12948: Returns: nothing
                   12949: 
                   12950: Side effects: populates trails and allitems hash references
                   12951: 
                   12952: =cut
                   12953: 
                   12954: sub recurse_categories {
1.665     raeburn  12955:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  12956:     my $shallower = $depth - 1;
                   12957:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   12958:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   12959:             my $name = $cats->[$depth]{$category}[$k];
                   12960:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   12961:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   12962:             if ($allitems->{$item} eq '') {
                   12963:                 push(@{$trails},$trailstr);
                   12964:                 $allitems->{$item} = scalar(@{$trails})-1;
                   12965:             }
                   12966:             my $deeper = $depth+1;
                   12967:             push(@{$parents},$category);
1.665     raeburn  12968:             if (ref($subcats) eq 'HASH') {
                   12969:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   12970:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   12971:                     my $higher;
                   12972:                     if ($j > 0) {
                   12973:                         $higher = &escape($parents->[$j]).':'.
                   12974:                                   &escape($parents->[$j-1]).':'.$j;
                   12975:                     } else {
                   12976:                         $higher = &escape($parents->[$j]).'::'.$j;
                   12977:                     }
                   12978:                     push(@{$subcats->{$higher}},$subcat);
                   12979:                 }
                   12980:             }
                   12981:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   12982:                                 $subcats);
1.655     raeburn  12983:             pop(@{$parents});
                   12984:         }
                   12985:     } else {
                   12986:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   12987:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   12988:         if ($allitems->{$item} eq '') {
                   12989:             push(@{$trails},$trailstr);
                   12990:             $allitems->{$item} = scalar(@{$trails})-1;
                   12991:         }
                   12992:     }
                   12993:     return;
                   12994: }
                   12995: 
1.663     raeburn  12996: =pod
                   12997: 
                   12998: =item *&assign_categories_table()
                   12999: 
                   13000: Create a datatable for display of hierarchical categories in a domain,
                   13001: with checkboxes to allow a course to be categorized. 
                   13002: 
                   13003: Inputs:
                   13004: 
                   13005: cathash - reference to hash of categories defined for the domain (from
                   13006:           configuration.db)
                   13007: 
                   13008: currcat - scalar with an & separated list of categories assigned to a course. 
                   13009: 
1.919     raeburn  13010: type    - scalar contains course type (Course or Community).
                   13011: 
1.663     raeburn  13012: Returns: $output (markup to be displayed) 
                   13013: 
                   13014: =cut
                   13015: 
                   13016: sub assign_categories_table {
1.919     raeburn  13017:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  13018:     my $output;
                   13019:     if (ref($cathash) eq 'HASH') {
                   13020:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   13021:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   13022:         $maxdepth = scalar(@cats);
                   13023:         if (@cats > 0) {
                   13024:             my $itemcount = 0;
                   13025:             if (ref($cats[0]) eq 'ARRAY') {
                   13026:                 my @currcategories;
                   13027:                 if ($currcat ne '') {
                   13028:                     @currcategories = split('&',$currcat);
                   13029:                 }
1.919     raeburn  13030:                 my $table;
1.663     raeburn  13031:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   13032:                     my $parent = $cats[0][$i];
1.919     raeburn  13033:                     next if ($parent eq 'instcode');
                   13034:                     if ($type eq 'Community') {
                   13035:                         next unless ($parent eq 'communities');
                   13036:                     } else {
                   13037:                         next if ($parent eq 'communities');
                   13038:                     }
1.663     raeburn  13039:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13040:                     my $item = &escape($parent).'::0';
                   13041:                     my $checked = '';
                   13042:                     if (@currcategories > 0) {
                   13043:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   13044:                             $checked = ' checked="checked"';
1.663     raeburn  13045:                         }
                   13046:                     }
1.919     raeburn  13047:                     my $parent_title = $parent;
                   13048:                     if ($parent eq 'communities') {
                   13049:                         $parent_title = &mt('Communities');
                   13050:                     }
                   13051:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   13052:                               '<input type="checkbox" name="usecategory" value="'.
                   13053:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   13054:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  13055:                     my $depth = 1;
                   13056:                     push(@path,$parent);
1.919     raeburn  13057:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  13058:                     pop(@path);
1.919     raeburn  13059:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  13060:                     $itemcount ++;
                   13061:                 }
1.919     raeburn  13062:                 if ($itemcount) {
                   13063:                     $output = &Apache::loncommon::start_data_table().
                   13064:                               $table.
                   13065:                               &Apache::loncommon::end_data_table();
                   13066:                 }
1.663     raeburn  13067:             }
                   13068:         }
                   13069:     }
                   13070:     return $output;
                   13071: }
                   13072: 
                   13073: =pod
                   13074: 
                   13075: =item *&assign_category_rows()
                   13076: 
                   13077: Create a datatable row for display of nested categories in a domain,
                   13078: with checkboxes to allow a course to be categorized,called recursively.
                   13079: 
                   13080: Inputs:
                   13081: 
                   13082: itemcount - track row number for alternating colors
                   13083: 
                   13084: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   13085:       categories and subcategories.
                   13086: 
                   13087: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   13088: 
                   13089: parent - parent of current category item
                   13090: 
                   13091: path - Array containing all categories back up through the hierarchy from the
                   13092:        current category to the top level.
                   13093: 
                   13094: currcategories - reference to array of current categories assigned to the course
                   13095: 
                   13096: Returns: $output (markup to be displayed).
                   13097: 
                   13098: =cut
                   13099: 
                   13100: sub assign_category_rows {
                   13101:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   13102:     my ($text,$name,$item,$chgstr);
                   13103:     if (ref($cats) eq 'ARRAY') {
                   13104:         my $maxdepth = scalar(@{$cats});
                   13105:         if (ref($cats->[$depth]) eq 'HASH') {
                   13106:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   13107:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   13108:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13109:                 $text .= '<td><table class="LC_datatable">';
                   13110:                 for (my $j=0; $j<$numchildren; $j++) {
                   13111:                     $name = $cats->[$depth]{$parent}[$j];
                   13112:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   13113:                     my $deeper = $depth+1;
                   13114:                     my $checked = '';
                   13115:                     if (ref($currcategories) eq 'ARRAY') {
                   13116:                         if (@{$currcategories} > 0) {
                   13117:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   13118:                                 $checked = ' checked="checked"';
1.663     raeburn  13119:                             }
                   13120:                         }
                   13121:                     }
1.664     raeburn  13122:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   13123:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  13124:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   13125:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   13126:                              '</td><td>';
1.663     raeburn  13127:                     if (ref($path) eq 'ARRAY') {
                   13128:                         push(@{$path},$name);
                   13129:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   13130:                         pop(@{$path});
                   13131:                     }
                   13132:                     $text .= '</td></tr>';
                   13133:                 }
                   13134:                 $text .= '</table></td>';
                   13135:             }
                   13136:         }
                   13137:     }
                   13138:     return $text;
                   13139: }
                   13140: 
1.655     raeburn  13141: ############################################################
                   13142: ############################################################
                   13143: 
                   13144: 
1.443     albertel 13145: sub commit_customrole {
1.664     raeburn  13146:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  13147:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 13148:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   13149:                          ($end?', ending '.localtime($end):'').': <b>'.
                   13150:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  13151:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 13152:                  '</b><br />';
                   13153:     return $output;
                   13154: }
                   13155: 
                   13156: sub commit_standardrole {
1.541     raeburn  13157:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
                   13158:     my ($output,$logmsg,$linefeed);
                   13159:     if ($context eq 'auto') {
                   13160:         $linefeed = "\n";
                   13161:     } else {
                   13162:         $linefeed = "<br />\n";
                   13163:     }  
1.443     albertel 13164:     if ($three eq 'st') {
1.541     raeburn  13165:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
                   13166:                                          $one,$two,$sec,$context);
                   13167:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  13168:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   13169:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 13170:         } else {
1.541     raeburn  13171:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 13172:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13173:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   13174:             if ($context eq 'auto') {
                   13175:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   13176:             } else {
                   13177:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   13178:                &mt('Add to classlist').': <b>ok</b>';
                   13179:             }
                   13180:             $output .= $linefeed;
1.443     albertel 13181:         }
                   13182:     } else {
                   13183:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   13184:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13185:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  13186:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  13187:         if ($context eq 'auto') {
                   13188:             $output .= $result.$linefeed;
                   13189:         } else {
                   13190:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   13191:         }
1.443     albertel 13192:     }
                   13193:     return $output;
                   13194: }
                   13195: 
                   13196: sub commit_studentrole {
1.541     raeburn  13197:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626     raeburn  13198:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  13199:     if ($context eq 'auto') {
                   13200:         $linefeed = "\n";
                   13201:     } else {
                   13202:         $linefeed = '<br />'."\n";
                   13203:     }
1.443     albertel 13204:     if (defined($one) && defined($two)) {
                   13205:         my $cid=$one.'_'.$two;
                   13206:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   13207:         my $secchange = 0;
                   13208:         my $expire_role_result;
                   13209:         my $modify_section_result;
1.628     raeburn  13210:         if ($oldsec ne '-1') { 
                   13211:             if ($oldsec ne $sec) {
1.443     albertel 13212:                 $secchange = 1;
1.628     raeburn  13213:                 my $now = time;
1.443     albertel 13214:                 my $uurl='/'.$cid;
                   13215:                 $uurl=~s/\_/\//g;
                   13216:                 if ($oldsec) {
                   13217:                     $uurl.='/'.$oldsec;
                   13218:                 }
1.626     raeburn  13219:                 $oldsecurl = $uurl;
1.628     raeburn  13220:                 $expire_role_result = 
1.652     raeburn  13221:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  13222:                 if ($env{'request.course.sec'} ne '') { 
                   13223:                     if ($expire_role_result eq 'refused') {
                   13224:                         my @roles = ('st');
                   13225:                         my @statuses = ('previous');
                   13226:                         my @roledoms = ($one);
                   13227:                         my $withsec = 1;
                   13228:                         my %roleshash = 
                   13229:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   13230:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   13231:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   13232:                             my ($oldstart,$oldend) = 
                   13233:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   13234:                             if ($oldend > 0 && $oldend <= $now) {
                   13235:                                 $expire_role_result = 'ok';
                   13236:                             }
                   13237:                         }
                   13238:                     }
                   13239:                 }
1.443     albertel 13240:                 $result = $expire_role_result;
                   13241:             }
                   13242:         }
                   13243:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652     raeburn  13244:             $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443     albertel 13245:             if ($modify_section_result =~ /^ok/) {
                   13246:                 if ($secchange == 1) {
1.628     raeburn  13247:                     if ($sec eq '') {
                   13248:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   13249:                     } else {
                   13250:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   13251:                     }
1.443     albertel 13252:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  13253:                     if ($sec eq '') {
                   13254:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   13255:                     } else {
                   13256:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13257:                     }
1.443     albertel 13258:                 } else {
1.628     raeburn  13259:                     if ($sec eq '') {
                   13260:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   13261:                     } else {
                   13262:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13263:                     }
1.443     albertel 13264:                 }
                   13265:             } else {
1.628     raeburn  13266:                 if ($secchange) {       
                   13267:                     $$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;
                   13268:                 } else {
                   13269:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   13270:                 }
1.443     albertel 13271:             }
                   13272:             $result = $modify_section_result;
                   13273:         } elsif ($secchange == 1) {
1.628     raeburn  13274:             if ($oldsec eq '') {
1.1075.2.20  raeburn  13275:                 $$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  13276:             } else {
                   13277:                 $$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;
                   13278:             }
1.626     raeburn  13279:             if ($expire_role_result eq 'refused') {
                   13280:                 my $newsecurl = '/'.$cid;
                   13281:                 $newsecurl =~ s/\_/\//g;
                   13282:                 if ($sec ne '') {
                   13283:                     $newsecurl.='/'.$sec;
                   13284:                 }
                   13285:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   13286:                     if ($sec eq '') {
                   13287:                         $$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;
                   13288:                     } else {
                   13289:                         $$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;
                   13290:                     }
                   13291:                 }
                   13292:             }
1.443     albertel 13293:         }
                   13294:     } else {
1.626     raeburn  13295:         $$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 13296:         $result = "error: incomplete course id\n";
                   13297:     }
                   13298:     return $result;
                   13299: }
                   13300: 
1.1075.2.25  raeburn  13301: sub show_role_extent {
                   13302:     my ($scope,$context,$role) = @_;
                   13303:     $scope =~ s{^/}{};
                   13304:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   13305:     push(@courseroles,'co');
                   13306:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   13307:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   13308:         $scope =~ s{/}{_};
                   13309:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   13310:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   13311:         my ($audom,$auname) = split(/\//,$scope);
                   13312:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   13313:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   13314:     } else {
                   13315:         $scope =~ s{/$}{};
                   13316:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   13317:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   13318:     }
                   13319: }
                   13320: 
1.443     albertel 13321: ############################################################
                   13322: ############################################################
                   13323: 
1.566     albertel 13324: sub check_clone {
1.578     raeburn  13325:     my ($args,$linefeed) = @_;
1.566     albertel 13326:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   13327:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   13328:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   13329:     my $clonemsg;
                   13330:     my $can_clone = 0;
1.944     raeburn  13331:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  13332:     if ($lctype ne 'community') {
                   13333:         $lctype = 'course';
                   13334:     }
1.566     albertel 13335:     if ($clonehome eq 'no_host') {
1.944     raeburn  13336:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13337:             $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'});
                   13338:         } else {
                   13339:             $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'});
                   13340:         }     
1.566     albertel 13341:     } else {
                   13342: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  13343:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13344:             if ($clonedesc{'type'} ne 'Community') {
                   13345:                  $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'});
                   13346:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13347:             }
                   13348:         }
1.882     raeburn  13349: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   13350:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 13351: 	    $can_clone = 1;
                   13352: 	} else {
                   13353: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   13354: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   13355: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  13356:             if (grep(/^\*$/,@cloners)) {
                   13357:                 $can_clone = 1;
                   13358:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   13359:                 $can_clone = 1;
                   13360:             } else {
1.908     raeburn  13361:                 my $ccrole = 'cc';
1.944     raeburn  13362:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13363:                     $ccrole = 'co';
                   13364:                 }
1.578     raeburn  13365: 	        my %roleshash =
                   13366: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   13367: 					 $args->{'ccdomain'},
1.908     raeburn  13368:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  13369: 					 [$args->{'clonedomain'}]);
1.908     raeburn  13370: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  13371:                     $can_clone = 1;
                   13372:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   13373:                     $can_clone = 1;
                   13374:                 } else {
1.944     raeburn  13375:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13376:                         $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'});
                   13377:                     } else {
                   13378:                         $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'});
                   13379:                     }
1.578     raeburn  13380: 	        }
1.566     albertel 13381: 	    }
1.578     raeburn  13382:         }
1.566     albertel 13383:     }
                   13384:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13385: }
                   13386: 
1.444     albertel 13387: sub construct_course {
1.885     raeburn  13388:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444     albertel 13389:     my $outcome;
1.541     raeburn  13390:     my $linefeed =  '<br />'."\n";
                   13391:     if ($context eq 'auto') {
                   13392:         $linefeed = "\n";
                   13393:     }
1.566     albertel 13394: 
                   13395: #
                   13396: # Are we cloning?
                   13397: #
                   13398:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13399:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  13400: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 13401: 	if ($context ne 'auto') {
1.578     raeburn  13402:             if ($clonemsg ne '') {
                   13403: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   13404:             }
1.566     albertel 13405: 	}
                   13406: 	$outcome .= $clonemsg.$linefeed;
                   13407: 
                   13408:         if (!$can_clone) {
                   13409: 	    return (0,$outcome);
                   13410: 	}
                   13411:     }
                   13412: 
1.444     albertel 13413: #
                   13414: # Open course
                   13415: #
                   13416:     my $crstype = lc($args->{'crstype'});
                   13417:     my %cenv=();
                   13418:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   13419:                                              $args->{'cdescr'},
                   13420:                                              $args->{'curl'},
                   13421:                                              $args->{'course_home'},
                   13422:                                              $args->{'nonstandard'},
                   13423:                                              $args->{'crscode'},
                   13424:                                              $args->{'ccuname'}.':'.
                   13425:                                              $args->{'ccdomain'},
1.882     raeburn  13426:                                              $args->{'crstype'},
1.885     raeburn  13427:                                              $cnum,$context,$category);
1.444     albertel 13428: 
                   13429:     # Note: The testing routines depend on this being output; see 
                   13430:     # Utils::Course. This needs to at least be output as a comment
                   13431:     # if anyone ever decides to not show this, and Utils::Course::new
                   13432:     # will need to be suitably modified.
1.541     raeburn  13433:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  13434:     if ($$courseid =~ /^error:/) {
                   13435:         return (0,$outcome);
                   13436:     }
                   13437: 
1.444     albertel 13438: #
                   13439: # Check if created correctly
                   13440: #
1.479     albertel 13441:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 13442:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  13443:     if ($crsuhome eq 'no_host') {
                   13444:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   13445:         return (0,$outcome);
                   13446:     }
1.541     raeburn  13447:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 13448: 
1.444     albertel 13449: #
1.566     albertel 13450: # Do the cloning
                   13451: #   
                   13452:     if ($can_clone && $cloneid) {
                   13453: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   13454: 	if ($context ne 'auto') {
                   13455: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   13456: 	}
                   13457: 	$outcome .= $clonemsg.$linefeed;
                   13458: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 13459: # Copy all files
1.637     www      13460: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 13461: # Restore URL
1.566     albertel 13462: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 13463: # Restore title
1.566     albertel 13464: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  13465: # Restore creation date, creator and creation context.
                   13466:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   13467:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   13468:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 13469: # Mark as cloned
1.566     albertel 13470: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      13471: # Need to clone grading mode
                   13472:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   13473:         $cenv{'grading'}=$newenv{'grading'};
                   13474: # Do not clone these environment entries
                   13475:         &Apache::lonnet::del('environment',
                   13476:                   ['default_enrollment_start_date',
                   13477:                    'default_enrollment_end_date',
                   13478:                    'question.email',
                   13479:                    'policy.email',
                   13480:                    'comment.email',
                   13481:                    'pch.users.denied',
1.725     raeburn  13482:                    'plc.users.denied',
                   13483:                    'hidefromcat',
                   13484:                    'categories'],
1.638     www      13485:                    $$crsudom,$$crsunum);
1.444     albertel 13486:     }
1.566     albertel 13487: 
1.444     albertel 13488: #
                   13489: # Set environment (will override cloned, if existing)
                   13490: #
                   13491:     my @sections = ();
                   13492:     my @xlists = ();
                   13493:     if ($args->{'crstype'}) {
                   13494:         $cenv{'type'}=$args->{'crstype'};
                   13495:     }
                   13496:     if ($args->{'crsid'}) {
                   13497:         $cenv{'courseid'}=$args->{'crsid'};
                   13498:     }
                   13499:     if ($args->{'crscode'}) {
                   13500:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   13501:     }
                   13502:     if ($args->{'crsquota'} ne '') {
                   13503:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   13504:     } else {
                   13505:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   13506:     }
                   13507:     if ($args->{'ccuname'}) {
                   13508:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   13509:                                         ':'.$args->{'ccdomain'};
                   13510:     } else {
                   13511:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   13512:     }
                   13513:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   13514:     if ($args->{'crssections'}) {
                   13515:         $cenv{'internal.sectionnums'} = '';
                   13516:         if ($args->{'crssections'} =~ m/,/) {
                   13517:             @sections = split/,/,$args->{'crssections'};
                   13518:         } else {
                   13519:             $sections[0] = $args->{'crssections'};
                   13520:         }
                   13521:         if (@sections > 0) {
                   13522:             foreach my $item (@sections) {
                   13523:                 my ($sec,$gp) = split/:/,$item;
                   13524:                 my $class = $args->{'crscode'}.$sec;
                   13525:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   13526:                 $cenv{'internal.sectionnums'} .= $item.',';
                   13527:                 unless ($addcheck eq 'ok') {
                   13528:                     push @badclasses, $class;
                   13529:                 }
                   13530:             }
                   13531:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   13532:         }
                   13533:     }
                   13534: # do not hide course coordinator from staff listing, 
                   13535: # even if privileged
                   13536:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13537: # add crosslistings
                   13538:     if ($args->{'crsxlist'}) {
                   13539:         $cenv{'internal.crosslistings'}='';
                   13540:         if ($args->{'crsxlist'} =~ m/,/) {
                   13541:             @xlists = split/,/,$args->{'crsxlist'};
                   13542:         } else {
                   13543:             $xlists[0] = $args->{'crsxlist'};
                   13544:         }
                   13545:         if (@xlists > 0) {
                   13546:             foreach my $item (@xlists) {
                   13547:                 my ($xl,$gp) = split/:/,$item;
                   13548:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   13549:                 $cenv{'internal.crosslistings'} .= $item.',';
                   13550:                 unless ($addcheck eq 'ok') {
                   13551:                     push @badclasses, $xl;
                   13552:                 }
                   13553:             }
                   13554:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   13555:         }
                   13556:     }
                   13557:     if ($args->{'autoadds'}) {
                   13558:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   13559:     }
                   13560:     if ($args->{'autodrops'}) {
                   13561:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   13562:     }
                   13563: # check for notification of enrollment changes
                   13564:     my @notified = ();
                   13565:     if ($args->{'notify_owner'}) {
                   13566:         if ($args->{'ccuname'} ne '') {
                   13567:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   13568:         }
                   13569:     }
                   13570:     if ($args->{'notify_dc'}) {
                   13571:         if ($uname ne '') { 
1.630     raeburn  13572:             push(@notified,$uname.':'.$udom);
1.444     albertel 13573:         }
                   13574:     }
                   13575:     if (@notified > 0) {
                   13576:         my $notifylist;
                   13577:         if (@notified > 1) {
                   13578:             $notifylist = join(',',@notified);
                   13579:         } else {
                   13580:             $notifylist = $notified[0];
                   13581:         }
                   13582:         $cenv{'internal.notifylist'} = $notifylist;
                   13583:     }
                   13584:     if (@badclasses > 0) {
                   13585:         my %lt=&Apache::lonlocal::texthash(
                   13586:                 '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',
                   13587:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   13588:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   13589:         );
1.541     raeburn  13590:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   13591:                            ' ('.$lt{'adby'}.')';
                   13592:         if ($context eq 'auto') {
                   13593:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 13594:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  13595:             foreach my $item (@badclasses) {
                   13596:                 if ($context eq 'auto') {
                   13597:                     $outcome .= " - $item\n";
                   13598:                 } else {
                   13599:                     $outcome .= "<li>$item</li>\n";
                   13600:                 }
                   13601:             }
                   13602:             if ($context eq 'auto') {
                   13603:                 $outcome .= $linefeed;
                   13604:             } else {
1.566     albertel 13605:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  13606:             }
                   13607:         } 
1.444     albertel 13608:     }
                   13609:     if ($args->{'no_end_date'}) {
                   13610:         $args->{'endaccess'} = 0;
                   13611:     }
                   13612:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   13613:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   13614:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   13615:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   13616:     if ($args->{'showphotos'}) {
                   13617:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   13618:     }
                   13619:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   13620:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   13621:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   13622:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  13623:             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'); 
                   13624:             if ($context eq 'auto') {
                   13625:                 $outcome .= $krb_msg;
                   13626:             } else {
1.566     albertel 13627:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  13628:             }
                   13629:             $outcome .= $linefeed;
1.444     albertel 13630:         }
                   13631:     }
                   13632:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   13633:        if ($args->{'setpolicy'}) {
                   13634:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13635:        }
                   13636:        if ($args->{'setcontent'}) {
                   13637:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13638:        }
                   13639:     }
                   13640:     if ($args->{'reshome'}) {
                   13641: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   13642: 	$cenv{'reshome'}=~s/\/+$/\//;
                   13643:     }
                   13644: #
                   13645: # course has keyed access
                   13646: #
                   13647:     if ($args->{'setkeys'}) {
                   13648:        $cenv{'keyaccess'}='yes';
                   13649:     }
                   13650: # if specified, key authority is not course, but user
                   13651: # only active if keyaccess is yes
                   13652:     if ($args->{'keyauth'}) {
1.487     albertel 13653: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   13654: 	$user = &LONCAPA::clean_username($user);
                   13655: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     13656: 	if ($user ne '' && $domain ne '') {
1.487     albertel 13657: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 13658: 	}
                   13659:     }
                   13660: 
                   13661:     if ($args->{'disresdis'}) {
                   13662:         $cenv{'pch.roles.denied'}='st';
                   13663:     }
                   13664:     if ($args->{'disablechat'}) {
                   13665:         $cenv{'plc.roles.denied'}='st';
                   13666:     }
                   13667: 
                   13668:     # Record we've not yet viewed the Course Initialization Helper for this 
                   13669:     # course
                   13670:     $cenv{'course.helper.not.run'} = 1;
                   13671:     #
                   13672:     # Use new Randomseed
                   13673:     #
                   13674:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   13675:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   13676:     #
                   13677:     # The encryption code and receipt prefix for this course
                   13678:     #
                   13679:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   13680:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   13681:     #
                   13682:     # By default, use standard grading
                   13683:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   13684: 
1.541     raeburn  13685:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   13686:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 13687: #
                   13688: # Open all assignments
                   13689: #
                   13690:     if ($args->{'openall'}) {
                   13691:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   13692:        my %storecontent = ($storeunder         => time,
                   13693:                            $storeunder.'.type' => 'date_start');
                   13694:        
                   13695:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  13696:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 13697:    }
                   13698: #
                   13699: # Set first page
                   13700: #
                   13701:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   13702: 	    || ($cloneid)) {
1.445     albertel 13703: 	use LONCAPA::map;
1.444     albertel 13704: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 13705: 
                   13706: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   13707:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   13708: 
1.444     albertel 13709:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   13710:         my $title; my $url;
                   13711:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   13712: 	    $title=&mt('Syllabus');
1.444     albertel 13713:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   13714:         } else {
1.963     raeburn  13715:             $title=&mt('Table of Contents');
1.444     albertel 13716:             $url='/adm/navmaps';
                   13717:         }
1.445     albertel 13718: 
                   13719:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   13720: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   13721: 
                   13722: 	if ($errtext) { $fatal=2; }
1.541     raeburn  13723:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 13724:     }
1.566     albertel 13725: 
                   13726:     return (1,$outcome);
1.444     albertel 13727: }
                   13728: 
                   13729: ############################################################
                   13730: ############################################################
                   13731: 
1.953     droeschl 13732: #SD
                   13733: # only Community and Course, or anything else?
1.378     raeburn  13734: sub course_type {
                   13735:     my ($cid) = @_;
                   13736:     if (!defined($cid)) {
                   13737:         $cid = $env{'request.course.id'};
                   13738:     }
1.404     albertel 13739:     if (defined($env{'course.'.$cid.'.type'})) {
                   13740:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  13741:     } else {
                   13742:         return 'Course';
1.377     raeburn  13743:     }
                   13744: }
1.156     albertel 13745: 
1.406     raeburn  13746: sub group_term {
                   13747:     my $crstype = &course_type();
                   13748:     my %names = (
                   13749:                   'Course' => 'group',
1.865     raeburn  13750:                   'Community' => 'group',
1.406     raeburn  13751:                 );
                   13752:     return $names{$crstype};
                   13753: }
                   13754: 
1.902     raeburn  13755: sub course_types {
                   13756:     my @types = ('official','unofficial','community');
                   13757:     my %typename = (
                   13758:                          official   => 'Official course',
                   13759:                          unofficial => 'Unofficial course',
                   13760:                          community  => 'Community',
                   13761:                    );
                   13762:     return (\@types,\%typename);
                   13763: }
                   13764: 
1.156     albertel 13765: sub icon {
                   13766:     my ($file)=@_;
1.505     albertel 13767:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 13768:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 13769:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 13770:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   13771: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   13772: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   13773: 	            $curfext.".gif") {
                   13774: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   13775: 		$curfext.".gif";
                   13776: 	}
                   13777:     }
1.249     albertel 13778:     return &lonhttpdurl($iconname);
1.154     albertel 13779: } 
1.84      albertel 13780: 
1.575     albertel 13781: sub lonhttpdurl {
1.692     www      13782: #
                   13783: # Had been used for "small fry" static images on separate port 8080.
                   13784: # Modify here if lightweight http functionality desired again.
                   13785: # Currently eliminated due to increasing firewall issues.
                   13786: #
1.575     albertel 13787:     my ($url)=@_;
1.692     www      13788:     return $url;
1.215     albertel 13789: }
                   13790: 
1.213     albertel 13791: sub connection_aborted {
                   13792:     my ($r)=@_;
                   13793:     $r->print(" ");$r->rflush();
                   13794:     my $c = $r->connection;
                   13795:     return $c->aborted();
                   13796: }
                   13797: 
1.221     foxr     13798: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     13799: #    strings as 'strings'.
                   13800: sub escape_single {
1.221     foxr     13801:     my ($input) = @_;
1.223     albertel 13802:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     13803:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   13804:     return $input;
                   13805: }
1.223     albertel 13806: 
1.222     foxr     13807: #  Same as escape_single, but escape's "'s  This 
                   13808: #  can be used for  "strings"
                   13809: sub escape_double {
                   13810:     my ($input) = @_;
                   13811:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   13812:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   13813:     return $input;
                   13814: }
1.223     albertel 13815:  
1.222     foxr     13816: #   Escapes the last element of a full URL.
                   13817: sub escape_url {
                   13818:     my ($url)   = @_;
1.238     raeburn  13819:     my @urlslices = split(/\//, $url,-1);
1.369     www      13820:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 13821:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     13822: }
1.462     albertel 13823: 
1.820     raeburn  13824: sub compare_arrays {
                   13825:     my ($arrayref1,$arrayref2) = @_;
                   13826:     my (@difference,%count);
                   13827:     @difference = ();
                   13828:     %count = ();
                   13829:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   13830:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   13831:         foreach my $element (keys(%count)) {
                   13832:             if ($count{$element} == 1) {
                   13833:                 push(@difference,$element);
                   13834:             }
                   13835:         }
                   13836:     }
                   13837:     return @difference;
                   13838: }
                   13839: 
1.817     bisitz   13840: # -------------------------------------------------------- Initialize user login
1.462     albertel 13841: sub init_user_environment {
1.463     albertel 13842:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 13843:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   13844: 
                   13845:     my $public=($username eq 'public' && $domain eq 'public');
                   13846: 
                   13847: # See if old ID present, if so, remove
                   13848: 
1.1062    raeburn  13849:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 13850:     my $now=time;
                   13851: 
                   13852:     if ($public) {
                   13853: 	my $max_public=100;
                   13854: 	my $oldest;
                   13855: 	my $oldest_time=0;
                   13856: 	for(my $next=1;$next<=$max_public;$next++) {
                   13857: 	    if (-e $lonids."/publicuser_$next.id") {
                   13858: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   13859: 		if ($mtime<$oldest_time || !$oldest_time) {
                   13860: 		    $oldest_time=$mtime;
                   13861: 		    $oldest=$next;
                   13862: 		}
                   13863: 	    } else {
                   13864: 		$cookie="publicuser_$next";
                   13865: 		last;
                   13866: 	    }
                   13867: 	}
                   13868: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   13869:     } else {
1.463     albertel 13870: 	# if this isn't a robot, kill any existing non-robot sessions
                   13871: 	if (!$args->{'robot'}) {
                   13872: 	    opendir(DIR,$lonids);
                   13873: 	    while ($filename=readdir(DIR)) {
                   13874: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   13875: 		    unlink($lonids.'/'.$filename);
                   13876: 		}
1.462     albertel 13877: 	    }
1.463     albertel 13878: 	    closedir(DIR);
1.462     albertel 13879: 	}
                   13880: # Give them a new cookie
1.463     albertel 13881: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      13882: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 13883: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 13884:     
                   13885: # Initialize roles
                   13886: 
1.1062    raeburn  13887: 	($userroles,$firstaccenv,$timerintenv) = 
                   13888:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 13889:     }
                   13890: # ------------------------------------ Check browser type and MathML capability
                   13891: 
                   13892:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   13893:         $clientunicode,$clientos) = &decode_user_agent($r);
                   13894: 
                   13895: # ------------------------------------------------------------- Get environment
                   13896: 
                   13897:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   13898:     my ($tmp) = keys(%userenv);
                   13899:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   13900:     } else {
                   13901: 	undef(%userenv);
                   13902:     }
                   13903:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   13904: 	$form->{'interface'}=$userenv{'interface'};
                   13905:     }
                   13906:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   13907: 
                   13908: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   13909:     foreach my $option ('interface','localpath','localres') {
                   13910:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 13911:     }
                   13912: # --------------------------------------------------------- Write first profile
                   13913: 
                   13914:     {
                   13915: 	my %initial_env = 
                   13916: 	    ("user.name"          => $username,
                   13917: 	     "user.domain"        => $domain,
                   13918: 	     "user.home"          => $authhost,
                   13919: 	     "browser.type"       => $clientbrowser,
                   13920: 	     "browser.version"    => $clientversion,
                   13921: 	     "browser.mathml"     => $clientmathml,
                   13922: 	     "browser.unicode"    => $clientunicode,
                   13923: 	     "browser.os"         => $clientos,
                   13924: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   13925: 	     "request.course.fn"  => '',
                   13926: 	     "request.course.uri" => '',
                   13927: 	     "request.course.sec" => '',
                   13928: 	     "request.role"       => 'cm',
                   13929: 	     "request.role.adv"   => $env{'user.adv'},
                   13930: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   13931: 
                   13932:         if ($form->{'localpath'}) {
                   13933: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   13934: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   13935:         }
                   13936: 	
                   13937: 	if ($form->{'interface'}) {
                   13938: 	    $form->{'interface'}=~s/\W//gs;
                   13939: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   13940: 	    $env{'browser.interface'}=$form->{'interface'};
                   13941: 	}
                   13942: 
1.981     raeburn  13943:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  13944:         my %domdef;
                   13945:         unless ($domain eq 'public') {
                   13946:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   13947:         }
1.980     raeburn  13948: 
1.1075.2.7  raeburn  13949:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  13950:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  13951:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   13952:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  13953:         }
                   13954: 
1.864     raeburn  13955:         foreach my $crstype ('official','unofficial','community') {
1.765     raeburn  13956:             $userenv{'canrequest.'.$crstype} =
                   13957:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  13958:                                                   'reload','requestcourses',
                   13959:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  13960:         }
                   13961: 
1.1075.2.14  raeburn  13962:         $userenv{'canrequest.author'} =
                   13963:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   13964:                                         'reload','requestauthor',
                   13965:                                         \%userenv,\%domdef,\%is_adv);
                   13966:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   13967:                                              $domain,$username);
                   13968:         my $reqstatus = $reqauthor{'author_status'};
                   13969:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
                   13970:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   13971:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   13972:                                                   $reqauthor{'author'}{'timestamp'};
                   13973:             }
                   13974:         }
                   13975: 
1.462     albertel 13976: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  13977: 
1.462     albertel 13978: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   13979: 		 &GDBM_WRCREAT(),0640)) {
                   13980: 	    &_add_to_env(\%disk_env,\%initial_env);
                   13981: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   13982: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  13983:             if (ref($firstaccenv) eq 'HASH') {
                   13984:                 &_add_to_env(\%disk_env,$firstaccenv);
                   13985:             }
                   13986:             if (ref($timerintenv) eq 'HASH') {
                   13987:                 &_add_to_env(\%disk_env,$timerintenv);
                   13988:             }
1.463     albertel 13989: 	    if (ref($args->{'extra_env'})) {
                   13990: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   13991: 	    }
1.462     albertel 13992: 	    untie(%disk_env);
                   13993: 	} else {
1.705     tempelho 13994: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   13995: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 13996: 	    return 'error: '.$!;
                   13997: 	}
                   13998:     }
                   13999:     $env{'request.role'}='cm';
                   14000:     $env{'request.role.adv'}=$env{'user.adv'};
                   14001:     $env{'browser.type'}=$clientbrowser;
                   14002: 
                   14003:     return $cookie;
                   14004: 
                   14005: }
                   14006: 
                   14007: sub _add_to_env {
                   14008:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  14009:     if (ref($env_data) eq 'HASH') {
                   14010:         while (my ($key,$value) = each(%$env_data)) {
                   14011: 	    $idf->{$prefix.$key} = $value;
                   14012: 	    $env{$prefix.$key}   = $value;
                   14013:         }
1.462     albertel 14014:     }
                   14015: }
                   14016: 
1.685     tempelho 14017: # --- Get the symbolic name of a problem and the url
                   14018: sub get_symb {
                   14019:     my ($request,$silent) = @_;
1.726     raeburn  14020:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 14021:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   14022:     if ($symb eq '') {
                   14023:         if (!$silent) {
1.1071    raeburn  14024:             if (ref($request)) { 
                   14025:                 $request->print("Unable to handle ambiguous references:$url:.");
                   14026:             }
1.685     tempelho 14027:             return ();
                   14028:         }
                   14029:     }
                   14030:     &Apache::lonenc::check_decrypt(\$symb);
                   14031:     return ($symb);
                   14032: }
                   14033: 
                   14034: # --------------------------------------------------------------Get annotation
                   14035: 
                   14036: sub get_annotation {
                   14037:     my ($symb,$enc) = @_;
                   14038: 
                   14039:     my $key = $symb;
                   14040:     if (!$enc) {
                   14041:         $key =
                   14042:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   14043:     }
                   14044:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   14045:     return $annotation{$key};
                   14046: }
                   14047: 
                   14048: sub clean_symb {
1.731     raeburn  14049:     my ($symb,$delete_enc) = @_;
1.685     tempelho 14050: 
                   14051:     &Apache::lonenc::check_decrypt(\$symb);
                   14052:     my $enc = $env{'request.enc'};
1.731     raeburn  14053:     if ($delete_enc) {
1.730     raeburn  14054:         delete($env{'request.enc'});
                   14055:     }
1.685     tempelho 14056: 
                   14057:     return ($symb,$enc);
                   14058: }
1.462     albertel 14059: 
1.990     raeburn  14060: sub build_release_hashes {
                   14061:     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
                   14062:     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
                   14063:                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                   14064:                   (ref($randomizetry) eq 'HASH'));
                   14065:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   14066:         my ($item,$name,$value) = split(/:/,$key);
                   14067:         if ($item eq 'parameter') {
                   14068:             if (ref($checkparms->{$name}) eq 'ARRAY') {
                   14069:                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
                   14070:                     push(@{$checkparms->{$name}},$value);
                   14071:                 }
                   14072:             } else {
                   14073:                 push(@{$checkparms->{$name}},$value);
                   14074:             }
                   14075:         } elsif ($item eq 'resourcetag') {
                   14076:             if ($name eq 'responsetype') {
                   14077:                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
                   14078:             }
                   14079:         } elsif ($item eq 'course') {
                   14080:             if ($name eq 'crstype') {
                   14081:                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
                   14082:             }
                   14083:         }
                   14084:     }
                   14085:     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
                   14086:     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
                   14087:     return;
                   14088: }
                   14089: 
1.1075.2.11  raeburn  14090: sub update_content_constraints {
                   14091:     my ($cdom,$cnum,$chome,$cid) = @_;
                   14092:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   14093:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   14094:     my %checkresponsetypes;
                   14095:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   14096:         my ($item,$name,$value) = split(/:/,$key);
                   14097:         if ($item eq 'resourcetag') {
                   14098:             if ($name eq 'responsetype') {
                   14099:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   14100:             }
                   14101:         }
                   14102:     }
                   14103:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14104:     if (defined($navmap)) {
                   14105:         my %allresponses;
                   14106:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   14107:             my %responses = $res->responseTypes();
                   14108:             foreach my $key (keys(%responses)) {
                   14109:                 next unless(exists($checkresponsetypes{$key}));
                   14110:                 $allresponses{$key} += $responses{$key};
                   14111:             }
                   14112:         }
                   14113:         foreach my $key (keys(%allresponses)) {
                   14114:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   14115:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   14116:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   14117:             }
                   14118:         }
                   14119:         undef($navmap);
                   14120:     }
                   14121:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   14122:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   14123:     }
                   14124:     return;
                   14125: }
                   14126: 
1.1075.2.27! raeburn  14127: sub allmaps_incourse {
        !          14128:     my ($cdom,$cnum,$chome,$cid) = @_;
        !          14129:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
        !          14130:         $cid = $env{'request.course.id'};
        !          14131:         $cdom = $env{'course.'.$cid.'.domain'};
        !          14132:         $cnum = $env{'course.'.$cid.'.num'};
        !          14133:         $chome = $env{'course.'.$cid.'.home'};
        !          14134:     }
        !          14135:     my %allmaps = ();
        !          14136:     my $lastchange =
        !          14137:         &Apache::lonnet::get_coursechange($cdom,$cnum);
        !          14138:     if ($lastchange > $env{'request.course.tied'}) {
        !          14139:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
        !          14140:         unless ($ferr) {
        !          14141:             &update_content_constraints($cdom,$cnum,$chome,$cid);
        !          14142:         }
        !          14143:     }
        !          14144:     my $navmap = Apache::lonnavmaps::navmap->new();
        !          14145:     if (defined($navmap)) {
        !          14146:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
        !          14147:             $allmaps{$res->src()} = 1;
        !          14148:         }
        !          14149:     }
        !          14150:     return \%allmaps;
        !          14151: }
        !          14152: 
1.1075.2.11  raeburn  14153: sub parse_supplemental_title {
                   14154:     my ($title) = @_;
                   14155: 
                   14156:     my ($foldertitle,$renametitle);
                   14157:     if ($title =~ /&amp;&amp;&amp;/) {
                   14158:         $title = &HTML::Entites::decode($title);
                   14159:     }
                   14160:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   14161:         $renametitle=$4;
                   14162:         my ($time,$uname,$udom) = ($1,$2,$3);
                   14163:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   14164:         my $name =  &plainname($uname,$udom);
                   14165:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   14166:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   14167:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   14168:             $name.': <br />'.$foldertitle;
                   14169:     }
                   14170:     if (wantarray) {
                   14171:         return ($title,$foldertitle,$renametitle);
                   14172:     }
                   14173:     return $title;
                   14174: }
                   14175: 
1.1075.2.18  raeburn  14176: sub symb_to_docspath {
                   14177:     my ($symb) = @_;
                   14178:     return unless ($symb);
                   14179:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   14180:     if ($resurl=~/\.(sequence|page)$/) {
                   14181:         $mapurl=$resurl;
                   14182:     } elsif ($resurl eq 'adm/navmaps') {
                   14183:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   14184:     }
                   14185:     my $mapresobj;
                   14186:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14187:     if (ref($navmap)) {
                   14188:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   14189:     }
                   14190:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   14191:     my $type=$2;
                   14192:     my $path;
                   14193:     if (ref($mapresobj)) {
                   14194:         my $pcslist = $mapresobj->map_hierarchy();
                   14195:         if ($pcslist ne '') {
                   14196:             foreach my $pc (split(/,/,$pcslist)) {
                   14197:                 next if ($pc <= 1);
                   14198:                 my $res = $navmap->getByMapPc($pc);
                   14199:                 if (ref($res)) {
                   14200:                     my $thisurl = $res->src();
                   14201:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   14202:                     my $thistitle = $res->title();
                   14203:                     $path .= '&'.
                   14204:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
                   14205:                              &Apache::lonhtmlcommon::entity_encode($thistitle).
                   14206:                              ':'.$res->randompick().
                   14207:                              ':'.$res->randomout().
                   14208:                              ':'.$res->encrypted().
                   14209:                              ':'.$res->randomorder().
                   14210:                              ':'.$res->is_page();
                   14211:                 }
                   14212:             }
                   14213:         }
                   14214:         $path =~ s/^\&//;
                   14215:         my $maptitle = $mapresobj->title();
                   14216:         if ($mapurl eq 'default') {
                   14217:             $maptitle = 'Main Course Documents';
                   14218:         }
                   14219:         $path .= (($path ne '')? '&' : '').
                   14220:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
                   14221:                  &Apache::lonhtmlcommon::entity_encode($maptitle).
                   14222:                  ':'.$mapresobj->randompick().
                   14223:                  ':'.$mapresobj->randomout().
                   14224:                  ':'.$mapresobj->encrypted().
                   14225:                  ':'.$mapresobj->randomorder().
                   14226:                  ':'.$mapresobj->is_page();
                   14227:     } else {
                   14228:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   14229:         my $ispage = (($type eq 'page')? 1 : '');
                   14230:         if ($mapurl eq 'default') {
                   14231:             $maptitle = 'Main Course Documents';
                   14232:         }
                   14233:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
                   14234:                 &Apache::lonhtmlcommon::entity_encode($maptitle).':::::'.$ispage;
                   14235:     }
                   14236:     unless ($mapurl eq 'default') {
                   14237:         $path = 'default&'.
                   14238:                 &Apache::lonhtmlcommon::entity_encode('Main Course Documents').
                   14239:                 ':::::&'.$path;
                   14240:     }
                   14241:     return $path;
                   14242: }
                   14243: 
1.1075.2.14  raeburn  14244: sub captcha_display {
                   14245:     my ($context,$lonhost) = @_;
                   14246:     my ($output,$error);
                   14247:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   14248:     if ($captcha eq 'original') {
                   14249:         $output = &create_captcha();
                   14250:         unless ($output) {
                   14251:             $error = 'captcha';
                   14252:         }
                   14253:     } elsif ($captcha eq 'recaptcha') {
                   14254:         $output = &create_recaptcha($pubkey);
                   14255:         unless ($output) {
                   14256:             $error = 'recaptcha';
                   14257:         }
                   14258:     }
                   14259:     return ($output,$error);
                   14260: }
                   14261: 
                   14262: sub captcha_response {
                   14263:     my ($context,$lonhost) = @_;
                   14264:     my ($captcha_chk,$captcha_error);
                   14265:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   14266:     if ($captcha eq 'original') {
                   14267:         ($captcha_chk,$captcha_error) = &check_captcha();
                   14268:     } elsif ($captcha eq 'recaptcha') {
                   14269:         $captcha_chk = &check_recaptcha($privkey);
                   14270:     } else {
                   14271:         $captcha_chk = 1;
                   14272:     }
                   14273:     return ($captcha_chk,$captcha_error);
                   14274: }
                   14275: 
                   14276: sub get_captcha_config {
                   14277:     my ($context,$lonhost) = @_;
                   14278:     my ($captcha,$pubkey,$privkey,$hashtocheck);
                   14279:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   14280:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   14281:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   14282:     if ($context eq 'usercreation') {
                   14283:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   14284:         if (ref($domconfig{$context}) eq 'HASH') {
                   14285:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   14286:             if (ref($hashtocheck) eq 'HASH') {
                   14287:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   14288:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   14289:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   14290:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   14291:                     }
                   14292:                     if ($privkey && $pubkey) {
                   14293:                         $captcha = 'recaptcha';
                   14294:                     } else {
                   14295:                         $captcha = 'original';
                   14296:                     }
                   14297:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   14298:                     $captcha = 'original';
                   14299:                 }
                   14300:             }
                   14301:         } else {
                   14302:             $captcha = 'captcha';
                   14303:         }
                   14304:     } elsif ($context eq 'login') {
                   14305:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   14306:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   14307:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   14308:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
                   14309:             if ($privkey && $pubkey) {
                   14310:                 $captcha = 'recaptcha';
                   14311:             } else {
                   14312:                 $captcha = 'original';
                   14313:             }
                   14314:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   14315:             $captcha = 'original';
                   14316:         }
                   14317:     }
                   14318:     return ($captcha,$pubkey,$privkey);
                   14319: }
                   14320: 
                   14321: sub create_captcha {
                   14322:     my %captcha_params = &captcha_settings();
                   14323:     my ($output,$maxtries,$tries) = ('',10,0);
                   14324:     while ($tries < $maxtries) {
                   14325:         $tries ++;
                   14326:         my $captcha = Authen::Captcha->new (
                   14327:                                            output_folder => $captcha_params{'output_dir'},
                   14328:                                            data_folder   => $captcha_params{'db_dir'},
                   14329:                                           );
                   14330:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   14331: 
                   14332:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   14333:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   14334:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
                   14335:                      '<input type="text" size="5" name="code" value="" /><br />'.
                   14336:                      '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" />';
                   14337:             last;
                   14338:         }
                   14339:     }
                   14340:     return $output;
                   14341: }
                   14342: 
                   14343: sub captcha_settings {
                   14344:     my %captcha_params = (
                   14345:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   14346:                            www_output_dir => "/captchaspool",
                   14347:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   14348:                            numchars       => '5',
                   14349:                          );
                   14350:     return %captcha_params;
                   14351: }
                   14352: 
                   14353: sub check_captcha {
                   14354:     my ($captcha_chk,$captcha_error);
                   14355:     my $code = $env{'form.code'};
                   14356:     my $md5sum = $env{'form.crypt'};
                   14357:     my %captcha_params = &captcha_settings();
                   14358:     my $captcha = Authen::Captcha->new(
                   14359:                       output_folder => $captcha_params{'output_dir'},
                   14360:                       data_folder   => $captcha_params{'db_dir'},
                   14361:                   );
1.1075.2.26  raeburn  14362:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14  raeburn  14363:     my %captcha_hash = (
                   14364:                         0       => 'Code not checked (file error)',
                   14365:                        -1      => 'Failed: code expired',
                   14366:                        -2      => 'Failed: invalid code (not in database)',
                   14367:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   14368:     );
                   14369:     if ($captcha_chk != 1) {
                   14370:         $captcha_error = $captcha_hash{$captcha_chk}
                   14371:     }
                   14372:     return ($captcha_chk,$captcha_error);
                   14373: }
                   14374: 
                   14375: sub create_recaptcha {
                   14376:     my ($pubkey) = @_;
                   14377:     my $captcha = Captcha::reCAPTCHA->new;
                   14378:     return $captcha->get_options_setter({theme => 'white'})."\n".
                   14379:            $captcha->get_html($pubkey).
                   14380:            &mt('If either word is hard to read, [_1] will replace them.',
                   14381:                '<image src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
                   14382:            '<br /><br />';
                   14383: }
                   14384: 
                   14385: sub check_recaptcha {
                   14386:     my ($privkey) = @_;
                   14387:     my $captcha_chk;
                   14388:     my $captcha = Captcha::reCAPTCHA->new;
                   14389:     my $captcha_result =
                   14390:         $captcha->check_answer(
                   14391:                                 $privkey,
                   14392:                                 $ENV{'REMOTE_ADDR'},
                   14393:                                 $env{'form.recaptcha_challenge_field'},
                   14394:                                 $env{'form.recaptcha_response_field'},
                   14395:                               );
                   14396:     if ($captcha_result->{is_valid}) {
                   14397:         $captcha_chk = 1;
                   14398:     }
                   14399:     return $captcha_chk;
                   14400: }
                   14401: 
1.41      ng       14402: =pod
                   14403: 
                   14404: =back
                   14405: 
1.112     bowersj2 14406: =cut
1.41      ng       14407: 
1.112     bowersj2 14408: 1;
                   14409: __END__;
1.41      ng       14410: 

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