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

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.15! raeburn     4: # $Id: loncommon.pm,v 1.1075.2.14 2012/09/01 09:49:08 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.479     albertel   70: use LONCAPA qw(:DEFAULT :match);
1.657     raeburn    71: use DateTime::TimeZone;
1.687     raeburn    72: use DateTime::Locale::Catalog;
1.1075.2.14  raeburn    73: use Authen::Captcha;
                     74: use Captcha::reCAPTCHA;
1.117     www        75: 
1.517     raeburn    76: # ---------------------------------------------- Designs
                     77: use vars qw(%defaultdesign);
                     78: 
1.22      www        79: my $readit;
                     80: 
1.517     raeburn    81: 
1.157     matthew    82: ##
                     83: ## Global Variables
                     84: ##
1.46      matthew    85: 
1.643     foxr       86: 
                     87: # ----------------------------------------------- SSI with retries:
                     88: #
                     89: 
                     90: =pod
                     91: 
1.648     raeburn    92: =head1 Server Side include with retries:
1.643     foxr       93: 
                     94: =over 4
                     95: 
1.648     raeburn    96: =item * &ssi_with_retries(resource,retries form)
1.643     foxr       97: 
                     98: Performs an ssi with some number of retries.  Retries continue either
                     99: until the result is ok or until the retry count supplied by the
                    100: caller is exhausted.  
                    101: 
                    102: Inputs:
1.648     raeburn   103: 
                    104: =over 4
                    105: 
1.643     foxr      106: resource   - Identifies the resource to insert.
1.648     raeburn   107: 
1.643     foxr      108: retries    - Count of the number of retries allowed.
1.648     raeburn   109: 
1.643     foxr      110: form       - Hash that identifies the rendering options.
                    111: 
1.648     raeburn   112: =back
                    113: 
                    114: Returns:
                    115: 
                    116: =over 4
                    117: 
1.643     foxr      118: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   119: 
1.643     foxr      120: response   - The response from the last attempt (which may or may not have been successful.
                    121: 
1.648     raeburn   122: =back
                    123: 
                    124: =back
                    125: 
1.643     foxr      126: =cut
                    127: 
                    128: sub ssi_with_retries {
                    129:     my ($resource, $retries, %form) = @_;
                    130: 
                    131: 
                    132:     my $ok = 0;			# True if we got a good response.
                    133:     my $content;
                    134:     my $response;
                    135: 
                    136:     # Try to get the ssi done. within the retries count:
                    137: 
                    138:     do {
                    139: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    140: 	$ok      = $response->is_success;
1.650     www       141:         if (!$ok) {
                    142:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    143:         }
1.643     foxr      144: 	$retries--;
                    145:     } while (!$ok && ($retries > 0));
                    146: 
                    147:     if (!$ok) {
                    148: 	$content = '';		# On error return an empty content.
                    149:     }
                    150:     return ($content, $response);
                    151: 
                    152: }
                    153: 
                    154: 
                    155: 
1.20      www       156: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  157: my %language;
1.124     www       158: my %supported_language;
1.1048    foxr      159: my %latex_language;		# For choosing hyphenation in <transl..>
                    160: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  161: my %cprtag;
1.192     taceyjo1  162: my %scprtag;
1.351     www       163: my %fe; my %fd; my %fm;
1.41      ng        164: my %category_extensions;
1.12      harris41  165: 
1.46      matthew   166: # ---------------------------------------------- Thesaurus variables
1.144     matthew   167: #
                    168: # %Keywords:
                    169: #      A hash used by &keyword to determine if a word is considered a keyword.
                    170: # $thesaurus_db_file 
                    171: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   172: 
                    173: my %Keywords;
                    174: my $thesaurus_db_file;
                    175: 
1.144     matthew   176: #
                    177: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    178: # thesaurus.tab, and filecategories.tab.
                    179: #
1.18      www       180: BEGIN {
1.46      matthew   181:     # Variable initialization
                    182:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    183:     #
1.22      www       184:     unless ($readit) {
1.12      harris41  185: # ------------------------------------------------------------------- languages
                    186:     {
1.158     raeburn   187:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    188:                                    '/language.tab';
                    189:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  190:             while (my $line = <$fh>) {
                    191:                 next if ($line=~/^\#/);
                    192:                 chomp($line);
1.1048    foxr      193:                 my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   194:                 $language{$key}=$val.' - '.$enc;
                    195:                 if ($sup) {
                    196:                     $supported_language{$key}=$sup;
                    197:                 }
1.1048    foxr      198: 		if ($latex) {
                    199: 		    $latex_language_bykey{$key} = $latex;
                    200: 		    $latex_language{$two} = $latex;
                    201: 		}
1.158     raeburn   202:             }
                    203:             close($fh);
                    204:         }
1.12      harris41  205:     }
                    206: # ------------------------------------------------------------------ copyrights
                    207:     {
1.158     raeburn   208:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    209:                                   '/copyright.tab';
                    210:         if ( open (my $fh,"<$copyrightfile") ) {
1.356     albertel  211:             while (my $line = <$fh>) {
                    212:                 next if ($line=~/^\#/);
                    213:                 chomp($line);
                    214:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   215:                 $cprtag{$key}=$val;
                    216:             }
                    217:             close($fh);
                    218:         }
1.12      harris41  219:     }
1.351     www       220: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  221:     {
                    222:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    223:                                   '/source_copyright.tab';
                    224:         if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356     albertel  225:             while (my $line = <$fh>) {
                    226:                 next if ($line =~ /^\#/);
                    227:                 chomp($line);
                    228:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  229:                 $scprtag{$key}=$val;
                    230:             }
                    231:             close($fh);
                    232:         }
                    233:     }
1.63      www       234: 
1.517     raeburn   235: # -------------------------------------------------------------- default domain designs
1.63      www       236:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   237:     my $designfile = $designdir.'/default.tab';
                    238:     if ( open (my $fh,"<$designfile") ) {
                    239:         while (my $line = <$fh>) {
                    240:             next if ($line =~ /^\#/);
                    241:             chomp($line);
                    242:             my ($key,$val)=(split(/\=/,$line));
                    243:             if ($val) { $defaultdesign{$key}=$val; }
                    244:         }
                    245:         close($fh);
1.63      www       246:     }
                    247: 
1.15      harris41  248: # ------------------------------------------------------------- file categories
                    249:     {
1.158     raeburn   250:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    251:                                   '/filecategories.tab';
                    252:         if ( open (my $fh,"<$categoryfile") ) {
1.356     albertel  253: 	    while (my $line = <$fh>) {
                    254: 		next if ($line =~ /^\#/);
                    255: 		chomp($line);
                    256:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.158     raeburn   257:                 push @{$category_extensions{lc($category)}},$extension;
                    258:             }
                    259:             close($fh);
                    260:         }
                    261: 
1.15      harris41  262:     }
1.12      harris41  263: # ------------------------------------------------------------------ file types
                    264:     {
1.158     raeburn   265:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    266:                '/filetypes.tab';
                    267:         if ( open (my $fh,"<$typesfile") ) {
1.356     albertel  268:             while (my $line = <$fh>) {
                    269: 		next if ($line =~ /^\#/);
                    270: 		chomp($line);
                    271:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   272:                 if ($descr ne '') {
                    273:                     $fe{$ending}=lc($emb);
                    274:                     $fd{$ending}=$descr;
1.351     www       275:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   276:                 }
                    277:             }
                    278:             close($fh);
                    279:         }
1.12      harris41  280:     }
1.22      www       281:     &Apache::lonnet::logthis(
1.705     tempelho  282:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       283:     $readit=1;
1.46      matthew   284:     }  # end of unless($readit) 
1.32      matthew   285:     
                    286: }
1.112     bowersj2  287: 
1.42      matthew   288: ###############################################################
                    289: ##           HTML and Javascript Helper Functions            ##
                    290: ###############################################################
                    291: 
                    292: =pod 
                    293: 
1.112     bowersj2  294: =head1 HTML and Javascript Functions
1.42      matthew   295: 
1.112     bowersj2  296: =over 4
                    297: 
1.648     raeburn   298: =item * &browser_and_searcher_javascript()
1.112     bowersj2  299: 
                    300: X<browsing, javascript>X<searching, javascript>Returns a string
                    301: containing javascript with two functions, C<openbrowser> and
                    302: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    303: tags.
1.42      matthew   304: 
1.648     raeburn   305: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   306: 
                    307: inputs: formname, elementname, only, omit
                    308: 
                    309: formname and elementname indicate the name of the html form and name of
                    310: the element that the results of the browsing selection are to be placed in. 
                    311: 
                    312: Specifying 'only' will restrict the browser to displaying only files
1.185     www       313: with the given extension.  Can be a comma separated list.
1.42      matthew   314: 
                    315: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       316: with the given extension.  Can be a comma separated list.
1.42      matthew   317: 
1.648     raeburn   318: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   319: 
                    320: Inputs: formname, elementname
                    321: 
                    322: formname and elementname specify the name of the html form and the name
                    323: of the element the selection from the search results will be placed in.
1.542     raeburn   324: 
1.42      matthew   325: =cut
                    326: 
                    327: sub browser_and_searcher_javascript {
1.199     albertel  328:     my ($mode)=@_;
                    329:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  330:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   331:     return <<END;
1.219     albertel  332: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   333:     var editbrowser = null;
1.135     albertel  334:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       335:         var url = '$resurl/?';
1.42      matthew   336:         if (editbrowser == null) {
                    337:             url += 'launch=1&';
                    338:         }
                    339:         url += 'catalogmode=interactive&';
1.199     albertel  340:         url += 'mode=$mode&';
1.611     albertel  341:         url += 'inhibitmenu=yes&';
1.42      matthew   342:         url += 'form=' + formname + '&';
                    343:         if (only != null) {
                    344:             url += 'only=' + only + '&';
1.217     albertel  345:         } else {
                    346:             url += 'only=&';
                    347: 	}
1.42      matthew   348:         if (omit != null) {
                    349:             url += 'omit=' + omit + '&';
1.217     albertel  350:         } else {
                    351:             url += 'omit=&';
                    352: 	}
1.135     albertel  353:         if (titleelement != null) {
                    354:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  355:         } else {
                    356: 	    url += 'titleelement=&';
                    357: 	}
1.42      matthew   358:         url += 'element=' + elementname + '';
                    359:         var title = 'Browser';
1.435     albertel  360:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   361:         options += ',width=700,height=600';
                    362:         editbrowser = open(url,title,options,'1');
                    363:         editbrowser.focus();
                    364:     }
                    365:     var editsearcher;
1.135     albertel  366:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   367:         var url = '/adm/searchcat?';
                    368:         if (editsearcher == null) {
                    369:             url += 'launch=1&';
                    370:         }
                    371:         url += 'catalogmode=interactive&';
1.199     albertel  372:         url += 'mode=$mode&';
1.42      matthew   373:         url += 'form=' + formname + '&';
1.135     albertel  374:         if (titleelement != null) {
                    375:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  376:         } else {
                    377: 	    url += 'titleelement=&';
                    378: 	}
1.42      matthew   379:         url += 'element=' + elementname + '';
                    380:         var title = 'Search';
1.435     albertel  381:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   382:         options += ',width=700,height=600';
                    383:         editsearcher = open(url,title,options,'1');
                    384:         editsearcher.focus();
                    385:     }
1.219     albertel  386: // END LON-CAPA Internal -->
1.42      matthew   387: END
1.170     www       388: }
                    389: 
                    390: sub lastresurl {
1.258     albertel  391:     if ($env{'environment.lastresurl'}) {
                    392: 	return $env{'environment.lastresurl'}
1.170     www       393:     } else {
                    394: 	return '/res';
                    395:     }
                    396: }
                    397: 
                    398: sub storeresurl {
                    399:     my $resurl=&Apache::lonnet::clutter(shift);
                    400:     unless ($resurl=~/^\/res/) { return 0; }
                    401:     $resurl=~s/\/$//;
                    402:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   403:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       404:     return 1;
1.42      matthew   405: }
                    406: 
1.74      www       407: sub studentbrowser_javascript {
1.111     www       408:    unless (
1.258     albertel  409:             (($env{'request.course.id'}) && 
1.302     albertel  410:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    411: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    412: 					  '/'.$env{'request.course.sec'})
                    413: 	      ))
1.258     albertel  414:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       415:           ) { return ''; }  
1.74      www       416:    return (<<'ENDSTDBRW');
1.776     bisitz    417: <script type="text/javascript" language="Javascript">
1.824     bisitz    418: // <![CDATA[
1.74      www       419:     var stdeditbrowser;
1.999     www       420:     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74      www       421:         var url = '/adm/pickstudent?';
                    422:         var filter;
1.558     albertel  423: 	if (!ignorefilter) {
                    424: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    425: 	}
1.74      www       426:         if (filter != null) {
                    427:            if (filter != '') {
                    428:                url += 'filter='+filter+'&';
                    429: 	   }
                    430:         }
                    431:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       432:                                     '&udomelement='+udom+
                    433:                                     '&clicker='+clicker;
1.111     www       434: 	if (roleflag) { url+="&roles=1"; }
1.793     raeburn   435:         if (courseadvonly) { url+="&courseadvonly=1"; }
1.102     www       436:         var title = 'Student_Browser';
1.74      www       437:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    438:         options += ',width=700,height=600';
                    439:         stdeditbrowser = open(url,title,options,'1');
                    440:         stdeditbrowser.focus();
                    441:     }
1.824     bisitz    442: // ]]>
1.74      www       443: </script>
                    444: ENDSTDBRW
                    445: }
1.42      matthew   446: 
1.1003    www       447: sub resourcebrowser_javascript {
                    448:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       449:    return (<<'ENDRESBRW');
1.1003    www       450: <script type="text/javascript" language="Javascript">
                    451: // <![CDATA[
                    452:     var reseditbrowser;
1.1004    www       453:     function openresbrowser(formname,reslink) {
1.1005    www       454:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       455:         var title = 'Resource_Browser';
                    456:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       457:         options += ',width=700,height=500';
1.1004    www       458:         reseditbrowser = open(url,title,options,'1');
                    459:         reseditbrowser.focus();
1.1003    www       460:     }
                    461: // ]]>
                    462: </script>
1.1004    www       463: ENDRESBRW
1.1003    www       464: }
                    465: 
1.74      www       466: sub selectstudent_link {
1.999     www       467:    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
                    468:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    469:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    470:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  471:    if ($env{'request.course.id'}) {  
1.302     albertel  472:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    473: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    474: 					'/'.$env{'request.course.sec'})) {
1.111     www       475: 	   return '';
                    476:        }
1.999     www       477:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793     raeburn   478:        if ($courseadvonly)  {
                    479:            $callargs .= ",'',1,1";
                    480:        }
                    481:        return '<span class="LC_nobreak">'.
                    482:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    483:               &mt('Select User').'</a></span>';
1.74      www       484:    }
1.258     albertel  485:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       486:        $callargs .= ",'',1"; 
1.793     raeburn   487:        return '<span class="LC_nobreak">'.
                    488:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    489:               &mt('Select User').'</a></span>';
1.111     www       490:    }
                    491:    return '';
1.91      www       492: }
                    493: 
1.1004    www       494: sub selectresource_link {
                    495:    my ($form,$reslink,$arg)=@_;
                    496:    
                    497:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    498:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    499:    unless ($env{'request.course.id'}) { return $arg; }
                    500:    return '<span class="LC_nobreak">'.
                    501:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    502:               $arg.'</a></span>';
                    503: }
                    504: 
                    505: 
                    506: 
1.653     raeburn   507: sub authorbrowser_javascript {
                    508:     return <<"ENDAUTHORBRW";
1.776     bisitz    509: <script type="text/javascript" language="JavaScript">
1.824     bisitz    510: // <![CDATA[
1.653     raeburn   511: var stdeditbrowser;
                    512: 
                    513: function openauthorbrowser(formname,udom) {
                    514:     var url = '/adm/pickauthor?';
                    515:     url += 'form='+formname+'&roledom='+udom;
                    516:     var title = 'Author_Browser';
                    517:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    518:     options += ',width=700,height=600';
                    519:     stdeditbrowser = open(url,title,options,'1');
                    520:     stdeditbrowser.focus();
                    521: }
                    522: 
1.824     bisitz    523: // ]]>
1.653     raeburn   524: </script>
                    525: ENDAUTHORBRW
                    526: }
                    527: 
1.91      www       528: sub coursebrowser_javascript {
1.909     raeburn   529:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype) = @_;
1.932     raeburn   530:     my $wintitle = 'Course_Browser';
1.931     raeburn   531:     if ($crstype eq 'Community') {
1.932     raeburn   532:         $wintitle = 'Community_Browser';
1.909     raeburn   533:     }
1.876     raeburn   534:     my $id_functions = &javascript_index_functions();
                    535:     my $output = '
1.776     bisitz    536: <script type="text/javascript" language="JavaScript">
1.824     bisitz    537: // <![CDATA[
1.468     raeburn   538:     var stdeditbrowser;'."\n";
1.876     raeburn   539: 
                    540:     $output .= <<"ENDSTDBRW";
1.909     raeburn   541:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       542:         var url = '/adm/pickcourse?';
1.895     raeburn   543:         var formid = getFormIdByName(formname);
1.876     raeburn   544:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  545:         if (domainfilter != null) {
                    546:            if (domainfilter != '') {
                    547:                url += 'domainfilter='+domainfilter+'&';
                    548: 	   }
                    549:         }
1.91      www       550:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  551: 	                            '&cdomelement='+udom+
                    552:                                     '&cnameelement='+desc;
1.468     raeburn   553:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   554:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   555:                 url += '&roleelement='+extra_element;
                    556:                 if (domainfilter == null || domainfilter == '') {
                    557:                     url += '&domainfilter='+extra_element;
                    558:                 }
1.234     raeburn   559:             }
1.468     raeburn   560:             else {
                    561:                 if (formname == 'portform') {
                    562:                     url += '&setroles='+extra_element;
1.800     raeburn   563:                 } else {
                    564:                     if (formname == 'rules') {
                    565:                         url += '&fixeddom='+extra_element; 
                    566:                     }
1.468     raeburn   567:                 }
                    568:             }     
1.230     raeburn   569:         }
1.909     raeburn   570:         if (type != null && type != '') {
                    571:             url += '&type='+type;
                    572:         }
                    573:         if (type_elem != null && type_elem != '') {
                    574:             url += '&typeelement='+type_elem;
                    575:         }
1.872     raeburn   576:         if (formname == 'ccrs') {
                    577:             var ownername = document.forms[formid].ccuname.value;
                    578:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
                    579:             url += '&cloner='+ownername+':'+ownerdom;
                    580:         }
1.293     raeburn   581:         if (multflag !=null && multflag != '') {
                    582:             url += '&multiple='+multflag;
                    583:         }
1.909     raeburn   584:         var title = '$wintitle';
1.91      www       585:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    586:         options += ',width=700,height=600';
                    587:         stdeditbrowser = open(url,title,options,'1');
                    588:         stdeditbrowser.focus();
                    589:     }
1.876     raeburn   590: $id_functions
                    591: ENDSTDBRW
1.905     raeburn   592:     if (($sec_element ne '') || ($role_element ne '')) {
                    593:         $output .= &setsec_javascript($sec_element,$formname,$role_element);
1.876     raeburn   594:     }
                    595:     $output .= '
                    596: // ]]>
                    597: </script>';
                    598:     return $output;
                    599: }
                    600: 
                    601: sub javascript_index_functions {
                    602:     return <<"ENDJS";
                    603: 
                    604: function getFormIdByName(formname) {
                    605:     for (var i=0;i<document.forms.length;i++) {
                    606:         if (document.forms[i].name == formname) {
                    607:             return i;
                    608:         }
                    609:     }
                    610:     return -1;
                    611: }
                    612: 
                    613: function getIndexByName(formid,item) {
                    614:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    615:         if (document.forms[formid].elements[i].name == item) {
                    616:             return i;
                    617:         }
                    618:     }
                    619:     return -1;
                    620: }
1.468     raeburn   621: 
1.876     raeburn   622: function getDomainFromSelectbox(formname,udom) {
                    623:     var userdom;
                    624:     var formid = getFormIdByName(formname);
                    625:     if (formid > -1) {
                    626:         var domid = getIndexByName(formid,udom);
                    627:         if (domid > -1) {
                    628:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    629:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    630:             }
                    631:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    632:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   633:             }
                    634:         }
                    635:     }
1.876     raeburn   636:     return userdom;
                    637: }
                    638: 
                    639: ENDJS
1.468     raeburn   640: 
1.876     raeburn   641: }
                    642: 
1.1017    raeburn   643: sub javascript_array_indexof {
1.1018    raeburn   644:     return <<ENDJS;
1.1017    raeburn   645: <script type="text/javascript" language="JavaScript">
                    646: // <![CDATA[
                    647: 
                    648: if (!Array.prototype.indexOf) {
                    649:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    650:         "use strict";
                    651:         if (this === void 0 || this === null) {
                    652:             throw new TypeError();
                    653:         }
                    654:         var t = Object(this);
                    655:         var len = t.length >>> 0;
                    656:         if (len === 0) {
                    657:             return -1;
                    658:         }
                    659:         var n = 0;
                    660:         if (arguments.length > 0) {
                    661:             n = Number(arguments[1]);
                    662:             if (n !== n) { // shortcut for verifying if it's NaN
                    663:                 n = 0;
                    664:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    665:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    666:             }
                    667:         }
                    668:         if (n >= len) {
                    669:             return -1;
                    670:         }
                    671:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    672:         for (; k < len; k++) {
                    673:             if (k in t && t[k] === searchElement) {
                    674:                 return k;
                    675:             }
                    676:         }
                    677:         return -1;
                    678:     }
                    679: }
                    680: 
                    681: // ]]>
                    682: </script>
                    683: 
                    684: ENDJS
                    685: 
                    686: }
                    687: 
1.876     raeburn   688: sub userbrowser_javascript {
                    689:     my $id_functions = &javascript_index_functions();
                    690:     return <<"ENDUSERBRW";
                    691: 
1.888     raeburn   692: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   693:     var url = '/adm/pickuser?';
                    694:     var userdom = getDomainFromSelectbox(formname,udom);
                    695:     if (userdom != null) {
                    696:        if (userdom != '') {
                    697:            url += 'srchdom='+userdom+'&';
                    698:        }
                    699:     }
                    700:     url += 'form=' + formname + '&unameelement='+uname+
                    701:                                 '&udomelement='+udom+
                    702:                                 '&ulastelement='+ulast+
                    703:                                 '&ufirstelement='+ufirst+
                    704:                                 '&uemailelement='+uemail+
1.881     raeburn   705:                                 '&hideudomelement='+hideudom+
                    706:                                 '&coursedom='+crsdom;
1.888     raeburn   707:     if ((caller != null) && (caller != undefined)) {
                    708:         url += '&caller='+caller;
                    709:     }
1.876     raeburn   710:     var title = 'User_Browser';
                    711:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    712:     options += ',width=700,height=600';
                    713:     var stdeditbrowser = open(url,title,options,'1');
                    714:     stdeditbrowser.focus();
                    715: }
                    716: 
1.888     raeburn   717: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   718:     var formid = getFormIdByName(formname);
                    719:     if (formid > -1) {
1.888     raeburn   720:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   721:         var domid = getIndexByName(formid,udom);
                    722:         var hidedomid = getIndexByName(formid,origdom);
                    723:         if (hidedomid > -1) {
                    724:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   725:             var unameval = document.forms[formid].elements[unameid].value;
                    726:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    727:                 if (domid > -1) {
                    728:                     var slct = document.forms[formid].elements[domid];
                    729:                     if (slct.type == 'select-one') {
                    730:                         var i;
                    731:                         for (i=0;i<slct.length;i++) {
                    732:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    733:                         }
                    734:                     }
                    735:                     if (slct.type == 'hidden') {
                    736:                         slct.value = fixeddom;
1.876     raeburn   737:                     }
                    738:                 }
1.468     raeburn   739:             }
                    740:         }
                    741:     }
1.876     raeburn   742:     return;
                    743: }
                    744: 
                    745: $id_functions
                    746: ENDUSERBRW
1.468     raeburn   747: }
                    748: 
                    749: sub setsec_javascript {
1.905     raeburn   750:     my ($sec_element,$formname,$role_element) = @_;
                    751:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    752:         $communityrolestr);
                    753:     if ($role_element ne '') {
                    754:         my @allroles = ('st','ta','ep','in','ad');
                    755:         foreach my $crstype ('Course','Community') {
                    756:             if ($crstype eq 'Community') {
                    757:                 foreach my $role (@allroles) {
                    758:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    759:                 }
                    760:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    761:             } else {
                    762:                 foreach my $role (@allroles) {
                    763:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    764:                 }
                    765:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    766:             }
                    767:         }
                    768:         $rolestr = '"'.join('","',@allroles).'"';
                    769:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    770:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    771:     }
1.468     raeburn   772:     my $setsections = qq|
                    773: function setSect(sectionlist) {
1.629     raeburn   774:     var sectionsArray = new Array();
                    775:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    776:         sectionsArray = sectionlist.split(",");
                    777:     }
1.468     raeburn   778:     var numSections = sectionsArray.length;
                    779:     document.$formname.$sec_element.length = 0;
                    780:     if (numSections == 0) {
                    781:         document.$formname.$sec_element.multiple=false;
                    782:         document.$formname.$sec_element.size=1;
                    783:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    784:     } else {
                    785:         if (numSections == 1) {
                    786:             document.$formname.$sec_element.multiple=false;
                    787:             document.$formname.$sec_element.size=1;
                    788:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    789:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    790:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    791:         } else {
                    792:             for (var i=0; i<numSections; i++) {
                    793:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    794:             }
                    795:             document.$formname.$sec_element.multiple=true
                    796:             if (numSections < 3) {
                    797:                 document.$formname.$sec_element.size=numSections;
                    798:             } else {
                    799:                 document.$formname.$sec_element.size=3;
                    800:             }
                    801:             document.$formname.$sec_element.options[0].selected = false
                    802:         }
                    803:     }
1.91      www       804: }
1.905     raeburn   805: 
                    806: function setRole(crstype) {
1.468     raeburn   807: |;
1.905     raeburn   808:     if ($role_element eq '') {
                    809:         $setsections .= '    return;
                    810: }
                    811: ';
                    812:     } else {
                    813:         $setsections .= qq|
                    814:     var elementLength = document.$formname.$role_element.length;
                    815:     var allroles = Array($rolestr);
                    816:     var courserolenames = Array($courserolestr);
                    817:     var communityrolenames = Array($communityrolestr);
                    818:     if (elementLength != undefined) {
                    819:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    820:             if (crstype == 'Course') {
                    821:                 return;
                    822:             } else {
                    823:                 allroles[5] = 'co';
                    824:                 for (var i=0; i<6; i++) {
                    825:                     document.$formname.$role_element.options[i].value = allroles[i];
                    826:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    827:                 }
                    828:             }
                    829:         } else {
                    830:             if (crstype == 'Community') {
                    831:                 return;
                    832:             } else {
                    833:                 allroles[5] = 'cc';
                    834:                 for (var i=0; i<6; i++) {
                    835:                     document.$formname.$role_element.options[i].value = allroles[i];
                    836:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    837:                 }
                    838:             }
                    839:         }
                    840:     }
                    841:     return;
                    842: }
                    843: |;
                    844:     }
1.468     raeburn   845:     return $setsections;
                    846: }
                    847: 
1.91      www       848: sub selectcourse_link {
1.909     raeburn   849:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    850:        $typeelement) = @_;
                    851:    my $type = $selecttype;
1.871     raeburn   852:    my $linktext = &mt('Select Course');
                    853:    if ($selecttype eq 'Community') {
1.909     raeburn   854:        $linktext = &mt('Select Community');
1.906     raeburn   855:    } elsif ($selecttype eq 'Course/Community') {
                    856:        $linktext = &mt('Select Course/Community');
1.909     raeburn   857:        $type = '';
1.1019    raeburn   858:    } elsif ($selecttype eq 'Select') {
                    859:        $linktext = &mt('Select');
                    860:        $type = '';
1.871     raeburn   861:    }
1.787     bisitz    862:    return '<span class="LC_nobreak">'
                    863:          ."<a href='"
                    864:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    865:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   866:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   867:          ."'>".$linktext.'</a>'
1.787     bisitz    868:          .'</span>';
1.74      www       869: }
1.42      matthew   870: 
1.653     raeburn   871: sub selectauthor_link {
                    872:    my ($form,$udom)=@_;
                    873:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    874:           &mt('Select Author').'</a>';
                    875: }
                    876: 
1.876     raeburn   877: sub selectuser_link {
1.881     raeburn   878:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   879:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   880:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   881:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   882:            ');">'.$linktext.'</a>';
1.876     raeburn   883: }
                    884: 
1.273     raeburn   885: sub check_uncheck_jscript {
                    886:     my $jscript = <<"ENDSCRT";
                    887: function checkAll(field) {
                    888:     if (field.length > 0) {
                    889:         for (i = 0; i < field.length; i++) {
1.1075.2.14  raeburn   890:             if (!field[i].disabled) {
                    891:                 field[i].checked = true;
                    892:             }
1.273     raeburn   893:         }
                    894:     } else {
1.1075.2.14  raeburn   895:         if (!field.disabled) {
                    896:             field.checked = true;
                    897:         }
1.273     raeburn   898:     }
                    899: }
                    900:  
                    901: function uncheckAll(field) {
                    902:     if (field.length > 0) {
                    903:         for (i = 0; i < field.length; i++) {
                    904:             field[i].checked = false ;
1.543     albertel  905:         }
                    906:     } else {
1.273     raeburn   907:         field.checked = false ;
                    908:     }
                    909: }
                    910: ENDSCRT
                    911:     return $jscript;
                    912: }
                    913: 
1.656     www       914: sub select_timezone {
1.659     raeburn   915:    my ($name,$selected,$onchange,$includeempty)=@_;
                    916:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    917:    if ($includeempty) {
                    918:        $output .= '<option value=""';
                    919:        if (($selected eq '') || ($selected eq 'local')) {
                    920:            $output .= ' selected="selected" ';
                    921:        }
                    922:        $output .= '> </option>';
                    923:    }
1.657     raeburn   924:    my @timezones = DateTime::TimeZone->all_names;
                    925:    foreach my $tzone (@timezones) {
                    926:        $output.= '<option value="'.$tzone.'"';
                    927:        if ($tzone eq $selected) {
                    928:            $output.=' selected="selected"';
                    929:        }
                    930:        $output.=">$tzone</option>\n";
1.656     www       931:    }
                    932:    $output.="</select>";
                    933:    return $output;
                    934: }
1.273     raeburn   935: 
1.687     raeburn   936: sub select_datelocale {
                    937:     my ($name,$selected,$onchange,$includeempty)=@_;
                    938:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    939:     if ($includeempty) {
                    940:         $output .= '<option value=""';
                    941:         if ($selected eq '') {
                    942:             $output .= ' selected="selected" ';
                    943:         }
                    944:         $output .= '> </option>';
                    945:     }
                    946:     my (@possibles,%locale_names);
                    947:     my @locales = DateTime::Locale::Catalog::Locales;
                    948:     foreach my $locale (@locales) {
                    949:         if (ref($locale) eq 'HASH') {
                    950:             my $id = $locale->{'id'};
                    951:             if ($id ne '') {
                    952:                 my $en_terr = $locale->{'en_territory'};
                    953:                 my $native_terr = $locale->{'native_territory'};
1.695     raeburn   954:                 my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   955:                 if (grep(/^en$/,@languages) || !@languages) {
                    956:                     if ($en_terr ne '') {
                    957:                         $locale_names{$id} = '('.$en_terr.')';
                    958:                     } elsif ($native_terr ne '') {
                    959:                         $locale_names{$id} = $native_terr;
                    960:                     }
                    961:                 } else {
                    962:                     if ($native_terr ne '') {
                    963:                         $locale_names{$id} = $native_terr.' ';
                    964:                     } elsif ($en_terr ne '') {
                    965:                         $locale_names{$id} = '('.$en_terr.')';
                    966:                     }
                    967:                 }
                    968:                 push (@possibles,$id);
                    969:             }
                    970:         }
                    971:     }
                    972:     foreach my $item (sort(@possibles)) {
                    973:         $output.= '<option value="'.$item.'"';
                    974:         if ($item eq $selected) {
                    975:             $output.=' selected="selected"';
                    976:         }
                    977:         $output.=">$item";
                    978:         if ($locale_names{$item} ne '') {
                    979:             $output.="  $locale_names{$item}</option>\n";
                    980:         }
                    981:         $output.="</option>\n";
                    982:     }
                    983:     $output.="</select>";
                    984:     return $output;
                    985: }
                    986: 
1.792     raeburn   987: sub select_language {
                    988:     my ($name,$selected,$includeempty) = @_;
                    989:     my %langchoices;
                    990:     if ($includeempty) {
                    991:         %langchoices = ('' => 'No language preference');
                    992:     }
                    993:     foreach my $id (&languageids()) {
                    994:         my $code = &supportedlanguagecode($id);
                    995:         if ($code) {
                    996:             $langchoices{$code} = &plainlanguagedescription($id);
                    997:         }
                    998:     }
1.970     raeburn   999:     return &select_form($selected,$name,\%langchoices);
1.792     raeburn  1000: }
                   1001: 
1.42      matthew  1002: =pod
1.36      matthew  1003: 
1.648     raeburn  1004: =item * &linked_select_forms(...)
1.36      matthew  1005: 
                   1006: linked_select_forms returns a string containing a <script></script> block
                   1007: and html for two <select> menus.  The select menus will be linked in that
                   1008: changing the value of the first menu will result in new values being placed
                   1009: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1010: order unless a defined order is provided.
1.36      matthew  1011: 
                   1012: linked_select_forms takes the following ordered inputs:
                   1013: 
                   1014: =over 4
                   1015: 
1.112     bowersj2 1016: =item * $formname, the name of the <form> tag
1.36      matthew  1017: 
1.112     bowersj2 1018: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1019: 
1.112     bowersj2 1020: =item * $firstdefault, the default value for the first menu
1.36      matthew  1021: 
1.112     bowersj2 1022: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1023: 
1.112     bowersj2 1024: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1025: 
1.112     bowersj2 1026: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1027: 
1.609     raeburn  1028: =item * $menuorder, the order of values in the first menu
                   1029: 
1.41      ng       1030: =back 
                   1031: 
1.36      matthew  1032: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1033: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1034: values for the first select menu.  The text that coincides with the 
1.41      ng       1035: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1036: and text for the second menu are given in the hash pointed to by 
                   1037: $menu{$choice1}->{'select2'}.  
                   1038: 
1.112     bowersj2 1039:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1040:                        default => "B3",
                   1041:                        select2 => { 
                   1042:                            B1 => "Choice B1",
                   1043:                            B2 => "Choice B2",
                   1044:                            B3 => "Choice B3",
                   1045:                            B4 => "Choice B4"
1.609     raeburn  1046:                            },
                   1047:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1048:                    },
                   1049:                A2 => { text =>"Choice A2" ,
                   1050:                        default => "C2",
                   1051:                        select2 => { 
                   1052:                            C1 => "Choice C1",
                   1053:                            C2 => "Choice C2",
                   1054:                            C3 => "Choice C3"
1.609     raeburn  1055:                            },
                   1056:                        order => ['C2','C1','C3'],
1.112     bowersj2 1057:                    },
                   1058:                A3 => { text =>"Choice A3" ,
                   1059:                        default => "D6",
                   1060:                        select2 => { 
                   1061:                            D1 => "Choice D1",
                   1062:                            D2 => "Choice D2",
                   1063:                            D3 => "Choice D3",
                   1064:                            D4 => "Choice D4",
                   1065:                            D5 => "Choice D5",
                   1066:                            D6 => "Choice D6",
                   1067:                            D7 => "Choice D7"
1.609     raeburn  1068:                            },
                   1069:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1070:                    }
                   1071:                );
1.36      matthew  1072: 
                   1073: =cut
                   1074: 
                   1075: sub linked_select_forms {
                   1076:     my ($formname,
                   1077:         $middletext,
                   1078:         $firstdefault,
                   1079:         $firstselectname,
                   1080:         $secondselectname, 
1.609     raeburn  1081:         $hashref,
                   1082:         $menuorder,
1.36      matthew  1083:         ) = @_;
                   1084:     my $second = "document.$formname.$secondselectname";
                   1085:     my $first = "document.$formname.$firstselectname";
                   1086:     # output the javascript to do the changing
                   1087:     my $result = '';
1.776     bisitz   1088:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1089:     $result.="// <![CDATA[\n";
1.36      matthew  1090:     $result.="var select2data = new Object();\n";
                   1091:     $" = '","';
                   1092:     my $debug = '';
                   1093:     foreach my $s1 (sort(keys(%$hashref))) {
                   1094:         $result.="select2data.d_$s1 = new Object();\n";        
                   1095:         $result.="select2data.d_$s1.def = new String('".
                   1096:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1097:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1098:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1099:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1100:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1101:         }
1.36      matthew  1102:         $result.="\"@s2values\");\n";
                   1103:         $result.="select2data.d_$s1.texts = new Array(";        
                   1104:         my @s2texts;
                   1105:         foreach my $value (@s2values) {
                   1106:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1107:         }
                   1108:         $result.="\"@s2texts\");\n";
                   1109:     }
                   1110:     $"=' ';
                   1111:     $result.= <<"END";
                   1112: 
                   1113: function select1_changed() {
                   1114:     // Determine new choice
                   1115:     var newvalue = "d_" + $first.value;
                   1116:     // update select2
                   1117:     var values     = select2data[newvalue].values;
                   1118:     var texts      = select2data[newvalue].texts;
                   1119:     var select2def = select2data[newvalue].def;
                   1120:     var i;
                   1121:     // out with the old
                   1122:     for (i = 0; i < $second.options.length; i++) {
                   1123:         $second.options[i] = null;
                   1124:     }
                   1125:     // in with the nuclear
                   1126:     for (i=0;i<values.length; i++) {
                   1127:         $second.options[i] = new Option(values[i]);
1.143     matthew  1128:         $second.options[i].value = values[i];
1.36      matthew  1129:         $second.options[i].text = texts[i];
                   1130:         if (values[i] == select2def) {
                   1131:             $second.options[i].selected = true;
                   1132:         }
                   1133:     }
                   1134: }
1.824     bisitz   1135: // ]]>
1.36      matthew  1136: </script>
                   1137: END
                   1138:     # output the initial values for the selection lists
                   1139:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609     raeburn  1140:     my @order = sort(keys(%{$hashref}));
                   1141:     if (ref($menuorder) eq 'ARRAY') {
                   1142:         @order = @{$menuorder};
                   1143:     }
                   1144:     foreach my $value (@order) {
1.36      matthew  1145:         $result.="    <option value=\"$value\" ";
1.253     albertel 1146:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1147:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1148:     }
                   1149:     $result .= "</select>\n";
                   1150:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1151:     $result .= $middletext;
                   1152:     $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
                   1153:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1154:     
                   1155:     my @secondorder = sort(keys(%select2));
                   1156:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1157:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1158:     }
                   1159:     foreach my $value (@secondorder) {
1.36      matthew  1160:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1161:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1162:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1163:     }
                   1164:     $result .= "</select>\n";
                   1165:     #    return $debug;
                   1166:     return $result;
                   1167: }   #  end of sub linked_select_forms {
                   1168: 
1.45      matthew  1169: =pod
1.44      bowersj2 1170: 
1.973     raeburn  1171: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1172: 
1.112     bowersj2 1173: Returns a string corresponding to an HTML link to the given help
                   1174: $topic, where $topic corresponds to the name of a .tex file in
                   1175: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1176: spaces. 
                   1177: 
                   1178: $text will optionally be linked to the same topic, allowing you to
                   1179: link text in addition to the graphic. If you do not want to link
                   1180: text, but wish to specify one of the later parameters, pass an
                   1181: empty string. 
                   1182: 
                   1183: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1184: the link will not open a new window. If false, the link will open
                   1185: a new window using Javascript. (Default is false.) 
                   1186: 
                   1187: $width and $height are optional numerical parameters that will
                   1188: override the width and height of the popped up window, which may
1.973     raeburn  1189: be useful for certain help topics with big pictures included.
                   1190: 
                   1191: $imgid is the id of the img tag used for the help icon. This may be
                   1192: used in a javascript call to switch the image src.  See 
                   1193: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1194: 
                   1195: =cut
                   1196: 
                   1197: sub help_open_topic {
1.973     raeburn  1198:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1199:     $text = "" if (not defined $text);
1.44      bowersj2 1200:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1201:     $width = 500 if (not defined $width);
1.44      bowersj2 1202:     $height = 400 if (not defined $height);
                   1203:     my $filename = $topic;
                   1204:     $filename =~ s/ /_/g;
                   1205: 
1.48      bowersj2 1206:     my $template = "";
                   1207:     my $link;
1.572     banghart 1208:     
1.159     www      1209:     $topic=~s/\W/\_/g;
1.44      bowersj2 1210: 
1.572     banghart 1211:     if (!$stayOnPage) {
1.1033    www      1212: 	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037    www      1213:     } elsif ($stayOnPage eq 'popup') {
                   1214:         $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 1215:     } else {
1.48      bowersj2 1216: 	$link = "/adm/help/${filename}.hlp";
                   1217:     }
                   1218: 
                   1219:     # Add the text
1.755     neumanie 1220:     if ($text ne "") {	
1.763     bisitz   1221: 	$template.='<span class="LC_help_open_topic">'
                   1222:                   .'<a target="_top" href="'.$link.'">'
                   1223:                   .$text.'</a>';
1.48      bowersj2 1224:     }
                   1225: 
1.763     bisitz   1226:     # (Always) Add the graphic
1.179     matthew  1227:     my $title = &mt('Online Help');
1.667     raeburn  1228:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1229:     if ($imgid ne '') {
                   1230:         $imgid = ' id="'.$imgid.'"';
                   1231:     }
1.763     bisitz   1232:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1233:               .'<img src="'.$helpicon.'" border="0"'
                   1234:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1235:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1236:               .' /></a>';
                   1237:     if ($text ne "") {	
                   1238:         $template.='</span>';
                   1239:     }
1.44      bowersj2 1240:     return $template;
                   1241: 
1.106     bowersj2 1242: }
                   1243: 
                   1244: # This is a quicky function for Latex cheatsheet editing, since it 
                   1245: # appears in at least four places
                   1246: sub helpLatexCheatsheet {
1.1037    www      1247:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1248:     my $out;
1.106     bowersj2 1249:     my $addOther = '';
1.732     raeburn  1250:     if ($topic) {
1.1037    www      1251: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1252:     }
                   1253:     $out = '<span>' # Start cheatsheet
                   1254: 	  .$addOther
                   1255:           .'<span>'
1.1037    www      1256: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1257: 	  .'</span> <span>'
1.1037    www      1258: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1259: 	  .'</span>';
1.732     raeburn  1260:     unless ($not_author) {
1.763     bisitz   1261:         $out .= ' <span>'
1.1037    www      1262: 	       .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.763     bisitz   1263: 	       .'</span>';
1.732     raeburn  1264:     }
1.763     bisitz   1265:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1266:     return $out;
1.172     www      1267: }
                   1268: 
1.430     albertel 1269: sub general_help {
                   1270:     my $helptopic='Student_Intro';
                   1271:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1272: 	$helptopic='Authoring_Intro';
1.907     raeburn  1273:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1274: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1275:     } elsif ($env{'request.role'}=~/^dc/) {
                   1276:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1277:     }
                   1278:     return $helptopic;
                   1279: }
                   1280: 
                   1281: sub update_help_link {
                   1282:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1283:     my $origurl = $ENV{'REQUEST_URI'};
                   1284:     $origurl=~s|^/~|/priv/|;
                   1285:     my $timestamp = time;
                   1286:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1287:         $$datum = &escape($$datum);
                   1288:     }
                   1289: 
                   1290:     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";
                   1291:     my $output .= <<"ENDOUTPUT";
                   1292: <script type="text/javascript">
1.824     bisitz   1293: // <![CDATA[
1.430     albertel 1294: banner_link = '$banner_link';
1.824     bisitz   1295: // ]]>
1.430     albertel 1296: </script>
                   1297: ENDOUTPUT
                   1298:     return $output;
                   1299: }
                   1300: 
                   1301: # now just updates the help link and generates a blue icon
1.193     raeburn  1302: sub help_open_menu {
1.430     albertel 1303:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1304: 	= @_;    
1.949     droeschl 1305:     $stayOnPage = 1;
1.430     albertel 1306:     my $output;
                   1307:     if ($component_help) {
                   1308: 	if (!$text) {
                   1309: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1310: 				       $width,$height);
                   1311: 	} else {
                   1312: 	    my $help_text;
                   1313: 	    $help_text=&unescape($topic);
                   1314: 	    $output='<table><tr><td>'.
                   1315: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1316: 				 $width,$height).'</td></tr></table>';
                   1317: 	}
                   1318:     }
                   1319:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1320:     return $output.$banner_link;
                   1321: }
                   1322: 
                   1323: sub top_nav_help {
                   1324:     my ($text) = @_;
1.436     albertel 1325:     $text = &mt($text);
1.949     droeschl 1326:     my $stay_on_page = 1;
                   1327: 
1.572     banghart 1328:     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436     albertel 1329: 	                     : "javascript:helpMenu('open')";
1.572     banghart 1330:     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436     albertel 1331: 
1.201     raeburn  1332:     my $title = &mt('Get help');
1.436     albertel 1333: 
                   1334:     return <<"END";
                   1335: $banner_link
                   1336:  <a href="$link" title="$title">$text</a>
                   1337: END
                   1338: }
                   1339: 
                   1340: sub help_menu_js {
                   1341:     my ($text) = @_;
1.949     droeschl 1342:     my $stayOnPage = 1;
1.436     albertel 1343:     my $width = 620;
                   1344:     my $height = 600;
1.430     albertel 1345:     my $helptopic=&general_help();
                   1346:     my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1347:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1348:     my $start_page =
                   1349:         &Apache::loncommon::start_page('Help Menu', undef,
                   1350: 				       {'frameset'    => 1,
                   1351: 					'js_ready'    => 1,
                   1352: 					'add_entries' => {
                   1353: 					    'border' => '0',
1.579     raeburn  1354: 					    'rows'   => "110,*",},});
1.331     albertel 1355:     my $end_page =
                   1356:         &Apache::loncommon::end_page({'frameset' => 1,
                   1357: 				      'js_ready' => 1,});
                   1358: 
1.436     albertel 1359:     my $template .= <<"ENDTEMPLATE";
                   1360: <script type="text/javascript">
1.877     bisitz   1361: // <![CDATA[
1.253     albertel 1362: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1363: var banner_link = '';
1.243     raeburn  1364: function helpMenu(target) {
                   1365:     var caller = this;
                   1366:     if (target == 'open') {
                   1367:         var newWindow = null;
                   1368:         try {
1.262     albertel 1369:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1370:         }
                   1371:         catch(error) {
                   1372:             writeHelp(caller);
                   1373:             return;
                   1374:         }
                   1375:         if (newWindow) {
                   1376:             caller = newWindow;
                   1377:         }
1.193     raeburn  1378:     }
1.243     raeburn  1379:     writeHelp(caller);
                   1380:     return;
                   1381: }
                   1382: function writeHelp(caller) {
1.1072    raeburn  1383:     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  1384:     caller.document.close()
                   1385:     caller.focus()
1.193     raeburn  1386: }
1.877     bisitz   1387: // END LON-CAPA Internal -->
1.253     albertel 1388: // ]]>
1.436     albertel 1389: </script>
1.193     raeburn  1390: ENDTEMPLATE
                   1391:     return $template;
                   1392: }
                   1393: 
1.172     www      1394: sub help_open_bug {
                   1395:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1396:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1397:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1398:     $text = "" if (not defined $text);
                   1399: 	$stayOnPage=1;
1.184     albertel 1400:     $width = 600 if (not defined $width);
                   1401:     $height = 600 if (not defined $height);
1.172     www      1402: 
                   1403:     $topic=~s/\W+/\+/g;
                   1404:     my $link='';
                   1405:     my $template='';
1.379     albertel 1406:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1407: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1408:     if (!$stayOnPage)
                   1409:     {
                   1410: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1411:     }
                   1412:     else
                   1413:     {
                   1414: 	$link = $url;
                   1415:     }
                   1416:     # Add the text
                   1417:     if ($text ne "")
                   1418:     {
                   1419: 	$template .= 
                   1420:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1421:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1422:     }
                   1423: 
                   1424:     # Add the graphic
1.179     matthew  1425:     my $title = &mt('Report a Bug');
1.215     albertel 1426:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1427:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1428:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1429: ENDTEMPLATE
                   1430:     if ($text ne '') { $template.='</td></tr></table>' };
                   1431:     return $template;
                   1432: 
                   1433: }
                   1434: 
                   1435: sub help_open_faq {
                   1436:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1437:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1438:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1439:     $text = "" if (not defined $text);
                   1440: 	$stayOnPage=1;
                   1441:     $width = 350 if (not defined $width);
                   1442:     $height = 400 if (not defined $height);
                   1443: 
                   1444:     $topic=~s/\W+/\+/g;
                   1445:     my $link='';
                   1446:     my $template='';
                   1447:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1448:     if (!$stayOnPage)
                   1449:     {
                   1450: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1451:     }
                   1452:     else
                   1453:     {
                   1454: 	$link = $url;
                   1455:     }
                   1456: 
                   1457:     # Add the text
                   1458:     if ($text ne "")
                   1459:     {
                   1460: 	$template .= 
1.173     www      1461:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1462:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1463:     }
                   1464: 
                   1465:     # Add the graphic
1.179     matthew  1466:     my $title = &mt('View the FAQ');
1.215     albertel 1467:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1468:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1469:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1470: ENDTEMPLATE
                   1471:     if ($text ne '') { $template.='</td></tr></table>' };
                   1472:     return $template;
                   1473: 
1.44      bowersj2 1474: }
1.37      matthew  1475: 
1.180     matthew  1476: ###############################################################
                   1477: ###############################################################
                   1478: 
1.45      matthew  1479: =pod
                   1480: 
1.648     raeburn  1481: =item * &change_content_javascript():
1.256     matthew  1482: 
                   1483: This and the next function allow you to create small sections of an
                   1484: otherwise static HTML page that you can update on the fly with
                   1485: Javascript, even in Netscape 4.
                   1486: 
                   1487: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1488: must be written to the HTML page once. It will prove the Javascript
                   1489: function "change(name, content)". Calling the change function with the
                   1490: name of the section 
                   1491: you want to update, matching the name passed to C<changable_area>, and
                   1492: the new content you want to put in there, will put the content into
                   1493: that area.
                   1494: 
                   1495: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1496: to contain room for the original contents. You need to "make space"
                   1497: for whatever changes you wish to make, and be B<sure> to check your
                   1498: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1499: it's adequate for updating a one-line status display, but little more.
                   1500: This script will set the space to 100% width, so you only need to
                   1501: worry about height in Netscape 4.
                   1502: 
                   1503: Modern browsers are much less limiting, and if you can commit to the
                   1504: user not using Netscape 4, this feature may be used freely with
                   1505: pretty much any HTML.
                   1506: 
                   1507: =cut
                   1508: 
                   1509: sub change_content_javascript {
                   1510:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1511:     if ($env{'browser.type'} eq 'netscape' &&
                   1512: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1513: 	return (<<NETSCAPE4);
                   1514: 	function change(name, content) {
                   1515: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1516: 	    doc.open();
                   1517: 	    doc.write(content);
                   1518: 	    doc.close();
                   1519: 	}
                   1520: NETSCAPE4
                   1521:     } else {
                   1522: 	# Otherwise, we need to use semi-standards-compliant code
                   1523: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1524: 	# is really scary, and every useful browser supports it
                   1525: 	return (<<DOMBASED);
                   1526: 	function change(name, content) {
                   1527: 	    element = document.getElementById(name);
                   1528: 	    element.innerHTML = content;
                   1529: 	}
                   1530: DOMBASED
                   1531:     }
                   1532: }
                   1533: 
                   1534: =pod
                   1535: 
1.648     raeburn  1536: =item * &changable_area($name,$origContent):
1.256     matthew  1537: 
                   1538: This provides a "changable area" that can be modified on the fly via
                   1539: the Javascript code provided in C<change_content_javascript>. $name is
                   1540: the name you will use to reference the area later; do not repeat the
                   1541: same name on a given HTML page more then once. $origContent is what
                   1542: the area will originally contain, which can be left blank.
                   1543: 
                   1544: =cut
                   1545: 
                   1546: sub changable_area {
                   1547:     my ($name, $origContent) = @_;
                   1548: 
1.258     albertel 1549:     if ($env{'browser.type'} eq 'netscape' &&
                   1550: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1551: 	# If this is netscape 4, we need to use the Layer tag
                   1552: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1553:     } else {
                   1554: 	return "<span id='$name'>$origContent</span>";
                   1555:     }
                   1556: }
                   1557: 
                   1558: =pod
                   1559: 
1.648     raeburn  1560: =item * &viewport_geometry_js 
1.590     raeburn  1561: 
                   1562: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1563: 
                   1564: =cut
                   1565: 
                   1566: 
                   1567: sub viewport_geometry_js { 
                   1568:     return <<"GEOMETRY";
                   1569: var Geometry = {};
                   1570: function init_geometry() {
                   1571:     if (Geometry.init) { return };
                   1572:     Geometry.init=1;
                   1573:     if (window.innerHeight) {
                   1574:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1575:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1576:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1577:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1578:     }
                   1579:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1580:         Geometry.getViewportHeight =
                   1581:             function() { return document.documentElement.clientHeight; };
                   1582:         Geometry.getViewportWidth =
                   1583:             function() { return document.documentElement.clientWidth; };
                   1584: 
                   1585:         Geometry.getHorizontalScroll =
                   1586:             function() { return document.documentElement.scrollLeft; };
                   1587:         Geometry.getVerticalScroll =
                   1588:             function() { return document.documentElement.scrollTop; };
                   1589:     }
                   1590:     else if (document.body.clientHeight) {
                   1591:         Geometry.getViewportHeight =
                   1592:             function() { return document.body.clientHeight; };
                   1593:         Geometry.getViewportWidth =
                   1594:             function() { return document.body.clientWidth; };
                   1595:         Geometry.getHorizontalScroll =
                   1596:             function() { return document.body.scrollLeft; };
                   1597:         Geometry.getVerticalScroll =
                   1598:             function() { return document.body.scrollTop; };
                   1599:     }
                   1600: }
                   1601: 
                   1602: GEOMETRY
                   1603: }
                   1604: 
                   1605: =pod
                   1606: 
1.648     raeburn  1607: =item * &viewport_size_js()
1.590     raeburn  1608: 
                   1609: 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. 
                   1610: 
                   1611: =cut
                   1612: 
                   1613: sub viewport_size_js {
                   1614:     my $geometry = &viewport_geometry_js();
                   1615:     return <<"DIMS";
                   1616: 
                   1617: $geometry
                   1618: 
                   1619: function getViewportDims(width,height) {
                   1620:     init_geometry();
                   1621:     width.value = Geometry.getViewportWidth();
                   1622:     height.value = Geometry.getViewportHeight();
                   1623:     return;
                   1624: }
                   1625: 
                   1626: DIMS
                   1627: }
                   1628: 
                   1629: =pod
                   1630: 
1.648     raeburn  1631: =item * &resize_textarea_js()
1.565     albertel 1632: 
                   1633: emits the needed javascript to resize a textarea to be as big as possible
                   1634: 
                   1635: creates a function resize_textrea that takes two IDs first should be
                   1636: the id of the element to resize, second should be the id of a div that
                   1637: surrounds everything that comes after the textarea, this routine needs
                   1638: to be attached to the <body> for the onload and onresize events.
                   1639: 
1.648     raeburn  1640: =back
1.565     albertel 1641: 
                   1642: =cut
                   1643: 
                   1644: sub resize_textarea_js {
1.590     raeburn  1645:     my $geometry = &viewport_geometry_js();
1.565     albertel 1646:     return <<"RESIZE";
                   1647:     <script type="text/javascript">
1.824     bisitz   1648: // <![CDATA[
1.590     raeburn  1649: $geometry
1.565     albertel 1650: 
1.588     albertel 1651: function getX(element) {
                   1652:     var x = 0;
                   1653:     while (element) {
                   1654: 	x += element.offsetLeft;
                   1655: 	element = element.offsetParent;
                   1656:     }
                   1657:     return x;
                   1658: }
                   1659: function getY(element) {
                   1660:     var y = 0;
                   1661:     while (element) {
                   1662: 	y += element.offsetTop;
                   1663: 	element = element.offsetParent;
                   1664:     }
                   1665:     return y;
                   1666: }
                   1667: 
                   1668: 
1.565     albertel 1669: function resize_textarea(textarea_id,bottom_id) {
                   1670:     init_geometry();
                   1671:     var textarea        = document.getElementById(textarea_id);
                   1672:     //alert(textarea);
                   1673: 
1.588     albertel 1674:     var textarea_top    = getY(textarea);
1.565     albertel 1675:     var textarea_height = textarea.offsetHeight;
                   1676:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1677:     var bottom_top      = getY(bottom);
1.565     albertel 1678:     var bottom_height   = bottom.offsetHeight;
                   1679:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1680:     var fudge           = 23;
1.565     albertel 1681:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1682:     if (new_height < 300) {
                   1683: 	new_height = 300;
                   1684:     }
                   1685:     textarea.style.height=new_height+'px';
                   1686: }
1.824     bisitz   1687: // ]]>
1.565     albertel 1688: </script>
                   1689: RESIZE
                   1690: 
                   1691: }
                   1692: 
                   1693: =pod
                   1694: 
1.256     matthew  1695: =head1 Excel and CSV file utility routines
                   1696: 
                   1697: =over 4
                   1698: 
                   1699: =cut
                   1700: 
                   1701: ###############################################################
                   1702: ###############################################################
                   1703: 
                   1704: =pod
                   1705: 
1.648     raeburn  1706: =item * &csv_translate($text) 
1.37      matthew  1707: 
1.185     www      1708: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1709: format.
                   1710: 
                   1711: =cut
                   1712: 
1.180     matthew  1713: ###############################################################
                   1714: ###############################################################
1.37      matthew  1715: sub csv_translate {
                   1716:     my $text = shift;
                   1717:     $text =~ s/\"/\"\"/g;
1.209     albertel 1718:     $text =~ s/\n/ /g;
1.37      matthew  1719:     return $text;
                   1720: }
1.180     matthew  1721: 
                   1722: ###############################################################
                   1723: ###############################################################
                   1724: 
                   1725: =pod
                   1726: 
1.648     raeburn  1727: =item * &define_excel_formats()
1.180     matthew  1728: 
                   1729: Define some commonly used Excel cell formats.
                   1730: 
                   1731: Currently supported formats:
                   1732: 
                   1733: =over 4
                   1734: 
                   1735: =item header
                   1736: 
                   1737: =item bold
                   1738: 
                   1739: =item h1
                   1740: 
                   1741: =item h2
                   1742: 
                   1743: =item h3
                   1744: 
1.256     matthew  1745: =item h4
                   1746: 
                   1747: =item i
                   1748: 
1.180     matthew  1749: =item date
                   1750: 
                   1751: =back
                   1752: 
                   1753: Inputs: $workbook
                   1754: 
                   1755: Returns: $format, a hash reference.
                   1756: 
1.1057    foxr     1757: 
1.180     matthew  1758: =cut
                   1759: 
                   1760: ###############################################################
                   1761: ###############################################################
                   1762: sub define_excel_formats {
                   1763:     my ($workbook) = @_;
                   1764:     my $format;
                   1765:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1766:                                                 bottom    => 1,
                   1767:                                                 align     => 'center');
                   1768:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1769:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1770:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1771:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1772:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1773:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1774:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1775:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1776:     return $format;
                   1777: }
                   1778: 
                   1779: ###############################################################
                   1780: ###############################################################
1.113     bowersj2 1781: 
                   1782: =pod
                   1783: 
1.648     raeburn  1784: =item * &create_workbook()
1.255     matthew  1785: 
                   1786: Create an Excel worksheet.  If it fails, output message on the
                   1787: request object and return undefs.
                   1788: 
                   1789: Inputs: Apache request object
                   1790: 
                   1791: Returns (undef) on failure, 
                   1792:     Excel worksheet object, scalar with filename, and formats 
                   1793:     from &Apache::loncommon::define_excel_formats on success
                   1794: 
                   1795: =cut
                   1796: 
                   1797: ###############################################################
                   1798: ###############################################################
                   1799: sub create_workbook {
                   1800:     my ($r) = @_;
                   1801:         #
                   1802:     # Create the excel spreadsheet
                   1803:     my $filename = '/prtspool/'.
1.258     albertel 1804:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1805:         time.'_'.rand(1000000000).'.xls';
                   1806:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1807:     if (! defined($workbook)) {
                   1808:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1809:         $r->print(
                   1810:             '<p class="LC_error">'
                   1811:            .&mt('Problems occurred in creating the new Excel file.')
                   1812:            .' '.&mt('This error has been logged.')
                   1813:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1814:            .'</p>'
                   1815:         );
1.255     matthew  1816:         return (undef);
                   1817:     }
                   1818:     #
1.1014    foxr     1819:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  1820:     #
                   1821:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1822:     return ($workbook,$filename,$format);
                   1823: }
                   1824: 
                   1825: ###############################################################
                   1826: ###############################################################
                   1827: 
                   1828: =pod
                   1829: 
1.648     raeburn  1830: =item * &create_text_file()
1.113     bowersj2 1831: 
1.542     raeburn  1832: Create a file to write to and eventually make available to the user.
1.256     matthew  1833: If file creation fails, outputs an error message on the request object and 
                   1834: return undefs.
1.113     bowersj2 1835: 
1.256     matthew  1836: Inputs: Apache request object, and file suffix
1.113     bowersj2 1837: 
1.256     matthew  1838: Returns (undef) on failure, 
                   1839:     Filehandle and filename on success.
1.113     bowersj2 1840: 
                   1841: =cut
                   1842: 
1.256     matthew  1843: ###############################################################
                   1844: ###############################################################
                   1845: sub create_text_file {
                   1846:     my ($r,$suffix) = @_;
                   1847:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1848:     my $fh;
                   1849:     my $filename = '/prtspool/'.
1.258     albertel 1850:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1851:         time.'_'.rand(1000000000).'.'.$suffix;
                   1852:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1853:     if (! defined($fh)) {
                   1854:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1855:         $r->print(
                   1856:             '<p class="LC_error">'
                   1857:            .&mt('Problems occurred in creating the output file.')
                   1858:            .' '.&mt('This error has been logged.')
                   1859:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1860:            .'</p>'
                   1861:         );
1.113     bowersj2 1862:     }
1.256     matthew  1863:     return ($fh,$filename)
1.113     bowersj2 1864: }
                   1865: 
                   1866: 
1.256     matthew  1867: =pod 
1.113     bowersj2 1868: 
                   1869: =back
                   1870: 
                   1871: =cut
1.37      matthew  1872: 
                   1873: ###############################################################
1.33      matthew  1874: ##        Home server <option> list generating code          ##
                   1875: ###############################################################
1.35      matthew  1876: 
1.169     www      1877: # ------------------------------------------
                   1878: 
                   1879: sub domain_select {
                   1880:     my ($name,$value,$multiple)=@_;
                   1881:     my %domains=map { 
1.514     albertel 1882: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1883:     } &Apache::lonnet::all_domains();
1.169     www      1884:     if ($multiple) {
                   1885: 	$domains{''}=&mt('Any domain');
1.550     albertel 1886: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1887: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1888:     } else {
1.550     albertel 1889: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1890: 	return &select_form($name,$value,\%domains);
1.169     www      1891:     }
                   1892: }
                   1893: 
1.282     albertel 1894: #-------------------------------------------
                   1895: 
                   1896: =pod
                   1897: 
1.519     raeburn  1898: =head1 Routines for form select boxes
                   1899: 
                   1900: =over 4
                   1901: 
1.648     raeburn  1902: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1903: 
                   1904: Returns a string containing a <select> element int multiple mode
                   1905: 
                   1906: 
                   1907: Args:
                   1908:   $name - name of the <select> element
1.506     raeburn  1909:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1910:   $size - number of rows long the select element is
1.283     albertel 1911:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1912:           (shown text should already have been &mt())
1.506     raeburn  1913:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1914: 
1.282     albertel 1915: =cut
                   1916: 
                   1917: #-------------------------------------------
1.169     www      1918: sub multiple_select_form {
1.284     albertel 1919:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1920:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1921:     my $output='';
1.191     matthew  1922:     if (! defined($size)) {
                   1923:         $size = 4;
1.283     albertel 1924:         if (scalar(keys(%$hash))<4) {
                   1925:             $size = scalar(keys(%$hash));
1.191     matthew  1926:         }
                   1927:     }
1.734     bisitz   1928:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1929:     my @order;
1.506     raeburn  1930:     if (ref($order) eq 'ARRAY')  {
                   1931:         @order = @{$order};
                   1932:     } else {
                   1933:         @order = sort(keys(%$hash));
1.501     banghart 1934:     }
                   1935:     if (exists($$hash{'select_form_order'})) {
                   1936:         @order = @{$$hash{'select_form_order'}};
                   1937:     }
                   1938:         
1.284     albertel 1939:     foreach my $key (@order) {
1.356     albertel 1940:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1941:         $output.='selected="selected" ' if ($selected{$key});
                   1942:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1943:     }
                   1944:     $output.="</select>\n";
                   1945:     return $output;
                   1946: }
                   1947: 
1.88      www      1948: #-------------------------------------------
                   1949: 
                   1950: =pod
                   1951: 
1.970     raeburn  1952: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      1953: 
                   1954: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  1955: allow a user to select options from a ref to a hash containing:
                   1956: option_name => displayed text. An optional $onchange can include
                   1957: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   1958: 
1.88      www      1959: See lonrights.pm for an example invocation and use.
                   1960: 
                   1961: =cut
                   1962: 
                   1963: #-------------------------------------------
                   1964: sub select_form {
1.970     raeburn  1965:     my ($def,$name,$hashref,$onchange) = @_;
                   1966:     return unless (ref($hashref) eq 'HASH');
                   1967:     if ($onchange) {
                   1968:         $onchange = ' onchange="'.$onchange.'"';
                   1969:     }
                   1970:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 1971:     my @keys;
1.970     raeburn  1972:     if (exists($hashref->{'select_form_order'})) {
                   1973: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 1974:     } else {
1.970     raeburn  1975: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 1976:     }
1.356     albertel 1977:     foreach my $key (@keys) {
                   1978:         $selectform.=
                   1979: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   1980:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  1981:                 ">".$hashref->{$key}."</option>\n";
1.88      www      1982:     }
                   1983:     $selectform.="</select>";
                   1984:     return $selectform;
                   1985: }
                   1986: 
1.475     www      1987: # For display filters
                   1988: 
                   1989: sub display_filter {
1.1074    raeburn  1990:     my ($context) = @_;
1.475     www      1991:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      1992:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  1993:     my $phraseinput = 'hidden';
                   1994:     my $includeinput = 'hidden';
                   1995:     my ($checked,$includetypestext);
                   1996:     if ($env{'form.displayfilter'} eq 'containing') {
                   1997:         $phraseinput = 'text'; 
                   1998:         if ($context eq 'parmslog') {
                   1999:             $includeinput = 'checkbox';
                   2000:             if ($env{'form.includetypes'}) {
                   2001:                 $checked = ' checked="checked"';
                   2002:             }
                   2003:             $includetypestext = &mt('Include parameter types');
                   2004:         }
                   2005:     } else {
                   2006:         $includetypestext = '&nbsp;';
                   2007:     }
                   2008:     my ($additional,$secondid,$thirdid);
                   2009:     if ($context eq 'parmslog') {
                   2010:         $additional = 
                   2011:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2012:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2013:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2014:             '</label>';
                   2015:         $secondid = 'includetypes';
                   2016:         $thirdid = 'includetypestext';
                   2017:     }
                   2018:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2019:                                                     '$secondid','$thirdid')";
                   2020:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2021: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2022: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2023: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2024:            &mt('Filter: [_1]',
1.477     www      2025: 	   &select_form($env{'form.displayfilter'},
                   2026: 			'displayfilter',
1.970     raeburn  2027: 			{'currentfolder' => 'Current folder/page',
1.477     www      2028: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2029: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2030: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2031:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2032:                          '" />'.$additional;
                   2033: }
                   2034: 
                   2035: sub display_filter_js {
                   2036:     my $includetext = &mt('Include parameter types');
                   2037:     return <<"ENDJS";
                   2038:   
                   2039: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2040:     var firstType = 'hidden';
                   2041:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2042:         firstType = 'text';
                   2043:     }
                   2044:     firstObject = document.getElementById(firstid);
                   2045:     if (typeof(firstObject) == 'object') {
                   2046:         if (firstObject.type != firstType) {
                   2047:             changeInputType(firstObject,firstType);
                   2048:         }
                   2049:     }
                   2050:     if (context == 'parmslog') {
                   2051:         var secondType = 'hidden';
                   2052:         if (firstType == 'text') {
                   2053:             secondType = 'checkbox';
                   2054:         }
                   2055:         secondObject = document.getElementById(secondid);  
                   2056:         if (typeof(secondObject) == 'object') {
                   2057:             if (secondObject.type != secondType) {
                   2058:                 changeInputType(secondObject,secondType);
                   2059:             }
                   2060:         }
                   2061:         var textItem = document.getElementById(thirdid);
                   2062:         var currtext = textItem.innerHTML;
                   2063:         var newtext;
                   2064:         if (firstType == 'text') {
                   2065:             newtext = '$includetext';
                   2066:         } else {
                   2067:             newtext = '&nbsp;';
                   2068:         }
                   2069:         if (currtext != newtext) {
                   2070:             textItem.innerHTML = newtext;
                   2071:         }
                   2072:     }
                   2073:     return;
                   2074: }
                   2075: 
                   2076: function changeInputType(oldObject,newType) {
                   2077:     var newObject = document.createElement('input');
                   2078:     newObject.type = newType;
                   2079:     if (oldObject.size) {
                   2080:         newObject.size = oldObject.size;
                   2081:     }
                   2082:     if (oldObject.value) {
                   2083:         newObject.value = oldObject.value;
                   2084:     }
                   2085:     if (oldObject.name) {
                   2086:         newObject.name = oldObject.name;
                   2087:     }
                   2088:     if (oldObject.id) {
                   2089:         newObject.id = oldObject.id;
                   2090:     }
                   2091:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2092:     return;
                   2093: }
                   2094: 
                   2095: ENDJS
1.475     www      2096: }
                   2097: 
1.167     www      2098: sub gradeleveldescription {
                   2099:     my $gradelevel=shift;
                   2100:     my %gradelevels=(0 => 'Not specified',
                   2101: 		     1 => 'Grade 1',
                   2102: 		     2 => 'Grade 2',
                   2103: 		     3 => 'Grade 3',
                   2104: 		     4 => 'Grade 4',
                   2105: 		     5 => 'Grade 5',
                   2106: 		     6 => 'Grade 6',
                   2107: 		     7 => 'Grade 7',
                   2108: 		     8 => 'Grade 8',
                   2109: 		     9 => 'Grade 9',
                   2110: 		     10 => 'Grade 10',
                   2111: 		     11 => 'Grade 11',
                   2112: 		     12 => 'Grade 12',
                   2113: 		     13 => 'Grade 13',
                   2114: 		     14 => '100 Level',
                   2115: 		     15 => '200 Level',
                   2116: 		     16 => '300 Level',
                   2117: 		     17 => '400 Level',
                   2118: 		     18 => 'Graduate Level');
                   2119:     return &mt($gradelevels{$gradelevel});
                   2120: }
                   2121: 
1.163     www      2122: sub select_level_form {
                   2123:     my ($deflevel,$name)=@_;
                   2124:     unless ($deflevel) { $deflevel=0; }
1.167     www      2125:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2126:     for (my $i=0; $i<=18; $i++) {
                   2127:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2128:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2129:                 ">".&gradeleveldescription($i)."</option>\n";
                   2130:     }
                   2131:     $selectform.="</select>";
                   2132:     return $selectform;
1.163     www      2133: }
1.167     www      2134: 
1.35      matthew  2135: #-------------------------------------------
                   2136: 
1.45      matthew  2137: =pod
                   2138: 
1.910     raeburn  2139: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms)
1.35      matthew  2140: 
                   2141: Returns a string containing a <select name='$name' size='1'> form to 
                   2142: allow a user to select the domain to preform an operation in.  
                   2143: See loncreateuser.pm for an example invocation and use.
                   2144: 
1.90      www      2145: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2146: selected");
                   2147: 
1.743     raeburn  2148: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2149: 
1.910     raeburn  2150: 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.
                   2151: 
                   2152: The optional $incdoms is a reference to an array of domains which will be the only available options. 
1.563     raeburn  2153: 
1.35      matthew  2154: =cut
                   2155: 
                   2156: #-------------------------------------------
1.34      matthew  2157: sub select_dom_form {
1.910     raeburn  2158:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms) = @_;
1.872     raeburn  2159:     if ($onchange) {
1.874     raeburn  2160:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2161:     }
1.910     raeburn  2162:     my @domains;
                   2163:     if (ref($incdoms) eq 'ARRAY') {
                   2164:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2165:     } else {
                   2166:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2167:     }
1.90      www      2168:     if ($includeempty) { @domains=('',@domains); }
1.743     raeburn  2169:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2170:     foreach my $dom (@domains) {
                   2171:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2172:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2173:         if ($showdomdesc) {
                   2174:             if ($dom ne '') {
                   2175:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2176:                 if ($domdesc ne '') {
                   2177:                     $selectdomain .= ' ('.$domdesc.')';
                   2178:                 }
                   2179:             } 
                   2180:         }
                   2181:         $selectdomain .= "</option>\n";
1.34      matthew  2182:     }
                   2183:     $selectdomain.="</select>";
                   2184:     return $selectdomain;
                   2185: }
                   2186: 
1.35      matthew  2187: #-------------------------------------------
                   2188: 
1.45      matthew  2189: =pod
                   2190: 
1.648     raeburn  2191: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2192: 
1.586     raeburn  2193: input: 4 arguments (two required, two optional) - 
                   2194:     $domain - domain of new user
                   2195:     $name - name of form element
                   2196:     $default - Value of 'default' causes a default item to be first 
                   2197:                             option, and selected by default. 
                   2198:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2199:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2200: output: returns 2 items: 
1.586     raeburn  2201: (a) form element which contains either:
                   2202:    (i) <select name="$name">
                   2203:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2204:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2205:        </select>
                   2206:        form item if there are multiple library servers in $domain, or
                   2207:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2208:        if there is only one library server in $domain.
                   2209: 
                   2210: (b) number of library servers found.
                   2211: 
                   2212: See loncreateuser.pm for example of use.
1.35      matthew  2213: 
                   2214: =cut
                   2215: 
                   2216: #-------------------------------------------
1.586     raeburn  2217: sub home_server_form_item {
                   2218:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2219:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2220:     my $result;
                   2221:     my $numlib = keys(%servers);
                   2222:     if ($numlib > 1) {
                   2223:         $result .= '<select name="'.$name.'" />'."\n";
                   2224:         if ($default) {
1.804     bisitz   2225:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2226:                        '</option>'."\n";
                   2227:         }
                   2228:         foreach my $hostid (sort(keys(%servers))) {
                   2229:             $result.= '<option value="'.$hostid.'">'.
                   2230: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2231:         }
                   2232:         $result .= '</select>'."\n";
                   2233:     } elsif ($numlib == 1) {
                   2234:         my $hostid;
                   2235:         foreach my $item (keys(%servers)) {
                   2236:             $hostid = $item;
                   2237:         }
                   2238:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2239:                    $hostid.'" />';
                   2240:                    if (!$hide) {
                   2241:                        $result .= $hostid.' '.$servers{$hostid};
                   2242:                    }
                   2243:                    $result .= "\n";
                   2244:     } elsif ($default) {
                   2245:         $result .= '<input type="hidden" name="'.$name.
                   2246:                    '" value="default" />';
                   2247:                    if (!$hide) {
                   2248:                        $result .= &mt('default');
                   2249:                    }
                   2250:                    $result .= "\n";
1.33      matthew  2251:     }
1.586     raeburn  2252:     return ($result,$numlib);
1.33      matthew  2253: }
1.112     bowersj2 2254: 
                   2255: =pod
                   2256: 
1.534     albertel 2257: =back 
                   2258: 
1.112     bowersj2 2259: =cut
1.87      matthew  2260: 
                   2261: ###############################################################
1.112     bowersj2 2262: ##                  Decoding User Agent                      ##
1.87      matthew  2263: ###############################################################
                   2264: 
                   2265: =pod
                   2266: 
1.112     bowersj2 2267: =head1 Decoding the User Agent
                   2268: 
                   2269: =over 4
                   2270: 
                   2271: =item * &decode_user_agent()
1.87      matthew  2272: 
                   2273: Inputs: $r
                   2274: 
                   2275: Outputs:
                   2276: 
                   2277: =over 4
                   2278: 
1.112     bowersj2 2279: =item * $httpbrowser
1.87      matthew  2280: 
1.112     bowersj2 2281: =item * $clientbrowser
1.87      matthew  2282: 
1.112     bowersj2 2283: =item * $clientversion
1.87      matthew  2284: 
1.112     bowersj2 2285: =item * $clientmathml
1.87      matthew  2286: 
1.112     bowersj2 2287: =item * $clientunicode
1.87      matthew  2288: 
1.112     bowersj2 2289: =item * $clientos
1.87      matthew  2290: 
                   2291: =back
                   2292: 
1.157     matthew  2293: =back 
                   2294: 
1.87      matthew  2295: =cut
                   2296: 
                   2297: ###############################################################
                   2298: ###############################################################
                   2299: sub decode_user_agent {
1.247     albertel 2300:     my ($r)=@_;
1.87      matthew  2301:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2302:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2303:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2304:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2305:     my $clientbrowser='unknown';
                   2306:     my $clientversion='0';
                   2307:     my $clientmathml='';
                   2308:     my $clientunicode='0';
                   2309:     for (my $i=0;$i<=$#browsertype;$i++) {
                   2310:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   2311: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2312: 	    $clientbrowser=$bname;
                   2313:             $httpbrowser=~/$vreg/i;
                   2314: 	    $clientversion=$1;
                   2315:             $clientmathml=($clientversion>=$minv);
                   2316:             $clientunicode=($clientversion>=$univ);
                   2317: 	}
                   2318:     }
                   2319:     my $clientos='unknown';
                   2320:     if (($httpbrowser=~/linux/i) ||
                   2321:         ($httpbrowser=~/unix/i) ||
                   2322:         ($httpbrowser=~/ux/i) ||
                   2323:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2324:     if (($httpbrowser=~/vax/i) ||
                   2325:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2326:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2327:     if (($httpbrowser=~/mac/i) ||
                   2328:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   2329:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   2330:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
                   2331:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   2332:             $clientunicode,$clientos,);
                   2333: }
                   2334: 
1.32      matthew  2335: ###############################################################
                   2336: ##    Authentication changing form generation subroutines    ##
                   2337: ###############################################################
                   2338: ##
                   2339: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2340: ## hash, and have reasonable default values.
                   2341: ##
                   2342: ##    formname = the name given in the <form> tag.
1.35      matthew  2343: #-------------------------------------------
                   2344: 
1.45      matthew  2345: =pod
                   2346: 
1.112     bowersj2 2347: =head1 Authentication Routines
                   2348: 
                   2349: =over 4
                   2350: 
1.648     raeburn  2351: =item * &authform_xxxxxx()
1.35      matthew  2352: 
                   2353: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2354: handle some of the conveniences required for authentication forms.  
                   2355: This is not an optimal method, but it works.  
                   2356: 
                   2357: =over 4
                   2358: 
1.112     bowersj2 2359: =item * authform_header
1.35      matthew  2360: 
1.112     bowersj2 2361: =item * authform_authorwarning
1.35      matthew  2362: 
1.112     bowersj2 2363: =item * authform_nochange
1.35      matthew  2364: 
1.112     bowersj2 2365: =item * authform_kerberos
1.35      matthew  2366: 
1.112     bowersj2 2367: =item * authform_internal
1.35      matthew  2368: 
1.112     bowersj2 2369: =item * authform_filesystem
1.35      matthew  2370: 
                   2371: =back
                   2372: 
1.648     raeburn  2373: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2374: 
1.35      matthew  2375: =cut
                   2376: 
                   2377: #-------------------------------------------
1.32      matthew  2378: sub authform_header{  
                   2379:     my %in = (
                   2380:         formname => 'cu',
1.80      albertel 2381:         kerb_def_dom => '',
1.32      matthew  2382:         @_,
                   2383:     );
                   2384:     $in{'formname'} = 'document.' . $in{'formname'};
                   2385:     my $result='';
1.80      albertel 2386: 
                   2387: #---------------------------------------------- Code for upper case translation
                   2388:     my $Javascript_toUpperCase;
                   2389:     unless ($in{kerb_def_dom}) {
                   2390:         $Javascript_toUpperCase =<<"END";
                   2391:         switch (choice) {
                   2392:            case 'krb': currentform.elements[choicearg].value =
                   2393:                currentform.elements[choicearg].value.toUpperCase();
                   2394:                break;
                   2395:            default:
                   2396:         }
                   2397: END
                   2398:     } else {
                   2399:         $Javascript_toUpperCase = "";
                   2400:     }
                   2401: 
1.165     raeburn  2402:     my $radioval = "'nochange'";
1.591     raeburn  2403:     if (defined($in{'curr_authtype'})) {
                   2404:         if ($in{'curr_authtype'} ne '') {
                   2405:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2406:         }
1.174     matthew  2407:     }
1.165     raeburn  2408:     my $argfield = 'null';
1.591     raeburn  2409:     if (defined($in{'mode'})) {
1.165     raeburn  2410:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2411:             if (defined($in{'curr_autharg'})) {
                   2412:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2413:                     $argfield = "'$in{'curr_autharg'}'";
                   2414:                 }
                   2415:             }
                   2416:         }
                   2417:     }
                   2418: 
1.32      matthew  2419:     $result.=<<"END";
                   2420: var current = new Object();
1.165     raeburn  2421: current.radiovalue = $radioval;
                   2422: current.argfield = $argfield;
1.32      matthew  2423: 
                   2424: function changed_radio(choice,currentform) {
                   2425:     var choicearg = choice + 'arg';
                   2426:     // If a radio button in changed, we need to change the argfield
                   2427:     if (current.radiovalue != choice) {
                   2428:         current.radiovalue = choice;
                   2429:         if (current.argfield != null) {
                   2430:             currentform.elements[current.argfield].value = '';
                   2431:         }
                   2432:         if (choice == 'nochange') {
                   2433:             current.argfield = null;
                   2434:         } else {
                   2435:             current.argfield = choicearg;
                   2436:             switch(choice) {
                   2437:                 case 'krb': 
                   2438:                     currentform.elements[current.argfield].value = 
                   2439:                         "$in{'kerb_def_dom'}";
                   2440:                 break;
                   2441:               default:
                   2442:                 break;
                   2443:             }
                   2444:         }
                   2445:     }
                   2446:     return;
                   2447: }
1.22      www      2448: 
1.32      matthew  2449: function changed_text(choice,currentform) {
                   2450:     var choicearg = choice + 'arg';
                   2451:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2452:         $Javascript_toUpperCase
1.32      matthew  2453:         // clear old field
                   2454:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2455:             currentform.elements[current.argfield].value = '';
                   2456:         }
                   2457:         current.argfield = choicearg;
                   2458:     }
                   2459:     set_auth_radio_buttons(choice,currentform);
                   2460:     return;
1.20      www      2461: }
1.32      matthew  2462: 
                   2463: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2464:     var numauthchoices = currentform.login.length;
                   2465:     if (typeof numauthchoices  == "undefined") {
                   2466:         return;
                   2467:     } 
1.32      matthew  2468:     var i=0;
1.986     raeburn  2469:     while (i < numauthchoices) {
1.32      matthew  2470:         if (currentform.login[i].value == newvalue) { break; }
                   2471:         i++;
                   2472:     }
1.986     raeburn  2473:     if (i == numauthchoices) {
1.32      matthew  2474:         return;
                   2475:     }
                   2476:     current.radiovalue = newvalue;
                   2477:     currentform.login[i].checked = true;
                   2478:     return;
                   2479: }
                   2480: END
                   2481:     return $result;
                   2482: }
                   2483: 
                   2484: sub authform_authorwarning{
                   2485:     my $result='';
1.144     matthew  2486:     $result='<i>'.
                   2487:         &mt('As a general rule, only authors or co-authors should be '.
                   2488:             'filesystem authenticated '.
                   2489:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2490:     return $result;
                   2491: }
                   2492: 
                   2493: sub authform_nochange{  
                   2494:     my %in = (
                   2495:               formname => 'document.cu',
                   2496:               kerb_def_dom => 'MSU.EDU',
                   2497:               @_,
                   2498:           );
1.586     raeburn  2499:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'}); 
                   2500:     my $result;
                   2501:     if (keys(%can_assign) == 0) {
                   2502:         $result = &mt('Under you current role you are not permitted to change login settings for this user');  
                   2503:     } else {
                   2504:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2505:                   '<input type="radio" name="login" value="nochange" '.
                   2506:                   'checked="checked" onclick="'.
1.281     albertel 2507:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2508: 	    '</label>';
1.586     raeburn  2509:     }
1.32      matthew  2510:     return $result;
                   2511: }
                   2512: 
1.591     raeburn  2513: sub authform_kerberos {
1.32      matthew  2514:     my %in = (
                   2515:               formname => 'document.cu',
                   2516:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2517:               kerb_def_auth => 'krb4',
1.32      matthew  2518:               @_,
                   2519:               );
1.586     raeburn  2520:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2521:         $autharg,$jscall);
                   2522:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.80      albertel 2523:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2524:        $check5 = ' checked="checked"';
1.80      albertel 2525:     } else {
1.772     bisitz   2526:        $check4 = ' checked="checked"';
1.80      albertel 2527:     }
1.165     raeburn  2528:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2529:     if (defined($in{'curr_authtype'})) {
                   2530:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2531:             $krbcheck = ' checked="checked"';
1.623     raeburn  2532:             if (defined($in{'mode'})) {
                   2533:                 if ($in{'mode'} eq 'modifyuser') {
                   2534:                     $krbcheck = '';
                   2535:                 }
                   2536:             }
1.591     raeburn  2537:             if (defined($in{'curr_kerb_ver'})) {
                   2538:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2539:                     $check5 = ' checked="checked"';
1.591     raeburn  2540:                     $check4 = '';
                   2541:                 } else {
1.772     bisitz   2542:                     $check4 = ' checked="checked"';
1.591     raeburn  2543:                     $check5 = '';
                   2544:                 }
1.586     raeburn  2545:             }
1.591     raeburn  2546:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2547:                 $krbarg = $in{'curr_autharg'};
                   2548:             }
1.586     raeburn  2549:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2550:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2551:                     $result = 
                   2552:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2553:         $in{'curr_autharg'},$krbver);
                   2554:                 } else {
                   2555:                     $result =
                   2556:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2557:                 }
                   2558:                 return $result; 
                   2559:             }
                   2560:         }
                   2561:     } else {
                   2562:         if ($authnum == 1) {
1.784     bisitz   2563:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2564:         }
                   2565:     }
1.586     raeburn  2566:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2567:         return;
1.587     raeburn  2568:     } elsif ($authtype eq '') {
1.591     raeburn  2569:         if (defined($in{'mode'})) {
1.587     raeburn  2570:             if ($in{'mode'} eq 'modifycourse') {
                   2571:                 if ($authnum == 1) {
1.784     bisitz   2572:                     $authtype = '<input type="hidden" name="login" value="krb" />';
1.587     raeburn  2573:                 }
                   2574:             }
                   2575:         }
1.586     raeburn  2576:     }
                   2577:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2578:     if ($authtype eq '') {
                   2579:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2580:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2581:                     $krbcheck.' />';
                   2582:     }
                   2583:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
                   2584:         ($can_assign{'krb4'} && !$can_assign{'krb5'} && 
                   2585:          $in{'curr_authtype'} eq 'krb5') ||
                   2586:         (!$can_assign{'krb4'} && $can_assign{'krb5'} && 
                   2587:          $in{'curr_authtype'} eq 'krb4')) {
                   2588:         $result .= &mt
1.144     matthew  2589:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2590:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2591:          '<label>'.$authtype,
1.281     albertel 2592:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2593:              'value="'.$krbarg.'" '.
1.144     matthew  2594:              'onchange="'.$jscall.'" />',
1.281     albertel 2595:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2596:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2597: 	 '</label>');
1.586     raeburn  2598:     } elsif ($can_assign{'krb4'}) {
                   2599:         $result .= &mt
                   2600:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2601:          '[_3] Version 4 [_4]',
                   2602:          '<label>'.$authtype,
                   2603:          '</label><input type="text" size="10" name="krbarg" '.
                   2604:              'value="'.$krbarg.'" '.
                   2605:              'onchange="'.$jscall.'" />',
                   2606:          '<label><input type="hidden" name="krbver" value="4" />',
                   2607:          '</label>');
                   2608:     } elsif ($can_assign{'krb5'}) {
                   2609:         $result .= &mt
                   2610:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2611:          '[_3] Version 5 [_4]',
                   2612:          '<label>'.$authtype,
                   2613:          '</label><input type="text" size="10" name="krbarg" '.
                   2614:              'value="'.$krbarg.'" '.
                   2615:              'onchange="'.$jscall.'" />',
                   2616:          '<label><input type="hidden" name="krbver" value="5" />',
                   2617:          '</label>');
                   2618:     }
1.32      matthew  2619:     return $result;
                   2620: }
                   2621: 
                   2622: sub authform_internal{  
1.586     raeburn  2623:     my %in = (
1.32      matthew  2624:                 formname => 'document.cu',
                   2625:                 kerb_def_dom => 'MSU.EDU',
                   2626:                 @_,
                   2627:                 );
1.586     raeburn  2628:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
                   2629:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2630:     if (defined($in{'curr_authtype'})) {
                   2631:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2632:             if ($can_assign{'int'}) {
1.772     bisitz   2633:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2634:                 if (defined($in{'mode'})) {
                   2635:                     if ($in{'mode'} eq 'modifyuser') {
                   2636:                         $intcheck = '';
                   2637:                     }
                   2638:                 }
1.591     raeburn  2639:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2640:                     $intarg = $in{'curr_autharg'};
                   2641:                 }
                   2642:             } else {
                   2643:                 $result = &mt('Currently internally authenticated.');
                   2644:                 return $result;
1.165     raeburn  2645:             }
                   2646:         }
1.586     raeburn  2647:     } else {
                   2648:         if ($authnum == 1) {
1.784     bisitz   2649:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2650:         }
                   2651:     }
                   2652:     if (!$can_assign{'int'}) {
                   2653:         return;
1.587     raeburn  2654:     } elsif ($authtype eq '') {
1.591     raeburn  2655:         if (defined($in{'mode'})) {
1.587     raeburn  2656:             if ($in{'mode'} eq 'modifycourse') {
                   2657:                 if ($authnum == 1) {
1.784     bisitz   2658:                     $authtype = '<input type="hidden" name="login" value="int" />';
1.587     raeburn  2659:                 }
                   2660:             }
                   2661:         }
1.165     raeburn  2662:     }
1.586     raeburn  2663:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2664:     if ($authtype eq '') {
                   2665:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2666:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2667:     }
1.605     bisitz   2668:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2669:                $intarg.'" onchange="'.$jscall.'" />';
                   2670:     $result = &mt
1.144     matthew  2671:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2672:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2673:     $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  2674:     return $result;
                   2675: }
                   2676: 
                   2677: sub authform_local{  
                   2678:     my %in = (
                   2679:               formname => 'document.cu',
                   2680:               kerb_def_dom => 'MSU.EDU',
                   2681:               @_,
                   2682:               );
1.586     raeburn  2683:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
                   2684:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2685:     if (defined($in{'curr_authtype'})) {
                   2686:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2687:             if ($can_assign{'loc'}) {
1.772     bisitz   2688:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2689:                 if (defined($in{'mode'})) {
                   2690:                     if ($in{'mode'} eq 'modifyuser') {
                   2691:                         $loccheck = '';
                   2692:                     }
                   2693:                 }
1.591     raeburn  2694:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2695:                     $locarg = $in{'curr_autharg'};
                   2696:                 }
                   2697:             } else {
                   2698:                 $result = &mt('Currently using local (institutional) authentication.');
                   2699:                 return $result;
1.165     raeburn  2700:             }
                   2701:         }
1.586     raeburn  2702:     } else {
                   2703:         if ($authnum == 1) {
1.784     bisitz   2704:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2705:         }
                   2706:     }
                   2707:     if (!$can_assign{'loc'}) {
                   2708:         return;
1.587     raeburn  2709:     } elsif ($authtype eq '') {
1.591     raeburn  2710:         if (defined($in{'mode'})) {
1.587     raeburn  2711:             if ($in{'mode'} eq 'modifycourse') {
                   2712:                 if ($authnum == 1) {
1.784     bisitz   2713:                     $authtype = '<input type="hidden" name="login" value="loc" />';
1.587     raeburn  2714:                 }
                   2715:             }
                   2716:         }
1.165     raeburn  2717:     }
1.586     raeburn  2718:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2719:     if ($authtype eq '') {
                   2720:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2721:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2722:                     $jscall.'" />';
                   2723:     }
                   2724:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2725:                $locarg.'" onchange="'.$jscall.'" />';
                   2726:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2727:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2728:     return $result;
                   2729: }
                   2730: 
                   2731: sub authform_filesystem{  
                   2732:     my %in = (
                   2733:               formname => 'document.cu',
                   2734:               kerb_def_dom => 'MSU.EDU',
                   2735:               @_,
                   2736:               );
1.586     raeburn  2737:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
                   2738:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2739:     if (defined($in{'curr_authtype'})) {
                   2740:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2741:             if ($can_assign{'fsys'}) {
1.772     bisitz   2742:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2743:                 if (defined($in{'mode'})) {
                   2744:                     if ($in{'mode'} eq 'modifyuser') {
                   2745:                         $fsyscheck = '';
                   2746:                     }
                   2747:                 }
1.586     raeburn  2748:             } else {
                   2749:                 $result = &mt('Currently Filesystem Authenticated.');
                   2750:                 return $result;
                   2751:             }           
                   2752:         }
                   2753:     } else {
                   2754:         if ($authnum == 1) {
1.784     bisitz   2755:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2756:         }
                   2757:     }
                   2758:     if (!$can_assign{'fsys'}) {
                   2759:         return;
1.587     raeburn  2760:     } elsif ($authtype eq '') {
1.591     raeburn  2761:         if (defined($in{'mode'})) {
1.587     raeburn  2762:             if ($in{'mode'} eq 'modifycourse') {
                   2763:                 if ($authnum == 1) {
1.784     bisitz   2764:                     $authtype = '<input type="hidden" name="login" value="fsys" />';
1.587     raeburn  2765:                 }
                   2766:             }
                   2767:         }
1.586     raeburn  2768:     }
                   2769:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2770:     if ($authtype eq '') {
                   2771:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2772:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2773:                     $jscall.'" />';
                   2774:     }
                   2775:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2776:                ' onchange="'.$jscall.'" />';
                   2777:     $result = &mt
1.144     matthew  2778:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2779:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2780:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2781:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2782:                   'onchange="'.$jscall.'" />');
1.32      matthew  2783:     return $result;
                   2784: }
                   2785: 
1.586     raeburn  2786: sub get_assignable_auth {
                   2787:     my ($dom) = @_;
                   2788:     if ($dom eq '') {
                   2789:         $dom = $env{'request.role.domain'};
                   2790:     }
                   2791:     my %can_assign = (
                   2792:                           krb4 => 1,
                   2793:                           krb5 => 1,
                   2794:                           int  => 1,
                   2795:                           loc  => 1,
                   2796:                      );
                   2797:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2798:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2799:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2800:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2801:             my $context;
                   2802:             if ($env{'request.role'} =~ /^au/) {
                   2803:                 $context = 'author';
                   2804:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2805:                 $context = 'domain';
                   2806:             } elsif ($env{'request.course.id'}) {
                   2807:                 $context = 'course';
                   2808:             }
                   2809:             if ($context) {
                   2810:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2811:                    %can_assign = %{$authhash->{$context}}; 
                   2812:                 }
                   2813:             }
                   2814:         }
                   2815:     }
                   2816:     my $authnum = 0;
                   2817:     foreach my $key (keys(%can_assign)) {
                   2818:         if ($can_assign{$key}) {
                   2819:             $authnum ++;
                   2820:         }
                   2821:     }
                   2822:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2823:         $authnum --;
                   2824:     }
                   2825:     return ($authnum,%can_assign);
                   2826: }
                   2827: 
1.80      albertel 2828: ###############################################################
                   2829: ##    Get Kerberos Defaults for Domain                 ##
                   2830: ###############################################################
                   2831: ##
                   2832: ## Returns default kerberos version and an associated argument
                   2833: ## as listed in file domain.tab. If not listed, provides
                   2834: ## appropriate default domain and kerberos version.
                   2835: ##
                   2836: #-------------------------------------------
                   2837: 
                   2838: =pod
                   2839: 
1.648     raeburn  2840: =item * &get_kerberos_defaults()
1.80      albertel 2841: 
                   2842: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2843: version and domain. If not found, it defaults to version 4 and the 
                   2844: domain of the server.
1.80      albertel 2845: 
1.648     raeburn  2846: =over 4
                   2847: 
1.80      albertel 2848: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2849: 
1.648     raeburn  2850: =back
                   2851: 
                   2852: =back
                   2853: 
1.80      albertel 2854: =cut
                   2855: 
                   2856: #-------------------------------------------
                   2857: sub get_kerberos_defaults {
                   2858:     my $domain=shift;
1.641     raeburn  2859:     my ($krbdef,$krbdefdom);
                   2860:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2861:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2862:         $krbdef = $domdefaults{'auth_def'};
                   2863:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2864:     } else {
1.80      albertel 2865:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2866:         my $krbdefdom=$1;
                   2867:         $krbdefdom=~tr/a-z/A-Z/;
                   2868:         $krbdef = "krb4";
                   2869:     }
                   2870:     return ($krbdef,$krbdefdom);
                   2871: }
1.112     bowersj2 2872: 
1.32      matthew  2873: 
1.46      matthew  2874: ###############################################################
                   2875: ##                Thesaurus Functions                        ##
                   2876: ###############################################################
1.20      www      2877: 
1.46      matthew  2878: =pod
1.20      www      2879: 
1.112     bowersj2 2880: =head1 Thesaurus Functions
                   2881: 
                   2882: =over 4
                   2883: 
1.648     raeburn  2884: =item * &initialize_keywords()
1.46      matthew  2885: 
                   2886: Initializes the package variable %Keywords if it is empty.  Uses the
                   2887: package variable $thesaurus_db_file.
                   2888: 
                   2889: =cut
                   2890: 
                   2891: ###################################################
                   2892: 
                   2893: sub initialize_keywords {
                   2894:     return 1 if (scalar keys(%Keywords));
                   2895:     # If we are here, %Keywords is empty, so fill it up
                   2896:     #   Make sure the file we need exists...
                   2897:     if (! -e $thesaurus_db_file) {
                   2898:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2899:                                  " failed because it does not exist");
                   2900:         return 0;
                   2901:     }
                   2902:     #   Set up the hash as a database
                   2903:     my %thesaurus_db;
                   2904:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2905:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2906:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2907:                                  $thesaurus_db_file);
                   2908:         return 0;
                   2909:     } 
                   2910:     #  Get the average number of appearances of a word.
                   2911:     my $avecount = $thesaurus_db{'average.count'};
                   2912:     #  Put keywords (those that appear > average) into %Keywords
                   2913:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2914:         my ($count,undef) = split /:/,$data;
                   2915:         $Keywords{$word}++ if ($count > $avecount);
                   2916:     }
                   2917:     untie %thesaurus_db;
                   2918:     # Remove special values from %Keywords.
1.356     albertel 2919:     foreach my $value ('total.count','average.count') {
                   2920:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2921:   }
1.46      matthew  2922:     return 1;
                   2923: }
                   2924: 
                   2925: ###################################################
                   2926: 
                   2927: =pod
                   2928: 
1.648     raeburn  2929: =item * &keyword($word)
1.46      matthew  2930: 
                   2931: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   2932: than the average number of times in the thesaurus database.  Calls 
                   2933: &initialize_keywords
                   2934: 
                   2935: =cut
                   2936: 
                   2937: ###################################################
1.20      www      2938: 
                   2939: sub keyword {
1.46      matthew  2940:     return if (!&initialize_keywords());
                   2941:     my $word=lc(shift());
                   2942:     $word=~s/\W//g;
                   2943:     return exists($Keywords{$word});
1.20      www      2944: }
1.46      matthew  2945: 
                   2946: ###############################################################
                   2947: 
                   2948: =pod 
1.20      www      2949: 
1.648     raeburn  2950: =item * &get_related_words()
1.46      matthew  2951: 
1.160     matthew  2952: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  2953: an array of words.  If the keyword is not in the thesaurus, an empty array
                   2954: will be returned.  The order of the words returned is determined by the
                   2955: database which holds them.
                   2956: 
                   2957: Uses global $thesaurus_db_file.
                   2958: 
1.1057    foxr     2959: 
1.46      matthew  2960: =cut
                   2961: 
                   2962: ###############################################################
                   2963: sub get_related_words {
                   2964:     my $keyword = shift;
                   2965:     my %thesaurus_db;
                   2966:     if (! -e $thesaurus_db_file) {
                   2967:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   2968:                                  "failed because the file does not exist");
                   2969:         return ();
                   2970:     }
                   2971:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2972:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2973:         return ();
                   2974:     } 
                   2975:     my @Words=();
1.429     www      2976:     my $count=0;
1.46      matthew  2977:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 2978: 	# The first element is the number of times
                   2979: 	# the word appears.  We do not need it now.
1.429     www      2980: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   2981: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   2982: 	my $threshold=$mostfrequentcount/10;
                   2983:         foreach my $possibleword (@RelatedWords) {
                   2984:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   2985:             if ($wordcount>$threshold) {
                   2986: 		push(@Words,$word);
                   2987:                 $count++;
                   2988:                 if ($count>10) { last; }
                   2989: 	    }
1.20      www      2990:         }
                   2991:     }
1.46      matthew  2992:     untie %thesaurus_db;
                   2993:     return @Words;
1.14      harris41 2994: }
1.46      matthew  2995: 
1.112     bowersj2 2996: =pod
                   2997: 
                   2998: =back
                   2999: 
                   3000: =cut
1.61      www      3001: 
                   3002: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3003: =pod
                   3004: 
1.112     bowersj2 3005: =head1 User Name Functions
                   3006: 
                   3007: =over 4
                   3008: 
1.648     raeburn  3009: =item * &plainname($uname,$udom,$first)
1.81      albertel 3010: 
1.112     bowersj2 3011: Takes a users logon name and returns it as a string in
1.226     albertel 3012: "first middle last generation" form 
                   3013: if $first is set to 'lastname' then it returns it as
                   3014: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3015: 
                   3016: =cut
1.61      www      3017: 
1.295     www      3018: 
1.81      albertel 3019: ###############################################################
1.61      www      3020: sub plainname {
1.226     albertel 3021:     my ($uname,$udom,$first)=@_;
1.537     albertel 3022:     return if (!defined($uname) || !defined($udom));
1.295     www      3023:     my %names=&getnames($uname,$udom);
1.226     albertel 3024:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3025: 					  $names{'middlename'},
                   3026: 					  $names{'lastname'},
                   3027: 					  $names{'generation'},$first);
                   3028:     $name=~s/^\s+//;
1.62      www      3029:     $name=~s/\s+$//;
                   3030:     $name=~s/\s+/ /g;
1.353     albertel 3031:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3032:     return $name;
1.61      www      3033: }
1.66      www      3034: 
                   3035: # -------------------------------------------------------------------- Nickname
1.81      albertel 3036: =pod
                   3037: 
1.648     raeburn  3038: =item * &nickname($uname,$udom)
1.81      albertel 3039: 
                   3040: Gets a users name and returns it as a string as
                   3041: 
                   3042: "&quot;nickname&quot;"
1.66      www      3043: 
1.81      albertel 3044: if the user has a nickname or
                   3045: 
                   3046: "first middle last generation"
                   3047: 
                   3048: if the user does not
                   3049: 
                   3050: =cut
1.66      www      3051: 
                   3052: sub nickname {
                   3053:     my ($uname,$udom)=@_;
1.537     albertel 3054:     return if (!defined($uname) || !defined($udom));
1.295     www      3055:     my %names=&getnames($uname,$udom);
1.68      albertel 3056:     my $name=$names{'nickname'};
1.66      www      3057:     if ($name) {
                   3058:        $name='&quot;'.$name.'&quot;'; 
                   3059:     } else {
                   3060:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3061: 	     $names{'lastname'}.' '.$names{'generation'};
                   3062:        $name=~s/\s+$//;
                   3063:        $name=~s/\s+/ /g;
                   3064:     }
                   3065:     return $name;
                   3066: }
                   3067: 
1.295     www      3068: sub getnames {
                   3069:     my ($uname,$udom)=@_;
1.537     albertel 3070:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3071:     if ($udom eq 'public' && $uname eq 'public') {
                   3072: 	return ('lastname' => &mt('Public'));
                   3073:     }
1.295     www      3074:     my $id=$uname.':'.$udom;
                   3075:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3076:     if ($cached) {
                   3077: 	return %{$names};
                   3078:     } else {
                   3079: 	my %loadnames=&Apache::lonnet::get('environment',
                   3080:                     ['firstname','middlename','lastname','generation','nickname'],
                   3081: 					 $udom,$uname);
                   3082: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3083: 	return %loadnames;
                   3084:     }
                   3085: }
1.61      www      3086: 
1.542     raeburn  3087: # -------------------------------------------------------------------- getemails
1.648     raeburn  3088: 
1.542     raeburn  3089: =pod
                   3090: 
1.648     raeburn  3091: =item * &getemails($uname,$udom)
1.542     raeburn  3092: 
                   3093: Gets a user's email information and returns it as a hash with keys:
                   3094: notification, critnotification, permanentemail
                   3095: 
                   3096: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3097: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3098:  
1.648     raeburn  3099: 
1.542     raeburn  3100: =cut
                   3101: 
1.648     raeburn  3102: 
1.466     albertel 3103: sub getemails {
                   3104:     my ($uname,$udom)=@_;
                   3105:     if ($udom eq 'public' && $uname eq 'public') {
                   3106: 	return;
                   3107:     }
1.467     www      3108:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3109:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3110:     my $id=$uname.':'.$udom;
                   3111:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3112:     if ($cached) {
                   3113: 	return %{$names};
                   3114:     } else {
                   3115: 	my %loadnames=&Apache::lonnet::get('environment',
                   3116:                     			   ['notification','critnotification',
                   3117: 					    'permanentemail'],
                   3118: 					   $udom,$uname);
                   3119: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3120: 	return %loadnames;
                   3121:     }
                   3122: }
                   3123: 
1.551     albertel 3124: sub flush_email_cache {
                   3125:     my ($uname,$udom)=@_;
                   3126:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3127:     if (!$uname) { $uname=$env{'user.name'};   }
                   3128:     return if ($udom eq 'public' && $uname eq 'public');
                   3129:     my $id=$uname.':'.$udom;
                   3130:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3131: }
                   3132: 
1.728     raeburn  3133: # -------------------------------------------------------------------- getlangs
                   3134: 
                   3135: =pod
                   3136: 
                   3137: =item * &getlangs($uname,$udom)
                   3138: 
                   3139: Gets a user's language preference and returns it as a hash with key:
                   3140: language.
                   3141: 
                   3142: =cut
                   3143: 
                   3144: 
                   3145: sub getlangs {
                   3146:     my ($uname,$udom) = @_;
                   3147:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3148:     if (!$uname) { $uname=$env{'user.name'};   }
                   3149:     my $id=$uname.':'.$udom;
                   3150:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3151:     if ($cached) {
                   3152:         return %{$langs};
                   3153:     } else {
                   3154:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3155:                                            $udom,$uname);
                   3156:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3157:         return %loadlangs;
                   3158:     }
                   3159: }
                   3160: 
                   3161: sub flush_langs_cache {
                   3162:     my ($uname,$udom)=@_;
                   3163:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3164:     if (!$uname) { $uname=$env{'user.name'};   }
                   3165:     return if ($udom eq 'public' && $uname eq 'public');
                   3166:     my $id=$uname.':'.$udom;
                   3167:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3168: }
                   3169: 
1.61      www      3170: # ------------------------------------------------------------------ Screenname
1.81      albertel 3171: 
                   3172: =pod
                   3173: 
1.648     raeburn  3174: =item * &screenname($uname,$udom)
1.81      albertel 3175: 
                   3176: Gets a users screenname and returns it as a string
                   3177: 
                   3178: =cut
1.61      www      3179: 
                   3180: sub screenname {
                   3181:     my ($uname,$udom)=@_;
1.258     albertel 3182:     if ($uname eq $env{'user.name'} &&
                   3183: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3184:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3185:     return $names{'screenname'};
1.62      www      3186: }
                   3187: 
1.212     albertel 3188: 
1.802     bisitz   3189: # ------------------------------------------------------------- Confirm Wrapper
                   3190: =pod
                   3191: 
                   3192: =item confirmwrapper
                   3193: 
                   3194: Wrap messages about completion of operation in box
                   3195: 
                   3196: =cut
                   3197: 
                   3198: sub confirmwrapper {
                   3199:     my ($message)=@_;
                   3200:     if ($message) {
                   3201:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3202:                .$message."\n"
                   3203:                .'</div>'."\n";
                   3204:     } else {
                   3205:         return $message;
                   3206:     }
                   3207: }
                   3208: 
1.62      www      3209: # ------------------------------------------------------------- Message Wrapper
                   3210: 
                   3211: sub messagewrapper {
1.369     www      3212:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3213:     return 
1.441     albertel 3214:         '<a href="/adm/email?compose=individual&amp;'.
                   3215:         'recname='.$username.'&amp;recdom='.$domain.
                   3216: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3217:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3218: }
1.802     bisitz   3219: 
1.74      www      3220: # --------------------------------------------------------------- Notes Wrapper
                   3221: 
                   3222: sub noteswrapper {
                   3223:     my ($link,$un,$do)=@_;
                   3224:     return 
1.896     amueller 3225: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3226: }
1.802     bisitz   3227: 
1.62      www      3228: # ------------------------------------------------------------- Aboutme Wrapper
                   3229: 
                   3230: sub aboutmewrapper {
1.1070    raeburn  3231:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3232:     if (!defined($username)  && !defined($domain)) {
                   3233:         return;
                   3234:     }
1.1075.2.15! raeburn  3235:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3236: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3237: }
                   3238: 
                   3239: # ------------------------------------------------------------ Syllabus Wrapper
                   3240: 
                   3241: sub syllabuswrapper {
1.707     bisitz   3242:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3243:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3244: }
1.14      harris41 3245: 
1.802     bisitz   3246: # -----------------------------------------------------------------------------
                   3247: 
1.208     matthew  3248: sub track_student_link {
1.887     raeburn  3249:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3250:     my $link ="/adm/trackstudent?";
1.208     matthew  3251:     my $title = 'View recent activity';
                   3252:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3253:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3254:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3255:         $title .= ' of this student';
1.268     albertel 3256:     } 
1.208     matthew  3257:     if (defined($target) && $target !~ /^\s*$/) {
                   3258:         $target = qq{target="$target"};
                   3259:     } else {
                   3260:         $target = '';
                   3261:     }
1.268     albertel 3262:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3263:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3264:     $title = &mt($title);
                   3265:     $linktext = &mt($linktext);
1.448     albertel 3266:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3267: 	&help_open_topic('View_recent_activity');
1.208     matthew  3268: }
                   3269: 
1.781     raeburn  3270: sub slot_reservations_link {
                   3271:     my ($linktext,$sname,$sdom,$target) = @_;
                   3272:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3273:     my $title = 'View slot reservation history';
                   3274:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3275:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3276:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3277:         $title .= ' of this student';
                   3278:     }
                   3279:     if (defined($target) && $target !~ /^\s*$/) {
                   3280:         $target = qq{target="$target"};
                   3281:     } else {
                   3282:         $target = '';
                   3283:     }
                   3284:     $title = &mt($title);
                   3285:     $linktext = &mt($linktext);
                   3286:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3287: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3288: 
                   3289: }
                   3290: 
1.508     www      3291: # ===================================================== Display a student photo
                   3292: 
                   3293: 
1.509     albertel 3294: sub student_image_tag {
1.508     www      3295:     my ($domain,$user)=@_;
                   3296:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3297:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3298: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3299:     } else {
                   3300: 	return '';
                   3301:     }
                   3302: }
                   3303: 
1.112     bowersj2 3304: =pod
                   3305: 
                   3306: =back
                   3307: 
                   3308: =head1 Access .tab File Data
                   3309: 
                   3310: =over 4
                   3311: 
1.648     raeburn  3312: =item * &languageids() 
1.112     bowersj2 3313: 
                   3314: returns list of all language ids
                   3315: 
                   3316: =cut
                   3317: 
1.14      harris41 3318: sub languageids {
1.16      harris41 3319:     return sort(keys(%language));
1.14      harris41 3320: }
                   3321: 
1.112     bowersj2 3322: =pod
                   3323: 
1.648     raeburn  3324: =item * &languagedescription() 
1.112     bowersj2 3325: 
                   3326: returns description of a specified language id
                   3327: 
                   3328: =cut
                   3329: 
1.14      harris41 3330: sub languagedescription {
1.125     www      3331:     my $code=shift;
                   3332:     return  ($supported_language{$code}?'* ':'').
                   3333:             $language{$code}.
1.126     www      3334: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3335: }
                   3336: 
1.1048    foxr     3337: =pod
                   3338: 
                   3339: =item * &plainlanguagedescription
                   3340: 
                   3341: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3342: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3343: 
                   3344: =cut
                   3345: 
1.145     www      3346: sub plainlanguagedescription {
                   3347:     my $code=shift;
                   3348:     return $language{$code};
                   3349: }
                   3350: 
1.1048    foxr     3351: =pod
                   3352: 
                   3353: =item * &supportedlanguagecode
                   3354: 
                   3355: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3356: code.
                   3357: 
                   3358: =cut
                   3359: 
1.145     www      3360: sub supportedlanguagecode {
                   3361:     my $code=shift;
                   3362:     return $supported_language{$code};
1.97      www      3363: }
                   3364: 
1.112     bowersj2 3365: =pod
                   3366: 
1.1048    foxr     3367: =item * &latexlanguage()
                   3368: 
                   3369: Given a language key code returns the correspondnig language to use
                   3370: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3371: is no supported hyphenation for the language code.
                   3372: 
                   3373: =cut
                   3374: 
                   3375: sub latexlanguage {
                   3376:     my $code = shift;
                   3377:     return $latex_language{$code};
                   3378: }
                   3379: 
                   3380: =pod
                   3381: 
                   3382: =item * &latexhyphenation()
                   3383: 
                   3384: Same as above but what's supplied is the language as it might be stored
                   3385: in the metadata.
                   3386: 
                   3387: =cut
                   3388: 
                   3389: sub latexhyphenation {
                   3390:     my $key = shift;
                   3391:     return $latex_language_bykey{$key};
                   3392: }
                   3393: 
                   3394: =pod
                   3395: 
1.648     raeburn  3396: =item * &copyrightids() 
1.112     bowersj2 3397: 
                   3398: returns list of all copyrights
                   3399: 
                   3400: =cut
                   3401: 
                   3402: sub copyrightids {
                   3403:     return sort(keys(%cprtag));
                   3404: }
                   3405: 
                   3406: =pod
                   3407: 
1.648     raeburn  3408: =item * &copyrightdescription() 
1.112     bowersj2 3409: 
                   3410: returns description of a specified copyright id
                   3411: 
                   3412: =cut
                   3413: 
                   3414: sub copyrightdescription {
1.166     www      3415:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3416: }
1.197     matthew  3417: 
                   3418: =pod
                   3419: 
1.648     raeburn  3420: =item * &source_copyrightids() 
1.192     taceyjo1 3421: 
                   3422: returns list of all source copyrights
                   3423: 
                   3424: =cut
                   3425: 
                   3426: sub source_copyrightids {
                   3427:     return sort(keys(%scprtag));
                   3428: }
                   3429: 
                   3430: =pod
                   3431: 
1.648     raeburn  3432: =item * &source_copyrightdescription() 
1.192     taceyjo1 3433: 
                   3434: returns description of a specified source copyright id
                   3435: 
                   3436: =cut
                   3437: 
                   3438: sub source_copyrightdescription {
                   3439:     return &mt($scprtag{shift(@_)});
                   3440: }
1.112     bowersj2 3441: 
                   3442: =pod
                   3443: 
1.648     raeburn  3444: =item * &filecategories() 
1.112     bowersj2 3445: 
                   3446: returns list of all file categories
                   3447: 
                   3448: =cut
                   3449: 
                   3450: sub filecategories {
                   3451:     return sort(keys(%category_extensions));
                   3452: }
                   3453: 
                   3454: =pod
                   3455: 
1.648     raeburn  3456: =item * &filecategorytypes() 
1.112     bowersj2 3457: 
                   3458: returns list of file types belonging to a given file
                   3459: category
                   3460: 
                   3461: =cut
                   3462: 
                   3463: sub filecategorytypes {
1.356     albertel 3464:     my ($cat) = @_;
                   3465:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3466: }
                   3467: 
                   3468: =pod
                   3469: 
1.648     raeburn  3470: =item * &fileembstyle() 
1.112     bowersj2 3471: 
                   3472: returns embedding style for a specified file type
                   3473: 
                   3474: =cut
                   3475: 
                   3476: sub fileembstyle {
                   3477:     return $fe{lc(shift(@_))};
1.169     www      3478: }
                   3479: 
1.351     www      3480: sub filemimetype {
                   3481:     return $fm{lc(shift(@_))};
                   3482: }
                   3483: 
1.169     www      3484: 
                   3485: sub filecategoryselect {
                   3486:     my ($name,$value)=@_;
1.189     matthew  3487:     return &select_form($value,$name,
1.970     raeburn  3488:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3489: }
                   3490: 
                   3491: =pod
                   3492: 
1.648     raeburn  3493: =item * &filedescription() 
1.112     bowersj2 3494: 
                   3495: returns description for a specified file type
                   3496: 
                   3497: =cut
                   3498: 
                   3499: sub filedescription {
1.188     matthew  3500:     my $file_description = $fd{lc(shift())};
                   3501:     $file_description =~ s:([\[\]]):~$1:g;
                   3502:     return &mt($file_description);
1.112     bowersj2 3503: }
                   3504: 
                   3505: =pod
                   3506: 
1.648     raeburn  3507: =item * &filedescriptionex() 
1.112     bowersj2 3508: 
                   3509: returns description for a specified file type with
                   3510: extra formatting
                   3511: 
                   3512: =cut
                   3513: 
                   3514: sub filedescriptionex {
                   3515:     my $ex=shift;
1.188     matthew  3516:     my $file_description = $fd{lc($ex)};
                   3517:     $file_description =~ s:([\[\]]):~$1:g;
                   3518:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3519: }
                   3520: 
                   3521: # End of .tab access
                   3522: =pod
                   3523: 
                   3524: =back
                   3525: 
                   3526: =cut
                   3527: 
                   3528: # ------------------------------------------------------------------ File Types
                   3529: sub fileextensions {
                   3530:     return sort(keys(%fe));
                   3531: }
                   3532: 
1.97      www      3533: # ----------------------------------------------------------- Display Languages
                   3534: # returns a hash with all desired display languages
                   3535: #
                   3536: 
                   3537: sub display_languages {
                   3538:     my %languages=();
1.695     raeburn  3539:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3540: 	$languages{$lang}=1;
1.97      www      3541:     }
                   3542:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3543:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3544: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3545: 	    $languages{$lang}=1;
1.97      www      3546:         }
                   3547:     }
                   3548:     return %languages;
1.14      harris41 3549: }
                   3550: 
1.582     albertel 3551: sub languages {
                   3552:     my ($possible_langs) = @_;
1.695     raeburn  3553:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3554:     if (!ref($possible_langs)) {
                   3555: 	if( wantarray ) {
                   3556: 	    return @preferred_langs;
                   3557: 	} else {
                   3558: 	    return $preferred_langs[0];
                   3559: 	}
                   3560:     }
                   3561:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3562:     my @preferred_possibilities;
                   3563:     foreach my $preferred_lang (@preferred_langs) {
                   3564: 	if (exists($possibilities{$preferred_lang})) {
                   3565: 	    push(@preferred_possibilities, $preferred_lang);
                   3566: 	}
                   3567:     }
                   3568:     if( wantarray ) {
                   3569: 	return @preferred_possibilities;
                   3570:     }
                   3571:     return $preferred_possibilities[0];
                   3572: }
                   3573: 
1.742     raeburn  3574: sub user_lang {
                   3575:     my ($touname,$toudom,$fromcid) = @_;
                   3576:     my @userlangs;
                   3577:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3578:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3579:                     $env{'course.'.$fromcid.'.languages'}));
                   3580:     } else {
                   3581:         my %langhash = &getlangs($touname,$toudom);
                   3582:         if ($langhash{'languages'} ne '') {
                   3583:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3584:         } else {
                   3585:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3586:             if ($domdefs{'lang_def'} ne '') {
                   3587:                 @userlangs = ($domdefs{'lang_def'});
                   3588:             }
                   3589:         }
                   3590:     }
                   3591:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3592:     my $user_lh = Apache::localize->get_handle(@languages);
                   3593:     return $user_lh;
                   3594: }
                   3595: 
                   3596: 
1.112     bowersj2 3597: ###############################################################
                   3598: ##               Student Answer Attempts                     ##
                   3599: ###############################################################
                   3600: 
                   3601: =pod
                   3602: 
                   3603: =head1 Alternate Problem Views
                   3604: 
                   3605: =over 4
                   3606: 
1.648     raeburn  3607: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3608:     $getattempt, $regexp, $gradesub)
                   3609: 
                   3610: Return string with previous attempt on problem. Arguments:
                   3611: 
                   3612: =over 4
                   3613: 
                   3614: =item * $symb: Problem, including path
                   3615: 
                   3616: =item * $username: username of the desired student
                   3617: 
                   3618: =item * $domain: domain of the desired student
1.14      harris41 3619: 
1.112     bowersj2 3620: =item * $course: Course ID
1.14      harris41 3621: 
1.112     bowersj2 3622: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3623:     something
1.14      harris41 3624: 
1.112     bowersj2 3625: =item * $regexp: if string matches this regexp, the string will be
                   3626:     sent to $gradesub
1.14      harris41 3627: 
1.112     bowersj2 3628: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3629: 
1.112     bowersj2 3630: =back
1.14      harris41 3631: 
1.112     bowersj2 3632: The output string is a table containing all desired attempts, if any.
1.16      harris41 3633: 
1.112     bowersj2 3634: =cut
1.1       albertel 3635: 
                   3636: sub get_previous_attempt {
1.43      ng       3637:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3638:   my $prevattempts='';
1.43      ng       3639:   no strict 'refs';
1.1       albertel 3640:   if ($symb) {
1.3       albertel 3641:     my (%returnhash)=
                   3642:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3643:     if ($returnhash{'version'}) {
                   3644:       my %lasthash=();
                   3645:       my $version;
                   3646:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3647:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3648: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3649:         }
1.1       albertel 3650:       }
1.596     albertel 3651:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3652:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3653:       my (%typeparts,%lasthidden);
1.945     raeburn  3654:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3655:       foreach my $key (sort(keys(%lasthash))) {
                   3656: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3657: 	if ($#parts > 0) {
1.31      albertel 3658: 	  my $data=$parts[-1];
1.989     raeburn  3659:           next if ($data eq 'foilorder');
1.31      albertel 3660: 	  pop(@parts);
1.1010    www      3661:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3662:           if ($data eq 'type') {
                   3663:               unless ($showsurv) {
                   3664:                   my $id = join(',',@parts);
                   3665:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3666:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3667:                       $lasthidden{$ign.'.'.$id} = 1;
                   3668:                   }
1.945     raeburn  3669:               }
1.1010    www      3670:           } 
1.31      albertel 3671: 	} else {
1.41      ng       3672: 	  if ($#parts == 0) {
                   3673: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3674: 	  } else {
                   3675: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3676: 	  }
1.31      albertel 3677: 	}
1.16      harris41 3678:       }
1.596     albertel 3679:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3680:       if ($getattempt eq '') {
                   3681: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3682:             my @hidden;
                   3683:             if (%typeparts) {
                   3684:                 foreach my $id (keys(%typeparts)) {
                   3685:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3686:                         push(@hidden,$id);
                   3687:                     }
                   3688:                 }
                   3689:             }
                   3690:             $prevattempts.=&start_data_table_row().
                   3691:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3692:             if (@hidden) {
                   3693:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3694:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3695:                     my $hide;
                   3696:                     foreach my $id (@hidden) {
                   3697:                         if ($key =~ /^\Q$id\E/) {
                   3698:                             $hide = 1;
                   3699:                             last;
                   3700:                         }
                   3701:                     }
                   3702:                     if ($hide) {
                   3703:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3704:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3705:                             my $value = &format_previous_attempt_value($key,
                   3706:                                              $returnhash{$version.':'.$key});
                   3707:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3708:                         } else {
                   3709:                             $prevattempts.='<td>&nbsp;</td>';
                   3710:                         }
                   3711:                     } else {
                   3712:                         if ($key =~ /\./) {
                   3713:                             my $value = &format_previous_attempt_value($key,
                   3714:                                               $returnhash{$version.':'.$key});
                   3715:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3716:                         } else {
                   3717:                             $prevattempts.='<td>&nbsp;</td>';
                   3718:                         }
                   3719:                     }
                   3720:                 }
                   3721:             } else {
                   3722: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3723:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3724: 		    my $value = &format_previous_attempt_value($key,
                   3725: 			            $returnhash{$version.':'.$key});
                   3726: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3727: 	        }
                   3728:             }
                   3729: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3730: 	 }
1.1       albertel 3731:       }
1.945     raeburn  3732:       my @currhidden = keys(%lasthidden);
1.596     albertel 3733:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3734:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3735:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3736:           if (%typeparts) {
                   3737:               my $hidden;
                   3738:               foreach my $id (@currhidden) {
                   3739:                   if ($key =~ /^\Q$id\E/) {
                   3740:                       $hidden = 1;
                   3741:                       last;
                   3742:                   }
                   3743:               }
                   3744:               if ($hidden) {
                   3745:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3746:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3747:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3748:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3749:                           $value = &$gradesub($value);
                   3750:                       }
                   3751:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3752:                   } else {
                   3753:                       $prevattempts.='<td>&nbsp;</td>';
                   3754:                   }
                   3755:               } else {
                   3756:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3757:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3758:                       $value = &$gradesub($value);
                   3759:                   }
                   3760:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3761:               }
                   3762:           } else {
                   3763: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3764: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3765:                   $value = &$gradesub($value);
                   3766:               }
                   3767: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3768:           }
1.16      harris41 3769:       }
1.596     albertel 3770:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3771:     } else {
1.596     albertel 3772:       $prevattempts=
                   3773: 	  &start_data_table().&start_data_table_row().
                   3774: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3775: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3776:     }
                   3777:   } else {
1.596     albertel 3778:     $prevattempts=
                   3779: 	  &start_data_table().&start_data_table_row().
                   3780: 	  '<td>'.&mt('No data.').'</td>'.
                   3781: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3782:   }
1.10      albertel 3783: }
                   3784: 
1.581     albertel 3785: sub format_previous_attempt_value {
                   3786:     my ($key,$value) = @_;
1.1011    www      3787:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 3788: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3789:     } elsif (ref($value) eq 'ARRAY') {
                   3790: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3791:     } elsif ($key =~ /answerstring$/) {
                   3792:         my %answers = &Apache::lonnet::str2hash($value);
                   3793:         my @anskeys = sort(keys(%answers));
                   3794:         if (@anskeys == 1) {
                   3795:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3796:             if ($answer =~ m{\0}) {
                   3797:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3798:             }
                   3799:             my $tag_internal_answer_name = 'INTERNAL';
                   3800:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3801:                 $value = $answer; 
                   3802:             } else {
                   3803:                 $value = $anskeys[0].'='.$answer;
                   3804:             }
                   3805:         } else {
                   3806:             foreach my $ans (@anskeys) {
                   3807:                 my $answer = $answers{$ans};
1.1001    raeburn  3808:                 if ($answer =~ m{\0}) {
                   3809:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3810:                 }
                   3811:                 $value .=  $ans.'='.$answer.'<br />';;
                   3812:             } 
                   3813:         }
1.581     albertel 3814:     } else {
                   3815: 	$value = &unescape($value);
                   3816:     }
                   3817:     return $value;
                   3818: }
                   3819: 
                   3820: 
1.107     albertel 3821: sub relative_to_absolute {
                   3822:     my ($url,$output)=@_;
                   3823:     my $parser=HTML::TokeParser->new(\$output);
                   3824:     my $token;
                   3825:     my $thisdir=$url;
                   3826:     my @rlinks=();
                   3827:     while ($token=$parser->get_token) {
                   3828: 	if ($token->[0] eq 'S') {
                   3829: 	    if ($token->[1] eq 'a') {
                   3830: 		if ($token->[2]->{'href'}) {
                   3831: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3832: 		}
                   3833: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3834: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3835: 	    } elsif ($token->[1] eq 'base') {
                   3836: 		$thisdir=$token->[2]->{'href'};
                   3837: 	    }
                   3838: 	}
                   3839:     }
                   3840:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3841:     foreach my $link (@rlinks) {
1.726     raeburn  3842: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3843: 		($link=~/^\//) ||
                   3844: 		($link=~/^javascript:/i) ||
                   3845: 		($link=~/^mailto:/i) ||
                   3846: 		($link=~/^\#/)) {
                   3847: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3848: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3849: 	}
                   3850:     }
                   3851: # -------------------------------------------------- Deal with Applet codebases
                   3852:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3853:     return $output;
                   3854: }
                   3855: 
1.112     bowersj2 3856: =pod
                   3857: 
1.648     raeburn  3858: =item * &get_student_view()
1.112     bowersj2 3859: 
                   3860: show a snapshot of what student was looking at
                   3861: 
                   3862: =cut
                   3863: 
1.10      albertel 3864: sub get_student_view {
1.186     albertel 3865:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3866:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3867:   my (%form);
1.10      albertel 3868:   my @elements=('symb','courseid','domain','username');
                   3869:   foreach my $element (@elements) {
1.186     albertel 3870:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3871:   }
1.186     albertel 3872:   if (defined($moreenv)) {
                   3873:       %form=(%form,%{$moreenv});
                   3874:   }
1.236     albertel 3875:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 3876:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      3877:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 3878:   $userview=~s/\<body[^\>]*\>//gi;
                   3879:   $userview=~s/\<\/body\>//gi;
                   3880:   $userview=~s/\<html\>//gi;
                   3881:   $userview=~s/\<\/html\>//gi;
                   3882:   $userview=~s/\<head\>//gi;
                   3883:   $userview=~s/\<\/head\>//gi;
                   3884:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 3885:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      3886:   if (wantarray) {
                   3887:      return ($userview,$response);
                   3888:   } else {
                   3889:      return $userview;
                   3890:   }
                   3891: }
                   3892: 
                   3893: sub get_student_view_with_retries {
                   3894:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   3895: 
                   3896:     my $ok = 0;                 # True if we got a good response.
                   3897:     my $content;
                   3898:     my $response;
                   3899: 
                   3900:     # Try to get the student_view done. within the retries count:
                   3901:     
                   3902:     do {
                   3903:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   3904:          $ok      = $response->is_success;
                   3905:          if (!$ok) {
                   3906:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   3907:          }
                   3908:          $retries--;
                   3909:     } while (!$ok && ($retries > 0));
                   3910:     
                   3911:     if (!$ok) {
                   3912:        $content = '';          # On error return an empty content.
                   3913:     }
1.651     www      3914:     if (wantarray) {
                   3915:        return ($content, $response);
                   3916:     } else {
                   3917:        return $content;
                   3918:     }
1.11      albertel 3919: }
                   3920: 
1.112     bowersj2 3921: =pod
                   3922: 
1.648     raeburn  3923: =item * &get_student_answers() 
1.112     bowersj2 3924: 
                   3925: show a snapshot of how student was answering problem
                   3926: 
                   3927: =cut
                   3928: 
1.11      albertel 3929: sub get_student_answers {
1.100     sakharuk 3930:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      3931:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3932:   my (%moreenv);
1.11      albertel 3933:   my @elements=('symb','courseid','domain','username');
                   3934:   foreach my $element (@elements) {
1.186     albertel 3935:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3936:   }
1.186     albertel 3937:   $moreenv{'grade_target'}='answer';
                   3938:   %moreenv=(%form,%moreenv);
1.497     raeburn  3939:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   3940:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 3941:   return $userview;
1.1       albertel 3942: }
1.116     albertel 3943: 
                   3944: =pod
                   3945: 
                   3946: =item * &submlink()
                   3947: 
1.242     albertel 3948: Inputs: $text $uname $udom $symb $target
1.116     albertel 3949: 
                   3950: Returns: A link to grades.pm such as to see the SUBM view of a student
                   3951: 
                   3952: =cut
                   3953: 
                   3954: ###############################################
                   3955: sub submlink {
1.242     albertel 3956:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 3957:     if (!($uname && $udom)) {
                   3958: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3959: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 3960: 	if (!$symb) { $symb=$cursymb; }
                   3961:     }
1.254     matthew  3962:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3963:     $symb=&escape($symb);
1.960     bisitz   3964:     if ($target) { $target=" target=\"$target\""; }
                   3965:     return
                   3966:         '<a href="/adm/grades?command=submission'.
                   3967:         '&amp;symb='.$symb.
                   3968:         '&amp;student='.$uname.
                   3969:         '&amp;userdom='.$udom.'"'.
                   3970:         $target.'>'.$text.'</a>';
1.242     albertel 3971: }
                   3972: ##############################################
                   3973: 
                   3974: =pod
                   3975: 
                   3976: =item * &pgrdlink()
                   3977: 
                   3978: Inputs: $text $uname $udom $symb $target
                   3979: 
                   3980: Returns: A link to grades.pm such as to see the PGRD view of a student
                   3981: 
                   3982: =cut
                   3983: 
                   3984: ###############################################
                   3985: sub pgrdlink {
                   3986:     my $link=&submlink(@_);
                   3987:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   3988:     return $link;
                   3989: }
                   3990: ##############################################
                   3991: 
                   3992: =pod
                   3993: 
                   3994: =item * &pprmlink()
                   3995: 
                   3996: Inputs: $text $uname $udom $symb $target
                   3997: 
                   3998: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 3999: student and a specific resource
1.242     albertel 4000: 
                   4001: =cut
                   4002: 
                   4003: ###############################################
                   4004: sub pprmlink {
                   4005:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4006:     if (!($uname && $udom)) {
                   4007: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4008: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4009: 	if (!$symb) { $symb=$cursymb; }
                   4010:     }
1.254     matthew  4011:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4012:     $symb=&escape($symb);
1.242     albertel 4013:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4014:     return '<a href="/adm/parmset?command=set&amp;'.
                   4015: 	'symb='.$symb.'&amp;uname='.$uname.
                   4016: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4017: }
                   4018: ##############################################
1.37      matthew  4019: 
1.112     bowersj2 4020: =pod
                   4021: 
                   4022: =back
                   4023: 
                   4024: =cut
                   4025: 
1.37      matthew  4026: ###############################################
1.51      www      4027: 
                   4028: 
                   4029: sub timehash {
1.687     raeburn  4030:     my ($thistime) = @_;
                   4031:     my $timezone = &Apache::lonlocal::gettimezone();
                   4032:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4033:                      ->set_time_zone($timezone);
                   4034:     my $wday = $dt->day_of_week();
                   4035:     if ($wday == 7) { $wday = 0; }
                   4036:     return ( 'second' => $dt->second(),
                   4037:              'minute' => $dt->minute(),
                   4038:              'hour'   => $dt->hour(),
                   4039:              'day'     => $dt->day_of_month(),
                   4040:              'month'   => $dt->month(),
                   4041:              'year'    => $dt->year(),
                   4042:              'weekday' => $wday,
                   4043:              'dayyear' => $dt->day_of_year(),
                   4044:              'dlsav'   => $dt->is_dst() );
1.51      www      4045: }
                   4046: 
1.370     www      4047: sub utc_string {
                   4048:     my ($date)=@_;
1.371     www      4049:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4050: }
                   4051: 
1.51      www      4052: sub maketime {
                   4053:     my %th=@_;
1.687     raeburn  4054:     my ($epoch_time,$timezone,$dt);
                   4055:     $timezone = &Apache::lonlocal::gettimezone();
                   4056:     eval {
                   4057:         $dt = DateTime->new( year   => $th{'year'},
                   4058:                              month  => $th{'month'},
                   4059:                              day    => $th{'day'},
                   4060:                              hour   => $th{'hour'},
                   4061:                              minute => $th{'minute'},
                   4062:                              second => $th{'second'},
                   4063:                              time_zone => $timezone,
                   4064:                          );
                   4065:     };
                   4066:     if (!$@) {
                   4067:         $epoch_time = $dt->epoch;
                   4068:         if ($epoch_time) {
                   4069:             return $epoch_time;
                   4070:         }
                   4071:     }
1.51      www      4072:     return POSIX::mktime(
                   4073:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4074:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4075: }
                   4076: 
                   4077: #########################################
1.51      www      4078: 
                   4079: sub findallcourses {
1.482     raeburn  4080:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4081:     my %roles;
                   4082:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4083:     my %courses;
1.51      www      4084:     my $now=time;
1.482     raeburn  4085:     if (!defined($uname)) {
                   4086:         $uname = $env{'user.name'};
                   4087:     }
                   4088:     if (!defined($udom)) {
                   4089:         $udom = $env{'user.domain'};
                   4090:     }
                   4091:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4092:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4093:         if (!%roles) {
                   4094:             %roles = (
                   4095:                        cc => 1,
1.907     raeburn  4096:                        co => 1,
1.482     raeburn  4097:                        in => 1,
                   4098:                        ep => 1,
                   4099:                        ta => 1,
                   4100:                        cr => 1,
                   4101:                        st => 1,
                   4102:              );
                   4103:         }
                   4104:         foreach my $entry (keys(%roleshash)) {
                   4105:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4106:             if ($trole =~ /^cr/) { 
                   4107:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4108:             } else {
                   4109:                 next if (!exists($roles{$trole}));
                   4110:             }
                   4111:             if ($tend) {
                   4112:                 next if ($tend < $now);
                   4113:             }
                   4114:             if ($tstart) {
                   4115:                 next if ($tstart > $now);
                   4116:             }
1.1058    raeburn  4117:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4118:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4119:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4120:             if ($secpart eq '') {
                   4121:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4122:                 $sec = 'none';
1.1058    raeburn  4123:                 $value .= $cnum.'/';
1.482     raeburn  4124:             } else {
                   4125:                 $cnum = $cnumpart;
                   4126:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4127:                 $value .= $cnum.'/'.$sec;
                   4128:             }
                   4129:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4130:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4131:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4132:                 }
                   4133:             } else {
                   4134:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4135:             }
1.482     raeburn  4136:         }
                   4137:     } else {
                   4138:         foreach my $key (keys(%env)) {
1.483     albertel 4139: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4140:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4141: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4142: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4143: 	        next if (%roles && !exists($roles{$role}));
                   4144: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4145:                 my $active=1;
                   4146:                 if ($starttime) {
                   4147: 		    if ($now<$starttime) { $active=0; }
                   4148:                 }
                   4149:                 if ($endtime) {
                   4150:                     if ($now>$endtime) { $active=0; }
                   4151:                 }
                   4152:                 if ($active) {
1.1058    raeburn  4153:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4154:                     if ($sec eq '') {
                   4155:                         $sec = 'none';
1.1058    raeburn  4156:                     } else {
                   4157:                         $value .= $sec;
                   4158:                     }
                   4159:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4160:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4161:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4162:                         }
                   4163:                     } else {
                   4164:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4165:                     }
1.474     raeburn  4166:                 }
                   4167:             }
1.51      www      4168:         }
                   4169:     }
1.474     raeburn  4170:     return %courses;
1.51      www      4171: }
1.37      matthew  4172: 
1.54      www      4173: ###############################################
1.474     raeburn  4174: 
                   4175: sub blockcheck {
1.1062    raeburn  4176:     my ($setters,$activity,$uname,$udom,$url) = @_;
1.490     raeburn  4177: 
                   4178:     if (!defined($udom)) {
                   4179:         $udom = $env{'user.domain'};
                   4180:     }
                   4181:     if (!defined($uname)) {
                   4182:         $uname = $env{'user.name'};
                   4183:     }
                   4184: 
                   4185:     # If uname and udom are for a course, check for blocks in the course.
                   4186: 
                   4187:     if (&Apache::lonnet::is_course($udom,$uname)) {
1.1062    raeburn  4188:         my ($startblock,$endblock,$triggerblock) = 
                   4189:             &get_blocks($setters,$activity,$udom,$uname,$url);
                   4190:         return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4191:     }
1.474     raeburn  4192: 
1.502     raeburn  4193:     my $startblock = 0;
                   4194:     my $endblock = 0;
1.1062    raeburn  4195:     my $triggerblock = '';
1.482     raeburn  4196:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4197: 
1.490     raeburn  4198:     # If uname is for a user, and activity is course-specific, i.e.,
                   4199:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4200: 
1.490     raeburn  4201:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   4202:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   4203:         foreach my $key (keys(%live_courses)) {
                   4204:             if ($key ne $env{'request.course.id'}) {
                   4205:                 delete($live_courses{$key});
                   4206:             }
                   4207:         }
                   4208:     }
                   4209: 
                   4210:     my $otheruser = 0;
                   4211:     my %own_courses;
                   4212:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4213:         # Resource belongs to user other than current user.
                   4214:         $otheruser = 1;
                   4215:         # Gather courses for current user
                   4216:         %own_courses = 
                   4217:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4218:     }
                   4219: 
                   4220:     # Gather active course roles - course coordinator, instructor, 
                   4221:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4222: 
                   4223:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4224:         my ($cdom,$cnum);
                   4225:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4226:             $cdom = $env{'course.'.$course.'.domain'};
                   4227:             $cnum = $env{'course.'.$course.'.num'};
                   4228:         } else {
1.490     raeburn  4229:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4230:         }
                   4231:         my $no_ownblock = 0;
                   4232:         my $no_userblock = 0;
1.533     raeburn  4233:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4234:             # Check if current user has 'evb' priv for this
                   4235:             if (defined($own_courses{$course})) {
                   4236:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4237:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4238:                     if ($sec ne 'none') {
                   4239:                         $checkrole .= '/'.$sec;
                   4240:                     }
                   4241:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4242:                         $no_ownblock = 1;
                   4243:                         last;
                   4244:                     }
                   4245:                 }
                   4246:             }
                   4247:             # if they have 'evb' priv and are currently not playing student
                   4248:             next if (($no_ownblock) &&
                   4249:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4250:         }
1.474     raeburn  4251:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4252:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4253:             if ($sec ne 'none') {
1.482     raeburn  4254:                 $checkrole .= '/'.$sec;
1.474     raeburn  4255:             }
1.490     raeburn  4256:             if ($otheruser) {
                   4257:                 # Resource belongs to user other than current user.
                   4258:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4259:                 my (%allroles,%userroles);
                   4260:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4261:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4262:                         my ($trole,$tdom,$tnum,$tsec);
                   4263:                         if ($entry =~ /^cr/) {
                   4264:                             ($trole,$tdom,$tnum,$tsec) = 
                   4265:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4266:                         } else {
                   4267:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4268:                         }
                   4269:                         my ($spec,$area,$trest);
                   4270:                         $area = '/'.$tdom.'/'.$tnum;
                   4271:                         $trest = $tnum;
                   4272:                         if ($tsec ne '') {
                   4273:                             $area .= '/'.$tsec;
                   4274:                             $trest .= '/'.$tsec;
                   4275:                         }
                   4276:                         $spec = $trole.'.'.$area;
                   4277:                         if ($trole =~ /^cr/) {
                   4278:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4279:                                                               $tdom,$spec,$trest,$area);
                   4280:                         } else {
                   4281:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4282:                                                                 $tdom,$spec,$trest,$area);
                   4283:                         }
                   4284:                     }
                   4285:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4286:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4287:                         if ($1) {
                   4288:                             $no_userblock = 1;
                   4289:                             last;
                   4290:                         }
1.486     raeburn  4291:                     }
                   4292:                 }
1.490     raeburn  4293:             } else {
                   4294:                 # Resource belongs to current user
                   4295:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4296:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4297:                     $no_ownblock = 1;
                   4298:                     last;
                   4299:                 }
1.474     raeburn  4300:             }
                   4301:         }
                   4302:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4303:         next if (($no_ownblock) &&
1.491     albertel 4304:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4305:         next if ($no_userblock);
1.474     raeburn  4306: 
1.866     kalberla 4307:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4308:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4309:         
1.1062    raeburn  4310:         my ($start,$end,$trigger) = 
                   4311:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4312:         if (($start != 0) && 
                   4313:             (($startblock == 0) || ($startblock > $start))) {
                   4314:             $startblock = $start;
1.1062    raeburn  4315:             if ($trigger ne '') {
                   4316:                 $triggerblock = $trigger;
                   4317:             }
1.502     raeburn  4318:         }
                   4319:         if (($end != 0)  &&
                   4320:             (($endblock == 0) || ($endblock < $end))) {
                   4321:             $endblock = $end;
1.1062    raeburn  4322:             if ($trigger ne '') {
                   4323:                 $triggerblock = $trigger;
                   4324:             }
1.502     raeburn  4325:         }
1.490     raeburn  4326:     }
1.1062    raeburn  4327:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4328: }
                   4329: 
                   4330: sub get_blocks {
1.1062    raeburn  4331:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4332:     my $startblock = 0;
                   4333:     my $endblock = 0;
1.1062    raeburn  4334:     my $triggerblock = '';
1.490     raeburn  4335:     my $course = $cdom.'_'.$cnum;
                   4336:     $setters->{$course} = {};
                   4337:     $setters->{$course}{'staff'} = [];
                   4338:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4339:     $setters->{$course}{'triggers'} = [];
                   4340:     my (@blockers,%triggered);
                   4341:     my $now = time;
                   4342:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4343:     if ($activity eq 'docs') {
                   4344:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4345:         foreach my $block (@blockers) {
                   4346:             if ($block =~ /^firstaccess____(.+)$/) {
                   4347:                 my $item = $1;
                   4348:                 my $type = 'map';
                   4349:                 my $timersymb = $item;
                   4350:                 if ($item eq 'course') {
                   4351:                     $type = 'course';
                   4352:                 } elsif ($item =~ /___\d+___/) {
                   4353:                     $type = 'resource';
                   4354:                 } else {
                   4355:                     $timersymb = &Apache::lonnet::symbread($item);
                   4356:                 }
                   4357:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4358:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4359:                 $triggered{$block} = {
                   4360:                                        start => $start,
                   4361:                                        end   => $end,
                   4362:                                        type  => $type,
                   4363:                                      };
                   4364:             }
                   4365:         }
                   4366:     } else {
                   4367:         foreach my $block (keys(%commblocks)) {
                   4368:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4369:                 my ($start,$end) = ($1,$2);
                   4370:                 if ($start <= time && $end >= time) {
                   4371:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4372:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4373:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4374:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4375:                                     push(@blockers,$block);
                   4376:                                 }
                   4377:                             }
                   4378:                         }
                   4379:                     }
                   4380:                 }
                   4381:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4382:                 my $item = $1;
                   4383:                 my $timersymb = $item; 
                   4384:                 my $type = 'map';
                   4385:                 if ($item eq 'course') {
                   4386:                     $type = 'course';
                   4387:                 } elsif ($item =~ /___\d+___/) {
                   4388:                     $type = 'resource';
                   4389:                 } else {
                   4390:                     $timersymb = &Apache::lonnet::symbread($item);
                   4391:                 }
                   4392:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4393:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4394:                 if ($start && $end) {
                   4395:                     if (($start <= time) && ($end >= time)) {
                   4396:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4397:                             push(@blockers,$block);
                   4398:                             $triggered{$block} = {
                   4399:                                                    start => $start,
                   4400:                                                    end   => $end,
                   4401:                                                    type  => $type,
                   4402:                                                  };
                   4403:                         }
                   4404:                     }
1.490     raeburn  4405:                 }
1.1062    raeburn  4406:             }
                   4407:         }
                   4408:     }
                   4409:     foreach my $blocker (@blockers) {
                   4410:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4411:             &parse_block_record($commblocks{$blocker});
                   4412:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4413:         my ($start,$end,$triggertype);
                   4414:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4415:             ($start,$end) = ($1,$2);
                   4416:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4417:             $start = $triggered{$blocker}{'start'};
                   4418:             $end = $triggered{$blocker}{'end'};
                   4419:             $triggertype = $triggered{$blocker}{'type'};
                   4420:         }
                   4421:         if ($start) {
                   4422:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4423:             if ($triggertype) {
                   4424:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4425:             } else {
                   4426:                 push(@{$$setters{$course}{'triggers'}},0);
                   4427:             }
                   4428:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4429:                 $startblock = $start;
                   4430:                 if ($triggertype) {
                   4431:                     $triggerblock = $blocker;
1.474     raeburn  4432:                 }
                   4433:             }
1.1062    raeburn  4434:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4435:                $endblock = $end;
                   4436:                if ($triggertype) {
                   4437:                    $triggerblock = $blocker;
                   4438:                }
                   4439:             }
1.474     raeburn  4440:         }
                   4441:     }
1.1062    raeburn  4442:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4443: }
                   4444: 
                   4445: sub parse_block_record {
                   4446:     my ($record) = @_;
                   4447:     my ($setuname,$setudom,$title,$blocks);
                   4448:     if (ref($record) eq 'HASH') {
                   4449:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4450:         $title = &unescape($record->{'event'});
                   4451:         $blocks = $record->{'blocks'};
                   4452:     } else {
                   4453:         my @data = split(/:/,$record,3);
                   4454:         if (scalar(@data) eq 2) {
                   4455:             $title = $data[1];
                   4456:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4457:         } else {
                   4458:             ($setuname,$setudom,$title) = @data;
                   4459:         }
                   4460:         $blocks = { 'com' => 'on' };
                   4461:     }
                   4462:     return ($setuname,$setudom,$title,$blocks);
                   4463: }
                   4464: 
1.854     kalberla 4465: sub blocking_status {
1.1062    raeburn  4466:     my ($activity,$uname,$udom,$url) = @_;
1.1061    raeburn  4467:     my %setters;
1.890     droeschl 4468: 
1.1061    raeburn  4469: # check for active blocking
1.1062    raeburn  4470:     my ($startblock,$endblock,$triggerblock) = 
                   4471:         &blockcheck(\%setters,$activity,$uname,$udom,$url);
                   4472:     my $blocked = 0;
                   4473:     if ($startblock && $endblock) {
                   4474:         $blocked = 1;
                   4475:     }
1.890     droeschl 4476: 
1.1061    raeburn  4477: # caller just wants to know whether a block is active
                   4478:     if (!wantarray) { return $blocked; }
                   4479: 
                   4480: # build a link to a popup window containing the details
                   4481:     my $querystring  = "?activity=$activity";
                   4482: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062    raeburn  4483:     if ($activity eq 'port') {
                   4484:         $querystring .= "&amp;udom=$udom"      if $udom;
                   4485:         $querystring .= "&amp;uname=$uname"    if $uname;
                   4486:     } elsif ($activity eq 'docs') {
                   4487:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4488:     }
1.1061    raeburn  4489: 
                   4490:     my $output .= <<'END_MYBLOCK';
                   4491: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4492:     var options = "width=" + w + ",height=" + h + ",";
                   4493:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4494:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4495:     var newWin = window.open(url, wdwName, options);
                   4496:     newWin.focus();
                   4497: }
1.890     droeschl 4498: END_MYBLOCK
1.854     kalberla 4499: 
1.1061    raeburn  4500:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4501:   
1.1061    raeburn  4502:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4503:     my $text = &mt('Communication Blocked');
                   4504:     if ($activity eq 'docs') {
                   4505:         $text = &mt('Content Access Blocked');
1.1063    raeburn  4506:     } elsif ($activity eq 'printout') {
                   4507:         $text = &mt('Printing Blocked');
1.1062    raeburn  4508:     }
1.1061    raeburn  4509:     $output .= <<"END_BLOCK";
1.867     kalberla 4510: <div class='LC_comblock'>
1.869     kalberla 4511:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4512:   title='$text'>
                   4513:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4514:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4515:   title='$text'>$text</a>
1.867     kalberla 4516: </div>
                   4517: 
                   4518: END_BLOCK
1.474     raeburn  4519: 
1.1061    raeburn  4520:     return ($blocked, $output);
1.854     kalberla 4521: }
1.490     raeburn  4522: 
1.60      matthew  4523: ###############################################
                   4524: 
1.682     raeburn  4525: sub check_ip_acc {
                   4526:     my ($acc)=@_;
                   4527:     &Apache::lonxml::debug("acc is $acc");
                   4528:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4529:         return 1;
                   4530:     }
                   4531:     my $allowed=0;
                   4532:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4533: 
                   4534:     my $name;
                   4535:     foreach my $pattern (split(',',$acc)) {
                   4536:         $pattern =~ s/^\s*//;
                   4537:         $pattern =~ s/\s*$//;
                   4538:         if ($pattern =~ /\*$/) {
                   4539:             #35.8.*
                   4540:             $pattern=~s/\*//;
                   4541:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4542:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4543:             #35.8.3.[34-56]
                   4544:             my $low=$2;
                   4545:             my $high=$3;
                   4546:             $pattern=$1;
                   4547:             if ($ip =~ /^\Q$pattern\E/) {
                   4548:                 my $last=(split(/\./,$ip))[3];
                   4549:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4550:             }
                   4551:         } elsif ($pattern =~ /^\*/) {
                   4552:             #*.msu.edu
                   4553:             $pattern=~s/\*//;
                   4554:             if (!defined($name)) {
                   4555:                 use Socket;
                   4556:                 my $netaddr=inet_aton($ip);
                   4557:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4558:             }
                   4559:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4560:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4561:             #127.0.0.1
                   4562:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4563:         } else {
                   4564:             #some.name.com
                   4565:             if (!defined($name)) {
                   4566:                 use Socket;
                   4567:                 my $netaddr=inet_aton($ip);
                   4568:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4569:             }
                   4570:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4571:         }
                   4572:         if ($allowed) { last; }
                   4573:     }
                   4574:     return $allowed;
                   4575: }
                   4576: 
                   4577: ###############################################
                   4578: 
1.60      matthew  4579: =pod
                   4580: 
1.112     bowersj2 4581: =head1 Domain Template Functions
                   4582: 
                   4583: =over 4
                   4584: 
                   4585: =item * &determinedomain()
1.60      matthew  4586: 
                   4587: Inputs: $domain (usually will be undef)
                   4588: 
1.63      www      4589: Returns: Determines which domain should be used for designs
1.60      matthew  4590: 
                   4591: =cut
1.54      www      4592: 
1.60      matthew  4593: ###############################################
1.63      www      4594: sub determinedomain {
                   4595:     my $domain=shift;
1.531     albertel 4596:     if (! $domain) {
1.60      matthew  4597:         # Determine domain if we have not been given one
1.893     raeburn  4598:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4599:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4600:         if ($env{'request.role.domain'}) { 
                   4601:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4602:         }
                   4603:     }
1.63      www      4604:     return $domain;
                   4605: }
                   4606: ###############################################
1.517     raeburn  4607: 
1.518     albertel 4608: sub devalidate_domconfig_cache {
                   4609:     my ($udom)=@_;
                   4610:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4611: }
                   4612: 
                   4613: # ---------------------- Get domain configuration for a domain
                   4614: sub get_domainconf {
                   4615:     my ($udom) = @_;
                   4616:     my $cachetime=1800;
                   4617:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4618:     if (defined($cached)) { return %{$result}; }
                   4619: 
                   4620:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4621: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4622:     my (%designhash,%legacy);
1.518     albertel 4623:     if (keys(%domconfig) > 0) {
                   4624:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4625:             if (keys(%{$domconfig{'login'}})) {
                   4626:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4627:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4628:                         if ($key eq 'loginvia') {
                   4629:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013    raeburn  4630:                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948     raeburn  4631:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4632:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4633:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4634:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4635:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4636: 
                   4637:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4638:                                             } else {
1.1013    raeburn  4639:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948     raeburn  4640:                                             }
                   4641:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4642:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4643:                                             }
1.946     raeburn  4644:                                         }
                   4645:                                     }
                   4646:                                 }
                   4647:                             }
                   4648:                         } else {
                   4649:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4650:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4651:                                     $domconfig{'login'}{$key}{$img};
                   4652:                             }
1.699     raeburn  4653:                         }
                   4654:                     } else {
                   4655:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4656:                     }
1.632     raeburn  4657:                 }
                   4658:             } else {
                   4659:                 $legacy{'login'} = 1;
1.518     albertel 4660:             }
1.632     raeburn  4661:         } else {
                   4662:             $legacy{'login'} = 1;
1.518     albertel 4663:         }
                   4664:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4665:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4666:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4667:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4668:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4669:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4670:                         }
1.518     albertel 4671:                     }
                   4672:                 }
1.632     raeburn  4673:             } else {
                   4674:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4675:             }
1.632     raeburn  4676:         } else {
                   4677:             $legacy{'rolecolors'} = 1;
1.518     albertel 4678:         }
1.948     raeburn  4679:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4680:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4681:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4682:             }
                   4683:         }
1.632     raeburn  4684:         if (keys(%legacy) > 0) {
                   4685:             my %legacyhash = &get_legacy_domconf($udom);
                   4686:             foreach my $item (keys(%legacyhash)) {
                   4687:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4688:                     if ($legacy{'login'}) { 
                   4689:                         $designhash{$item} = $legacyhash{$item};
                   4690:                     }
                   4691:                 } else {
                   4692:                     if ($legacy{'rolecolors'}) {
                   4693:                         $designhash{$item} = $legacyhash{$item};
                   4694:                     }
1.518     albertel 4695:                 }
                   4696:             }
                   4697:         }
1.632     raeburn  4698:     } else {
                   4699:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4700:     }
                   4701:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4702: 				  $cachetime);
                   4703:     return %designhash;
                   4704: }
                   4705: 
1.632     raeburn  4706: sub get_legacy_domconf {
                   4707:     my ($udom) = @_;
                   4708:     my %legacyhash;
                   4709:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4710:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4711:     if (-e $designfile) {
                   4712:         if ( open (my $fh,"<$designfile") ) {
                   4713:             while (my $line = <$fh>) {
                   4714:                 next if ($line =~ /^\#/);
                   4715:                 chomp($line);
                   4716:                 my ($key,$val)=(split(/\=/,$line));
                   4717:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4718:             }
                   4719:             close($fh);
                   4720:         }
                   4721:     }
1.1026    raeburn  4722:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4723:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4724:     }
                   4725:     return %legacyhash;
                   4726: }
                   4727: 
1.63      www      4728: =pod
                   4729: 
1.112     bowersj2 4730: =item * &domainlogo()
1.63      www      4731: 
                   4732: Inputs: $domain (usually will be undef)
                   4733: 
                   4734: Returns: A link to a domain logo, if the domain logo exists.
                   4735: If the domain logo does not exist, a description of the domain.
                   4736: 
                   4737: =cut
1.112     bowersj2 4738: 
1.63      www      4739: ###############################################
                   4740: sub domainlogo {
1.517     raeburn  4741:     my $domain = &determinedomain(shift);
1.518     albertel 4742:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4743:     # See if there is a logo
                   4744:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4745:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4746:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4747: 	    if ($imgsrc =~ m{^/res/}) {
                   4748: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4749: 		&Apache::lonnet::repcopy($local_name);
                   4750: 	    }
                   4751: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4752:         } 
                   4753:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4754:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4755:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4756:     } else {
1.60      matthew  4757:         return '';
1.59      www      4758:     }
                   4759: }
1.63      www      4760: ##############################################
                   4761: 
                   4762: =pod
                   4763: 
1.112     bowersj2 4764: =item * &designparm()
1.63      www      4765: 
                   4766: Inputs: $which parameter; $domain (usually will be undef)
                   4767: 
                   4768: Returns: value of designparamter $which
                   4769: 
                   4770: =cut
1.112     bowersj2 4771: 
1.397     albertel 4772: 
1.400     albertel 4773: ##############################################
1.397     albertel 4774: sub designparm {
                   4775:     my ($which,$domain)=@_;
                   4776:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4777:         return $env{'environment.color.'.$which};
1.96      www      4778:     }
1.63      www      4779:     $domain=&determinedomain($domain);
1.1016    raeburn  4780:     my %domdesign;
                   4781:     unless ($domain eq 'public') {
                   4782:         %domdesign = &get_domainconf($domain);
                   4783:     }
1.520     raeburn  4784:     my $output;
1.517     raeburn  4785:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4786:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4787:     } else {
1.520     raeburn  4788:         $output = $defaultdesign{$which};
                   4789:     }
                   4790:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4791:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4792:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4793:             if ($output =~ m{^/res/}) {
                   4794:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4795:                 &Apache::lonnet::repcopy($local_name);
                   4796:             }
1.520     raeburn  4797:             $output = &lonhttpdurl($output);
                   4798:         }
1.63      www      4799:     }
1.520     raeburn  4800:     return $output;
1.63      www      4801: }
1.59      www      4802: 
1.822     bisitz   4803: ##############################################
                   4804: =pod
                   4805: 
1.832     bisitz   4806: =item * &authorspace()
                   4807: 
1.1028    raeburn  4808: Inputs: $url (usually will be undef).
1.832     bisitz   4809: 
1.1028    raeburn  4810: Returns: Path to Construction Space containing the resource or 
                   4811:          directory being viewed (or for which action is being taken). 
                   4812:          If $url is provided, and begins /priv/<domain>/<uname>
                   4813:          the path will be that portion of the $context argument.
                   4814:          Otherwise the path will be for the author space of the current
                   4815:          user when the current role is author, or for that of the 
                   4816:          co-author/assistant co-author space when the current role 
                   4817:          is co-author or assistant co-author.
1.832     bisitz   4818: 
                   4819: =cut
                   4820: 
                   4821: sub authorspace {
1.1028    raeburn  4822:     my ($url) = @_;
                   4823:     if ($url ne '') {
                   4824:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4825:            return $1;
                   4826:         }
                   4827:     }
1.832     bisitz   4828:     my $caname = '';
1.1024    www      4829:     my $cadom = '';
1.1028    raeburn  4830:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4831:         ($cadom,$caname) =
1.832     bisitz   4832:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4833:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4834:         $caname = $env{'user.name'};
1.1024    www      4835:         $cadom = $env{'user.domain'};
1.832     bisitz   4836:     }
1.1028    raeburn  4837:     if (($caname ne '') && ($cadom ne '')) {
                   4838:         return "/priv/$cadom/$caname/";
                   4839:     }
                   4840:     return;
1.832     bisitz   4841: }
                   4842: 
                   4843: ##############################################
                   4844: =pod
                   4845: 
1.822     bisitz   4846: =item * &head_subbox()
                   4847: 
                   4848: Inputs: $content (contains HTML code with page functions, etc.)
                   4849: 
                   4850: Returns: HTML div with $content
                   4851:          To be included in page header
                   4852: 
                   4853: =cut
                   4854: 
                   4855: sub head_subbox {
                   4856:     my ($content)=@_;
                   4857:     my $output =
1.993     raeburn  4858:         '<div class="LC_head_subbox">'
1.822     bisitz   4859:        .$content
                   4860:        .'</div>'
                   4861: }
                   4862: 
                   4863: ##############################################
                   4864: =pod
                   4865: 
                   4866: =item * &CSTR_pageheader()
                   4867: 
1.1026    raeburn  4868: Input: (optional) filename from which breadcrumb trail is built.
                   4869:        In most cases no input as needed, as $env{'request.filename'}
                   4870:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   4871: 
                   4872: Returns: HTML div with CSTR path and recent box
                   4873:          To be included on Construction Space pages
                   4874: 
                   4875: =cut
                   4876: 
                   4877: sub CSTR_pageheader {
1.1026    raeburn  4878:     my ($trailfile) = @_;
                   4879:     if ($trailfile eq '') {
                   4880:         $trailfile = $env{'request.filename'};
                   4881:     }
                   4882: 
                   4883: # this is for resources; directories have customtitle, and crumbs
                   4884: # and select recent are created in lonpubdir.pm
                   4885: 
                   4886:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      4887:     my ($udom,$uname,$thisdisfn)=
1.1026    raeburn  4888:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)/(.*)$});
                   4889:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   4890:     $formaction =~ s{/+}{/}g;
1.822     bisitz   4891: 
                   4892:     my $parentpath = '';
                   4893:     my $lastitem = '';
                   4894:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   4895:         $parentpath = $1;
                   4896:         $lastitem = $2;
                   4897:     } else {
                   4898:         $lastitem = $thisdisfn;
                   4899:     }
1.921     bisitz   4900: 
                   4901:     my $output =
1.822     bisitz   4902:          '<div>'
                   4903:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
                   4904:         .'<b>'.&mt('Construction Space:').'</b> '
                   4905:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   4906:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      4907:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   4908: 
                   4909:     if ($lastitem) {
                   4910:         $output .=
                   4911:              '<span class="LC_filename">'
                   4912:             .$lastitem
                   4913:             .'</span>';
                   4914:     }
                   4915:     $output .=
                   4916:          '<br />'
1.822     bisitz   4917:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   4918:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   4919:         .'</form>'
                   4920:         .&Apache::lonmenu::constspaceform()
                   4921:         .'</div>';
1.921     bisitz   4922: 
                   4923:     return $output;
1.822     bisitz   4924: }
                   4925: 
1.60      matthew  4926: ###############################################
                   4927: ###############################################
                   4928: 
                   4929: =pod
                   4930: 
1.112     bowersj2 4931: =back
                   4932: 
1.549     albertel 4933: =head1 HTML Helpers
1.112     bowersj2 4934: 
                   4935: =over 4
                   4936: 
                   4937: =item * &bodytag()
1.60      matthew  4938: 
                   4939: Returns a uniform header for LON-CAPA web pages.
                   4940: 
                   4941: Inputs: 
                   4942: 
1.112     bowersj2 4943: =over 4
                   4944: 
                   4945: =item * $title, A title to be displayed on the page.
                   4946: 
                   4947: =item * $function, the current role (can be undef).
                   4948: 
                   4949: =item * $addentries, extra parameters for the <body> tag.
                   4950: 
                   4951: =item * $bodyonly, if defined, only return the <body> tag.
                   4952: 
                   4953: =item * $domain, if defined, force a given domain.
                   4954: 
                   4955: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      4956:             text interface only)
1.60      matthew  4957: 
1.814     bisitz   4958: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   4959:                      navigational links
1.317     albertel 4960: 
1.338     albertel 4961: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   4962: 
1.1075.2.12  raeburn  4963: =item * $no_inline_link, if true and in remote mode, don't show the
                   4964:          'Switch To Inline Menu' link
                   4965: 
1.460     albertel 4966: =item * $args, optional argument valid values are
                   4967:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 4968:             inherit_jsmath -> when creating popup window in a page,
                   4969:                               should it have jsmath forced on by the
                   4970:                               current page
1.460     albertel 4971: 
1.1075.2.15! raeburn  4972: =item * $advtoolsref, optional argument, ref to an array containing
        !          4973:             inlineremote items to be added in "Functions" menu below
        !          4974:             breadcrumbs.
        !          4975: 
1.112     bowersj2 4976: =back
                   4977: 
1.60      matthew  4978: Returns: A uniform header for LON-CAPA web pages.  
                   4979: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   4980: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   4981: other decorations will be returned.
                   4982: 
                   4983: =cut
                   4984: 
1.54      www      4985: sub bodytag {
1.831     bisitz   4986:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15! raeburn  4987:         $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339     albertel 4988: 
1.954     raeburn  4989:     my $public;
                   4990:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   4991:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   4992:         $public = 1;
                   4993:     }
1.460     albertel 4994:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339     albertel 4995: 
1.183     matthew  4996:     $function = &get_users_function() if (!$function);
1.339     albertel 4997:     my $img =    &designparm($function.'.img',$domain);
                   4998:     my $font =   &designparm($function.'.font',$domain);
                   4999:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5000: 
1.803     bisitz   5001:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5002: 		   'bgcolor' => $pgbg,
1.339     albertel 5003: 		   'text'    => $font,
                   5004:                    'alink'   => &designparm($function.'.alink',$domain),
                   5005: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5006: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5007:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5008: 
1.63      www      5009:  # role and realm
1.378     raeburn  5010:     my ($role,$realm) = split(/\./,$env{'request.role'},2);
                   5011:     if ($role  eq 'ca') {
1.479     albertel 5012:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5013:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5014:     } 
1.55      www      5015: # realm
1.258     albertel 5016:     if ($env{'request.course.id'}) {
1.378     raeburn  5017:         if ($env{'request.role'} !~ /^cr/) {
                   5018:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5019:         }
1.898     raeburn  5020:         if ($env{'request.course.sec'}) {
                   5021:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5022:         }   
1.359     albertel 5023: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5024:     } else {
                   5025:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5026:     }
1.433     albertel 5027: 
1.359     albertel 5028:     if (!$realm) { $realm='&nbsp;'; }
1.1075.2.12  raeburn  5029: # Set messages
                   5030:     my $messages=&domainlogo($domain);
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: 
                   5071:     unless ($env{'environment.remote'} eq 'on') {
1.903     droeschl 5072: 
                   5073:         #    if ($env{'request.state'} eq 'construct') {
                   5074:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5075:         #    }
                   5076: 
1.359     albertel 5077: 
1.1075.2.2  raeburn  5078: 
1.916     droeschl 5079:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.1  raeburn  5080:             unless ($env{'request.noversionuri'} =~ m{/res/adm/pages/bookmarkmenu/}) {
                   5081:                 if ($dc_info) {
                   5082:                      $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   5083:                 }
                   5084:                 $bodytag .= qq|<div id="LC_nav_bar">$name $role<br />
                   5085:                                <em>$realm</em> $dc_info</div>|;
                   5086:             }
1.903     droeschl 5087:             return $bodytag;
                   5088:         }
1.894     droeschl 5089: 
1.927     raeburn  5090:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
                   5091:             $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>|;
                   5092:         }
1.916     droeschl 5093: 
1.903     droeschl 5094:         $bodytag .= Apache::lonhtmlcommon::scripttag(
                   5095:             Apache::lonmenu::utilityfunctions(), 'start');
1.816     bisitz   5096: 
1.903     droeschl 5097:         $bodytag .= Apache::lonmenu::primary_menu();
1.852     droeschl 5098: 
1.917     raeburn  5099:         if ($dc_info) {
                   5100:             $dc_info = &dc_courseid_toggle($dc_info);
                   5101:         }
                   5102:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5103: 
1.903     droeschl 5104:         #don't show menus for public users
1.954     raeburn  5105:         if (!$public){
1.903     droeschl 5106:             $bodytag .= Apache::lonmenu::secondary_menu();
                   5107:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5108:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5109:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5110:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5111:                                 $args->{'bread_crumbs'});
                   5112:             } elsif ($forcereg) { 
                   5113:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg);
1.1075.2.15! raeburn  5114:             } else {
        !          5115:                 $bodytag .=
        !          5116:                     &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
        !          5117:                                                         $forcereg,$args->{'group'},
        !          5118:                                                         $args->{'bread_crumbs'},
        !          5119:                                                         $advtoolsref);
1.920     raeburn  5120:             }
1.903     droeschl 5121:         }else{
                   5122:             # this is to seperate menu from content when there's no secondary
                   5123:             # menu. Especially needed for public accessible ressources.
                   5124:             $bodytag .= '<hr style="clear:both" />';
                   5125:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5126:         }
1.903     droeschl 5127: 
1.235     raeburn  5128:         return $bodytag;
1.1075.2.12  raeburn  5129:     }
                   5130: 
                   5131: #
                   5132: # Top frame rendering, Remote is up
                   5133: #
                   5134: 
                   5135:     my $imgsrc = $img;
                   5136:     if ($img =~ /^\/adm/) {
                   5137:         $imgsrc = &lonhttpdurl($img);
                   5138:     }
                   5139:     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
                   5140: 
                   5141:     # Explicit link to get inline menu
                   5142:     my $menu= ($no_inline_link?''
                   5143:                :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
                   5144: 
                   5145:     if ($dc_info) {
                   5146:         $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
                   5147:     }
                   5148: 
                   5149:     unless ($env{'form.inhibitmenu'}) {
                   5150:         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
                   5151:                        <ol class="LC_primary_menu LC_right">
                   5152:                        <li>$menu</li>
                   5153:                        </ol><div id="LC_realm"> $realm $dc_info</div>|;
                   5154:     }
1.1075.2.13  raeburn  5155:     my $funclist;
                   5156:     if ($env{'request.state'} eq 'construct') {
                   5157:         if (!$public){
                   5158:             if ($env{'request.state'} eq 'construct') {
                   5159:                 $funclist = &Apache::lonhtmlcommon::scripttag(
                   5160:                                 &Apache::lonmenu::utilityfunctions(), 'start').
                   5161:                             &Apache::lonhtmlcommon::scripttag('','end').
                   5162:                             &Apache::lonmenu::innerregister($forcereg,
                   5163:                                                             $args->{'bread_crumbs'});
                   5164:             }
                   5165:         }
                   5166:     }
1.1075.2.12  raeburn  5167:     return(<<ENDBODY);
                   5168: $bodytag
                   5169: <table id="LC_title_bar" class="LC_with_remote">
                   5170: <tr><td>$upperleft</td>
                   5171:     <td>$messages&nbsp;</td>
                   5172: </tr>
                   5173: <tr><td>$titleinfo $dc_info $menu</td>
                   5174: </tr>
                   5175: </table>
1.1075.2.13  raeburn  5176: $funclist
1.1075.2.12  raeburn  5177: ENDBODY
1.182     matthew  5178: }
                   5179: 
1.917     raeburn  5180: sub dc_courseid_toggle {
                   5181:     my ($dc_info) = @_;
1.980     raeburn  5182:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5183:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5184:            &mt('(More ...)').'</a></span>'.
                   5185:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5186: }
                   5187: 
1.330     albertel 5188: sub make_attr_string {
                   5189:     my ($register,$attr_ref) = @_;
                   5190: 
                   5191:     if ($attr_ref && !ref($attr_ref)) {
                   5192: 	die("addentries Must be a hash ref ".
                   5193: 	    join(':',caller(1))." ".
                   5194: 	    join(':',caller(0))." ");
                   5195:     }
                   5196: 
                   5197:     if ($register) {
1.339     albertel 5198: 	my ($on_load,$on_unload);
                   5199: 	foreach my $key (keys(%{$attr_ref})) {
                   5200: 	    if      (lc($key) eq 'onload') {
                   5201: 		$on_load.=$attr_ref->{$key}.';';
                   5202: 		delete($attr_ref->{$key});
                   5203: 
                   5204: 	    } elsif (lc($key) eq 'onunload') {
                   5205: 		$on_unload.=$attr_ref->{$key}.';';
                   5206: 		delete($attr_ref->{$key});
                   5207: 	    }
                   5208: 	}
1.1075.2.12  raeburn  5209:         if ($env{'environment.remote'} eq 'on') {
                   5210:             $attr_ref->{'onload'}  =
                   5211:                 &Apache::lonmenu::loadevents().  $on_load;
                   5212:             $attr_ref->{'onunload'}=
                   5213:                 &Apache::lonmenu::unloadevents().$on_unload;
                   5214:         } else {  
                   5215: 	    $attr_ref->{'onload'}  = $on_load;
                   5216: 	    $attr_ref->{'onunload'}= $on_unload;
                   5217:         }
1.330     albertel 5218:     }
1.339     albertel 5219: 
1.330     albertel 5220:     my $attr_string;
                   5221:     foreach my $attr (keys(%$attr_ref)) {
                   5222: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5223:     }
                   5224:     return $attr_string;
                   5225: }
                   5226: 
                   5227: 
1.182     matthew  5228: ###############################################
1.251     albertel 5229: ###############################################
                   5230: 
                   5231: =pod
                   5232: 
                   5233: =item * &endbodytag()
                   5234: 
                   5235: Returns a uniform footer for LON-CAPA web pages.
                   5236: 
1.635     raeburn  5237: Inputs: 1 - optional reference to an args hash
                   5238: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5239: a 'Continue' link is not displayed if the page contains an
                   5240: internal redirect in the <head></head> section,
                   5241: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5242: 
                   5243: =cut
                   5244: 
                   5245: sub endbodytag {
1.635     raeburn  5246:     my ($args) = @_;
1.1075.2.6  raeburn  5247:     my $endbodytag;
                   5248:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5249:         $endbodytag='</body>';
                   5250:     }
1.269     albertel 5251:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 5252:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5253:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5254: 	    $endbodytag=
                   5255: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5256: 	        &mt('Continue').'</a>'.
                   5257: 	        $endbodytag;
                   5258:         }
1.315     albertel 5259:     }
1.251     albertel 5260:     return $endbodytag;
                   5261: }
                   5262: 
1.352     albertel 5263: =pod
                   5264: 
                   5265: =item * &standard_css()
                   5266: 
                   5267: Returns a style sheet
                   5268: 
                   5269: Inputs: (all optional)
                   5270:             domain         -> force to color decorate a page for a specific
                   5271:                                domain
                   5272:             function       -> force usage of a specific rolish color scheme
                   5273:             bgcolor        -> override the default page bgcolor
                   5274: 
                   5275: =cut
                   5276: 
1.343     albertel 5277: sub standard_css {
1.345     albertel 5278:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5279:     $function  = &get_users_function() if (!$function);
                   5280:     my $img    = &designparm($function.'.img',   $domain);
                   5281:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5282:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5283:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5284: #second colour for later usage
1.345     albertel 5285:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5286:     my $pgbg_or_bgcolor =
                   5287: 	         $bgcolor ||
1.352     albertel 5288: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5289:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5290:     my $alink  = &designparm($function.'.alink', $domain);
                   5291:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5292:     my $link   = &designparm($function.'.link',  $domain);
                   5293: 
1.602     albertel 5294:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5295:     my $mono                 = 'monospace';
1.850     bisitz   5296:     my $data_table_head      = $sidebg;
                   5297:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5298:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5299:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5300:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5301:     my $mail_new             = '#FFBB77';
                   5302:     my $mail_new_hover       = '#DD9955';
                   5303:     my $mail_read            = '#BBBB77';
                   5304:     my $mail_read_hover      = '#999944';
                   5305:     my $mail_replied         = '#AAAA88';
                   5306:     my $mail_replied_hover   = '#888855';
                   5307:     my $mail_other           = '#99BBBB';
                   5308:     my $mail_other_hover     = '#669999';
1.391     albertel 5309:     my $table_header         = '#DDDDDD';
1.489     raeburn  5310:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5311:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5312:     my $button_hover         = '#BF2317';
1.392     albertel 5313: 
1.608     albertel 5314:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5315:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5316:                                              : '0 3px 0 4px';
1.448     albertel 5317: 
1.523     albertel 5318: 
1.343     albertel 5319:     return <<END;
1.947     droeschl 5320: 
                   5321: /* needed for iframe to allow 100% height in FF */
                   5322: body, html { 
                   5323:     margin: 0;
                   5324:     padding: 0 0.5%;
                   5325:     height: 99%; /* to avoid scrollbars */
                   5326: }
                   5327: 
1.795     www      5328: body {
1.911     bisitz   5329:   font-family: $sans;
                   5330:   line-height:130%;
                   5331:   font-size:0.83em;
                   5332:   color:$font;
1.795     www      5333: }
                   5334: 
1.959     onken    5335: a:focus,
                   5336: a:focus img {
1.795     www      5337:   color: red;
                   5338: }
1.698     harmsja  5339: 
1.911     bisitz   5340: form, .inline {
                   5341:   display: inline;
1.795     www      5342: }
1.721     harmsja  5343: 
1.795     www      5344: .LC_right {
1.911     bisitz   5345:   text-align:right;
1.795     www      5346: }
                   5347: 
                   5348: .LC_middle {
1.911     bisitz   5349:   vertical-align:middle;
1.795     www      5350: }
1.721     harmsja  5351: 
1.911     bisitz   5352: .LC_400Box {
                   5353:   width:400px;
                   5354: }
1.721     harmsja  5355: 
1.947     droeschl 5356: .LC_iframecontainer {
                   5357:     width: 98%;
                   5358:     margin: 0;
                   5359:     position: fixed;
                   5360:     top: 8.5em;
                   5361:     bottom: 0;
                   5362: }
                   5363: 
                   5364: .LC_iframecontainer iframe{
                   5365:     border: none;
                   5366:     width: 100%;
                   5367:     height: 100%;
                   5368: }
                   5369: 
1.778     bisitz   5370: .LC_filename {
                   5371:   font-family: $mono;
                   5372:   white-space:pre;
1.921     bisitz   5373:   font-size: 120%;
1.778     bisitz   5374: }
                   5375: 
                   5376: .LC_fileicon {
                   5377:   border: none;
                   5378:   height: 1.3em;
                   5379:   vertical-align: text-bottom;
                   5380:   margin-right: 0.3em;
                   5381:   text-decoration:none;
                   5382: }
                   5383: 
1.1008    www      5384: .LC_setting {
                   5385:   text-decoration:underline;
                   5386: }
                   5387: 
1.350     albertel 5388: .LC_error {
                   5389:   color: red;
                   5390: }
1.795     www      5391: 
1.1075.2.15! raeburn  5392: .LC_warning {
        !          5393:   color: darkorange;
        !          5394: }
        !          5395: 
1.457     albertel 5396: .LC_diff_removed {
1.733     bisitz   5397:   color: red;
1.394     albertel 5398: }
1.532     albertel 5399: 
                   5400: .LC_info,
1.457     albertel 5401: .LC_success,
                   5402: .LC_diff_added {
1.350     albertel 5403:   color: green;
                   5404: }
1.795     www      5405: 
1.802     bisitz   5406: div.LC_confirm_box {
                   5407:   background-color: #FAFAFA;
                   5408:   border: 1px solid $lg_border_color;
                   5409:   margin-right: 0;
                   5410:   padding: 5px;
                   5411: }
                   5412: 
                   5413: div.LC_confirm_box .LC_error img,
                   5414: div.LC_confirm_box .LC_success img {
                   5415:   vertical-align: middle;
                   5416: }
                   5417: 
1.440     albertel 5418: .LC_icon {
1.771     droeschl 5419:   border: none;
1.790     droeschl 5420:   vertical-align: middle;
1.771     droeschl 5421: }
                   5422: 
1.543     albertel 5423: .LC_docs_spacer {
                   5424:   width: 25px;
                   5425:   height: 1px;
1.771     droeschl 5426:   border: none;
1.543     albertel 5427: }
1.346     albertel 5428: 
1.532     albertel 5429: .LC_internal_info {
1.735     bisitz   5430:   color: #999999;
1.532     albertel 5431: }
                   5432: 
1.794     www      5433: .LC_discussion {
1.1050    www      5434:   background: $data_table_dark;
1.911     bisitz   5435:   border: 1px solid black;
                   5436:   margin: 2px;
1.794     www      5437: }
                   5438: 
                   5439: .LC_disc_action_left {
1.1050    www      5440:   background: $sidebg;
1.911     bisitz   5441:   text-align: left;
1.1050    www      5442:   padding: 4px;
                   5443:   margin: 2px;
1.794     www      5444: }
                   5445: 
                   5446: .LC_disc_action_right {
1.1050    www      5447:   background: $sidebg;
1.911     bisitz   5448:   text-align: right;
1.1050    www      5449:   padding: 4px;
                   5450:   margin: 2px;
1.794     www      5451: }
                   5452: 
                   5453: .LC_disc_new_item {
1.911     bisitz   5454:   background: white;
                   5455:   border: 2px solid red;
1.1050    www      5456:   margin: 4px;
                   5457:   padding: 4px;
1.794     www      5458: }
                   5459: 
                   5460: .LC_disc_old_item {
1.911     bisitz   5461:   background: white;
1.1050    www      5462:   margin: 4px;
                   5463:   padding: 4px;
1.794     www      5464: }
                   5465: 
1.458     albertel 5466: table.LC_pastsubmission {
                   5467:   border: 1px solid black;
                   5468:   margin: 2px;
                   5469: }
                   5470: 
1.924     bisitz   5471: table#LC_menubuttons {
1.345     albertel 5472:   width: 100%;
                   5473:   background: $pgbg;
1.392     albertel 5474:   border: 2px;
1.402     albertel 5475:   border-collapse: separate;
1.803     bisitz   5476:   padding: 0;
1.345     albertel 5477: }
1.392     albertel 5478: 
1.801     tempelho 5479: table#LC_title_bar a {
                   5480:   color: $fontmenu;
                   5481: }
1.836     bisitz   5482: 
1.807     droeschl 5483: table#LC_title_bar {
1.819     tempelho 5484:   clear: both;
1.836     bisitz   5485:   display: none;
1.807     droeschl 5486: }
                   5487: 
1.795     www      5488: table#LC_title_bar,
1.933     droeschl 5489: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5490: table#LC_title_bar.LC_with_remote {
1.359     albertel 5491:   width: 100%;
1.392     albertel 5492:   border-color: $pgbg;
                   5493:   border-style: solid;
                   5494:   border-width: $border;
1.379     albertel 5495:   background: $pgbg;
1.801     tempelho 5496:   color: $fontmenu;
1.392     albertel 5497:   border-collapse: collapse;
1.803     bisitz   5498:   padding: 0;
1.819     tempelho 5499:   margin: 0;
1.359     albertel 5500: }
1.795     www      5501: 
1.933     droeschl 5502: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5503:     margin: 0;
                   5504:     padding: 0;
1.933     droeschl 5505:     position: relative;
                   5506:     list-style: none;
1.913     droeschl 5507: }
1.933     droeschl 5508: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5509:     display: inline;
                   5510: }
1.933     droeschl 5511: 
                   5512: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5513:     padding: 0;
1.933     droeschl 5514:     margin: 0;
                   5515:     float: left;
1.913     droeschl 5516: }
1.933     droeschl 5517: .LC_breadcrumb_tools_tools {
                   5518:     padding: 0;
                   5519:     margin: 0;
1.913     droeschl 5520:     float: right;
                   5521: }
                   5522: 
1.359     albertel 5523: table#LC_title_bar td {
                   5524:   background: $tabbg;
                   5525: }
1.795     www      5526: 
1.911     bisitz   5527: table#LC_menubuttons img {
1.803     bisitz   5528:   border: none;
1.346     albertel 5529: }
1.795     www      5530: 
1.842     droeschl 5531: .LC_breadcrumbs_component {
1.911     bisitz   5532:   float: right;
                   5533:   margin: 0 1em;
1.357     albertel 5534: }
1.842     droeschl 5535: .LC_breadcrumbs_component img {
1.911     bisitz   5536:   vertical-align: middle;
1.777     tempelho 5537: }
1.795     www      5538: 
1.383     albertel 5539: td.LC_table_cell_checkbox {
                   5540:   text-align: center;
                   5541: }
1.795     www      5542: 
                   5543: .LC_fontsize_small {
1.911     bisitz   5544:   font-size: 70%;
1.705     tempelho 5545: }
                   5546: 
1.844     bisitz   5547: #LC_breadcrumbs {
1.911     bisitz   5548:   clear:both;
                   5549:   background: $sidebg;
                   5550:   border-bottom: 1px solid $lg_border_color;
                   5551:   line-height: 2.5em;
1.933     droeschl 5552:   overflow: hidden;
1.911     bisitz   5553:   margin: 0;
                   5554:   padding: 0;
1.995     raeburn  5555:   text-align: left;
1.819     tempelho 5556: }
1.862     bisitz   5557: 
1.993     raeburn  5558: .LC_head_subbox {
1.911     bisitz   5559:   clear:both;
                   5560:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5561:   border: 1px solid $sidebg;
                   5562:   margin: 0 0 10px 0;      
1.966     bisitz   5563:   padding: 3px;
1.995     raeburn  5564:   text-align: left;
1.822     bisitz   5565: }
                   5566: 
1.795     www      5567: .LC_fontsize_medium {
1.911     bisitz   5568:   font-size: 85%;
1.705     tempelho 5569: }
                   5570: 
1.795     www      5571: .LC_fontsize_large {
1.911     bisitz   5572:   font-size: 120%;
1.705     tempelho 5573: }
                   5574: 
1.346     albertel 5575: .LC_menubuttons_inline_text {
                   5576:   color: $font;
1.698     harmsja  5577:   font-size: 90%;
1.701     harmsja  5578:   padding-left:3px;
1.346     albertel 5579: }
                   5580: 
1.934     droeschl 5581: .LC_menubuttons_inline_text img{
                   5582:   vertical-align: middle;
                   5583: }
                   5584: 
1.1051    www      5585: li.LC_menubuttons_inline_text img {
1.951     onken    5586:   cursor:pointer;
1.1002    droeschl 5587:   text-decoration: none;
1.951     onken    5588: }
                   5589: 
1.526     www      5590: .LC_menubuttons_link {
                   5591:   text-decoration: none;
                   5592: }
1.795     www      5593: 
1.522     albertel 5594: .LC_menubuttons_category {
1.521     www      5595:   color: $font;
1.526     www      5596:   background: $pgbg;
1.521     www      5597:   font-size: larger;
                   5598:   font-weight: bold;
                   5599: }
                   5600: 
1.346     albertel 5601: td.LC_menubuttons_text {
1.911     bisitz   5602:   color: $font;
1.346     albertel 5603: }
1.706     harmsja  5604: 
1.346     albertel 5605: .LC_current_location {
                   5606:   background: $tabbg;
                   5607: }
1.795     www      5608: 
1.938     bisitz   5609: table.LC_data_table {
1.347     albertel 5610:   border: 1px solid #000000;
1.402     albertel 5611:   border-collapse: separate;
1.426     albertel 5612:   border-spacing: 1px;
1.610     albertel 5613:   background: $pgbg;
1.347     albertel 5614: }
1.795     www      5615: 
1.422     albertel 5616: .LC_data_table_dense {
                   5617:   font-size: small;
                   5618: }
1.795     www      5619: 
1.507     raeburn  5620: table.LC_nested_outer {
                   5621:   border: 1px solid #000000;
1.589     raeburn  5622:   border-collapse: collapse;
1.803     bisitz   5623:   border-spacing: 0;
1.507     raeburn  5624:   width: 100%;
                   5625: }
1.795     www      5626: 
1.879     raeburn  5627: table.LC_innerpickbox,
1.507     raeburn  5628: table.LC_nested {
1.803     bisitz   5629:   border: none;
1.589     raeburn  5630:   border-collapse: collapse;
1.803     bisitz   5631:   border-spacing: 0;
1.507     raeburn  5632:   width: 100%;
                   5633: }
1.795     www      5634: 
1.911     bisitz   5635: table.LC_data_table tr th,
                   5636: table.LC_calendar tr th,
1.879     raeburn  5637: table.LC_prior_tries tr th,
                   5638: table.LC_innerpickbox tr th {
1.349     albertel 5639:   font-weight: bold;
                   5640:   background-color: $data_table_head;
1.801     tempelho 5641:   color:$fontmenu;
1.701     harmsja  5642:   font-size:90%;
1.347     albertel 5643: }
1.795     www      5644: 
1.879     raeburn  5645: table.LC_innerpickbox tr th,
                   5646: table.LC_innerpickbox tr td {
                   5647:   vertical-align: top;
                   5648: }
                   5649: 
1.711     raeburn  5650: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5651:   background-color: #CCCCCC;
1.711     raeburn  5652:   font-weight: bold;
                   5653:   text-align: left;
                   5654: }
1.795     www      5655: 
1.912     bisitz   5656: table.LC_data_table tr.LC_odd_row > td {
                   5657:   background-color: $data_table_light;
                   5658:   padding: 2px;
                   5659:   vertical-align: top;
                   5660: }
                   5661: 
1.809     bisitz   5662: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5663:   background-color: $data_table_light;
1.912     bisitz   5664:   vertical-align: top;
                   5665: }
                   5666: 
                   5667: table.LC_data_table tr.LC_even_row > td {
                   5668:   background-color: $data_table_dark;
1.425     albertel 5669:   padding: 2px;
1.900     bisitz   5670:   vertical-align: top;
1.347     albertel 5671: }
1.795     www      5672: 
1.809     bisitz   5673: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5674:   background-color: $data_table_dark;
1.900     bisitz   5675:   vertical-align: top;
1.347     albertel 5676: }
1.795     www      5677: 
1.425     albertel 5678: table.LC_data_table tr.LC_data_table_highlight td {
                   5679:   background-color: $data_table_darker;
                   5680: }
1.795     www      5681: 
1.639     raeburn  5682: table.LC_data_table tr td.LC_leftcol_header {
                   5683:   background-color: $data_table_head;
                   5684:   font-weight: bold;
                   5685: }
1.795     www      5686: 
1.451     albertel 5687: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5688: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5689:   font-weight: bold;
                   5690:   font-style: italic;
                   5691:   text-align: center;
                   5692:   padding: 8px;
1.347     albertel 5693: }
1.795     www      5694: 
1.940     bisitz   5695: table.LC_data_table tr.LC_empty_row td {
                   5696:   background-color: $sidebg;
                   5697: }
                   5698: 
                   5699: table.LC_nested tr.LC_empty_row td {
                   5700:   background-color: #FFFFFF;
                   5701: }
                   5702: 
1.890     droeschl 5703: table.LC_caption {
                   5704: }
                   5705: 
1.507     raeburn  5706: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5707:   padding: 4ex
                   5708: }
1.795     www      5709: 
1.507     raeburn  5710: table.LC_nested_outer tr th {
                   5711:   font-weight: bold;
1.801     tempelho 5712:   color:$fontmenu;
1.507     raeburn  5713:   background-color: $data_table_head;
1.701     harmsja  5714:   font-size: small;
1.507     raeburn  5715:   border-bottom: 1px solid #000000;
                   5716: }
1.795     www      5717: 
1.507     raeburn  5718: table.LC_nested_outer tr td.LC_subheader {
                   5719:   background-color: $data_table_head;
                   5720:   font-weight: bold;
                   5721:   font-size: small;
                   5722:   border-bottom: 1px solid #000000;
                   5723:   text-align: right;
1.451     albertel 5724: }
1.795     www      5725: 
1.507     raeburn  5726: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5727:   background-color: #CCCCCC;
1.451     albertel 5728:   font-weight: bold;
                   5729:   font-size: small;
1.507     raeburn  5730:   text-align: center;
                   5731: }
1.795     www      5732: 
1.589     raeburn  5733: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5734: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5735:   text-align: left;
1.451     albertel 5736: }
1.795     www      5737: 
1.507     raeburn  5738: table.LC_nested td {
1.735     bisitz   5739:   background-color: #FFFFFF;
1.451     albertel 5740:   font-size: small;
1.507     raeburn  5741: }
1.795     www      5742: 
1.507     raeburn  5743: table.LC_nested_outer tr th.LC_right_item,
                   5744: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5745: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5746: table.LC_nested tr td.LC_right_item {
1.451     albertel 5747:   text-align: right;
                   5748: }
                   5749: 
1.507     raeburn  5750: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5751:   background-color: #EEEEEE;
1.451     albertel 5752: }
                   5753: 
1.473     raeburn  5754: table.LC_createuser {
                   5755: }
                   5756: 
                   5757: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5758:   font-size: small;
1.473     raeburn  5759: }
                   5760: 
                   5761: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5762:   background-color: #CCCCCC;
1.473     raeburn  5763:   font-weight: bold;
                   5764:   text-align: center;
                   5765: }
                   5766: 
1.349     albertel 5767: table.LC_calendar {
                   5768:   border: 1px solid #000000;
                   5769:   border-collapse: collapse;
1.917     raeburn  5770:   width: 98%;
1.349     albertel 5771: }
1.795     www      5772: 
1.349     albertel 5773: table.LC_calendar_pickdate {
                   5774:   font-size: xx-small;
                   5775: }
1.795     www      5776: 
1.349     albertel 5777: table.LC_calendar tr td {
                   5778:   border: 1px solid #000000;
                   5779:   vertical-align: top;
1.917     raeburn  5780:   width: 14%;
1.349     albertel 5781: }
1.795     www      5782: 
1.349     albertel 5783: table.LC_calendar tr td.LC_calendar_day_empty {
                   5784:   background-color: $data_table_dark;
                   5785: }
1.795     www      5786: 
1.779     bisitz   5787: table.LC_calendar tr td.LC_calendar_day_current {
                   5788:   background-color: $data_table_highlight;
1.777     tempelho 5789: }
1.795     www      5790: 
1.938     bisitz   5791: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5792:   background-color: $mail_new;
                   5793: }
1.795     www      5794: 
1.938     bisitz   5795: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5796:   background-color: $mail_new_hover;
                   5797: }
1.795     www      5798: 
1.938     bisitz   5799: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5800:   background-color: $mail_read;
                   5801: }
1.795     www      5802: 
1.938     bisitz   5803: /*
                   5804: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5805:   background-color: $mail_read_hover;
                   5806: }
1.938     bisitz   5807: */
1.795     www      5808: 
1.938     bisitz   5809: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5810:   background-color: $mail_replied;
                   5811: }
1.795     www      5812: 
1.938     bisitz   5813: /*
                   5814: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5815:   background-color: $mail_replied_hover;
                   5816: }
1.938     bisitz   5817: */
1.795     www      5818: 
1.938     bisitz   5819: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5820:   background-color: $mail_other;
                   5821: }
1.795     www      5822: 
1.938     bisitz   5823: /*
                   5824: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5825:   background-color: $mail_other_hover;
                   5826: }
1.938     bisitz   5827: */
1.494     raeburn  5828: 
1.777     tempelho 5829: table.LC_data_table tr > td.LC_browser_file,
                   5830: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5831:   background: #AAEE77;
1.389     albertel 5832: }
1.795     www      5833: 
1.777     tempelho 5834: table.LC_data_table tr > td.LC_browser_file_locked,
                   5835: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5836:   background: #FFAA99;
1.387     albertel 5837: }
1.795     www      5838: 
1.777     tempelho 5839: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5840:   background: #888888;
1.779     bisitz   5841: }
1.795     www      5842: 
1.777     tempelho 5843: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5844: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5845:   background: #F8F866;
1.777     tempelho 5846: }
1.795     www      5847: 
1.696     bisitz   5848: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5849:   background: #E0E8FF;
1.387     albertel 5850: }
1.696     bisitz   5851: 
1.707     bisitz   5852: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5853:   /* background: #77FF77; */
1.707     bisitz   5854: }
1.795     www      5855: 
1.707     bisitz   5856: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5857:   border-right: 8px solid #FFFF77;
1.707     bisitz   5858: }
1.795     www      5859: 
1.707     bisitz   5860: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5861:   border-right: 8px solid #FFAA77;
1.707     bisitz   5862: }
1.795     www      5863: 
1.707     bisitz   5864: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5865:   border-right: 8px solid #FF7777;
1.707     bisitz   5866: }
1.795     www      5867: 
1.707     bisitz   5868: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5869:   border-right: 8px solid #AAFF77;
1.707     bisitz   5870: }
1.795     www      5871: 
1.707     bisitz   5872: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5873:   border-right: 8px solid #11CC55;
1.707     bisitz   5874: }
                   5875: 
1.388     albertel 5876: span.LC_current_location {
1.701     harmsja  5877:   font-size:larger;
1.388     albertel 5878:   background: $pgbg;
                   5879: }
1.387     albertel 5880: 
1.1029    www      5881: span.LC_current_nav_location {
                   5882:   font-weight:bold;
                   5883:   background: $sidebg;
                   5884: }
                   5885: 
1.395     albertel 5886: span.LC_parm_menu_item {
                   5887:   font-size: larger;
                   5888: }
1.795     www      5889: 
1.395     albertel 5890: span.LC_parm_scope_all {
                   5891:   color: red;
                   5892: }
1.795     www      5893: 
1.395     albertel 5894: span.LC_parm_scope_folder {
                   5895:   color: green;
                   5896: }
1.795     www      5897: 
1.395     albertel 5898: span.LC_parm_scope_resource {
                   5899:   color: orange;
                   5900: }
1.795     www      5901: 
1.395     albertel 5902: span.LC_parm_part {
                   5903:   color: blue;
                   5904: }
1.795     www      5905: 
1.911     bisitz   5906: span.LC_parm_folder,
                   5907: span.LC_parm_symb {
1.395     albertel 5908:   font-size: x-small;
                   5909:   font-family: $mono;
                   5910:   color: #AAAAAA;
                   5911: }
                   5912: 
1.977     bisitz   5913: ul.LC_parm_parmlist li {
                   5914:   display: inline-block;
                   5915:   padding: 0.3em 0.8em;
                   5916:   vertical-align: top;
                   5917:   width: 150px;
                   5918:   border-top:1px solid $lg_border_color;
                   5919: }
                   5920: 
1.795     www      5921: td.LC_parm_overview_level_menu,
                   5922: td.LC_parm_overview_map_menu,
                   5923: td.LC_parm_overview_parm_selectors,
                   5924: td.LC_parm_overview_restrictions  {
1.396     albertel 5925:   border: 1px solid black;
                   5926:   border-collapse: collapse;
                   5927: }
1.795     www      5928: 
1.396     albertel 5929: table.LC_parm_overview_restrictions td {
                   5930:   border-width: 1px 4px 1px 4px;
                   5931:   border-style: solid;
                   5932:   border-color: $pgbg;
                   5933:   text-align: center;
                   5934: }
1.795     www      5935: 
1.396     albertel 5936: table.LC_parm_overview_restrictions th {
                   5937:   background: $tabbg;
                   5938:   border-width: 1px 4px 1px 4px;
                   5939:   border-style: solid;
                   5940:   border-color: $pgbg;
                   5941: }
1.795     www      5942: 
1.398     albertel 5943: table#LC_helpmenu {
1.803     bisitz   5944:   border: none;
1.398     albertel 5945:   height: 55px;
1.803     bisitz   5946:   border-spacing: 0;
1.398     albertel 5947: }
                   5948: 
                   5949: table#LC_helpmenu fieldset legend {
                   5950:   font-size: larger;
                   5951: }
1.795     www      5952: 
1.397     albertel 5953: table#LC_helpmenu_links {
                   5954:   width: 100%;
                   5955:   border: 1px solid black;
                   5956:   background: $pgbg;
1.803     bisitz   5957:   padding: 0;
1.397     albertel 5958:   border-spacing: 1px;
                   5959: }
1.795     www      5960: 
1.397     albertel 5961: table#LC_helpmenu_links tr td {
                   5962:   padding: 1px;
                   5963:   background: $tabbg;
1.399     albertel 5964:   text-align: center;
                   5965:   font-weight: bold;
1.397     albertel 5966: }
1.396     albertel 5967: 
1.795     www      5968: table#LC_helpmenu_links a:link,
                   5969: table#LC_helpmenu_links a:visited,
1.397     albertel 5970: table#LC_helpmenu_links a:active {
                   5971:   text-decoration: none;
                   5972:   color: $font;
                   5973: }
1.795     www      5974: 
1.397     albertel 5975: table#LC_helpmenu_links a:hover {
                   5976:   text-decoration: underline;
                   5977:   color: $vlink;
                   5978: }
1.396     albertel 5979: 
1.417     albertel 5980: .LC_chrt_popup_exists {
                   5981:   border: 1px solid #339933;
                   5982:   margin: -1px;
                   5983: }
1.795     www      5984: 
1.417     albertel 5985: .LC_chrt_popup_up {
                   5986:   border: 1px solid yellow;
                   5987:   margin: -1px;
                   5988: }
1.795     www      5989: 
1.417     albertel 5990: .LC_chrt_popup {
                   5991:   border: 1px solid #8888FF;
                   5992:   background: #CCCCFF;
                   5993: }
1.795     www      5994: 
1.421     albertel 5995: table.LC_pick_box {
                   5996:   border-collapse: separate;
                   5997:   background: white;
                   5998:   border: 1px solid black;
                   5999:   border-spacing: 1px;
                   6000: }
1.795     www      6001: 
1.421     albertel 6002: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6003:   background: $sidebg;
1.421     albertel 6004:   font-weight: bold;
1.900     bisitz   6005:   text-align: left;
1.740     bisitz   6006:   vertical-align: top;
1.421     albertel 6007:   width: 184px;
                   6008:   padding: 8px;
                   6009: }
1.795     www      6010: 
1.579     raeburn  6011: table.LC_pick_box td.LC_pick_box_value {
                   6012:   text-align: left;
                   6013:   padding: 8px;
                   6014: }
1.795     www      6015: 
1.579     raeburn  6016: table.LC_pick_box td.LC_pick_box_select {
                   6017:   text-align: left;
                   6018:   padding: 8px;
                   6019: }
1.795     www      6020: 
1.424     albertel 6021: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6022:   padding: 0;
1.421     albertel 6023:   height: 1px;
                   6024:   background: black;
                   6025: }
1.795     www      6026: 
1.421     albertel 6027: table.LC_pick_box td.LC_pick_box_submit {
                   6028:   text-align: right;
                   6029: }
1.795     www      6030: 
1.579     raeburn  6031: table.LC_pick_box td.LC_evenrow_value {
                   6032:   text-align: left;
                   6033:   padding: 8px;
                   6034:   background-color: $data_table_light;
                   6035: }
1.795     www      6036: 
1.579     raeburn  6037: table.LC_pick_box td.LC_oddrow_value {
                   6038:   text-align: left;
                   6039:   padding: 8px;
                   6040:   background-color: $data_table_light;
                   6041: }
1.795     www      6042: 
1.579     raeburn  6043: span.LC_helpform_receipt_cat {
                   6044:   font-weight: bold;
                   6045: }
1.795     www      6046: 
1.424     albertel 6047: table.LC_group_priv_box {
                   6048:   background: white;
                   6049:   border: 1px solid black;
                   6050:   border-spacing: 1px;
                   6051: }
1.795     www      6052: 
1.424     albertel 6053: table.LC_group_priv_box td.LC_pick_box_title {
                   6054:   background: $tabbg;
                   6055:   font-weight: bold;
                   6056:   text-align: right;
                   6057:   width: 184px;
                   6058: }
1.795     www      6059: 
1.424     albertel 6060: table.LC_group_priv_box td.LC_groups_fixed {
                   6061:   background: $data_table_light;
                   6062:   text-align: center;
                   6063: }
1.795     www      6064: 
1.424     albertel 6065: table.LC_group_priv_box td.LC_groups_optional {
                   6066:   background: $data_table_dark;
                   6067:   text-align: center;
                   6068: }
1.795     www      6069: 
1.424     albertel 6070: table.LC_group_priv_box td.LC_groups_functionality {
                   6071:   background: $data_table_darker;
                   6072:   text-align: center;
                   6073:   font-weight: bold;
                   6074: }
1.795     www      6075: 
1.424     albertel 6076: table.LC_group_priv td {
                   6077:   text-align: left;
1.803     bisitz   6078:   padding: 0;
1.424     albertel 6079: }
                   6080: 
                   6081: .LC_navbuttons {
                   6082:   margin: 2ex 0ex 2ex 0ex;
                   6083: }
1.795     www      6084: 
1.423     albertel 6085: .LC_topic_bar {
                   6086:   font-weight: bold;
                   6087:   background: $tabbg;
1.918     wenzelju 6088:   margin: 1em 0em 1em 2em;
1.805     bisitz   6089:   padding: 3px;
1.918     wenzelju 6090:   font-size: 1.2em;
1.423     albertel 6091: }
1.795     www      6092: 
1.423     albertel 6093: .LC_topic_bar span {
1.918     wenzelju 6094:   left: 0.5em;
                   6095:   position: absolute;
1.423     albertel 6096:   vertical-align: middle;
1.918     wenzelju 6097:   font-size: 1.2em;
1.423     albertel 6098: }
1.795     www      6099: 
1.423     albertel 6100: table.LC_course_group_status {
                   6101:   margin: 20px;
                   6102: }
1.795     www      6103: 
1.423     albertel 6104: table.LC_status_selector td {
                   6105:   vertical-align: top;
                   6106:   text-align: center;
1.424     albertel 6107:   padding: 4px;
                   6108: }
1.795     www      6109: 
1.599     albertel 6110: div.LC_feedback_link {
1.616     albertel 6111:   clear: both;
1.829     kalberla 6112:   background: $sidebg;
1.779     bisitz   6113:   width: 100%;
1.829     kalberla 6114:   padding-bottom: 10px;
                   6115:   border: 1px $tabbg solid;
1.833     kalberla 6116:   height: 22px;
                   6117:   line-height: 22px;
                   6118:   padding-top: 5px;
                   6119: }
                   6120: 
                   6121: div.LC_feedback_link img {
                   6122:   height: 22px;
1.867     kalberla 6123:   vertical-align:middle;
1.829     kalberla 6124: }
                   6125: 
1.911     bisitz   6126: div.LC_feedback_link a {
1.829     kalberla 6127:   text-decoration: none;
1.489     raeburn  6128: }
1.795     www      6129: 
1.867     kalberla 6130: div.LC_comblock {
1.911     bisitz   6131:   display:inline;
1.867     kalberla 6132:   color:$font;
                   6133:   font-size:90%;
                   6134: }
                   6135: 
                   6136: div.LC_feedback_link div.LC_comblock {
                   6137:   padding-left:5px;
                   6138: }
                   6139: 
                   6140: div.LC_feedback_link div.LC_comblock a {
                   6141:   color:$font;
                   6142: }
                   6143: 
1.489     raeburn  6144: span.LC_feedback_link {
1.858     bisitz   6145:   /* background: $feedback_link_bg; */
1.599     albertel 6146:   font-size: larger;
                   6147: }
1.795     www      6148: 
1.599     albertel 6149: span.LC_message_link {
1.858     bisitz   6150:   /* background: $feedback_link_bg; */
1.599     albertel 6151:   font-size: larger;
                   6152:   position: absolute;
                   6153:   right: 1em;
1.489     raeburn  6154: }
1.421     albertel 6155: 
1.515     albertel 6156: table.LC_prior_tries {
1.524     albertel 6157:   border: 1px solid #000000;
                   6158:   border-collapse: separate;
                   6159:   border-spacing: 1px;
1.515     albertel 6160: }
1.523     albertel 6161: 
1.515     albertel 6162: table.LC_prior_tries td {
1.524     albertel 6163:   padding: 2px;
1.515     albertel 6164: }
1.523     albertel 6165: 
                   6166: .LC_answer_correct {
1.795     www      6167:   background: lightgreen;
                   6168:   color: darkgreen;
                   6169:   padding: 6px;
1.523     albertel 6170: }
1.795     www      6171: 
1.523     albertel 6172: .LC_answer_charged_try {
1.797     www      6173:   background: #FFAAAA;
1.795     www      6174:   color: darkred;
                   6175:   padding: 6px;
1.523     albertel 6176: }
1.795     www      6177: 
1.779     bisitz   6178: .LC_answer_not_charged_try,
1.523     albertel 6179: .LC_answer_no_grade,
                   6180: .LC_answer_late {
1.795     www      6181:   background: lightyellow;
1.523     albertel 6182:   color: black;
1.795     www      6183:   padding: 6px;
1.523     albertel 6184: }
1.795     www      6185: 
1.523     albertel 6186: .LC_answer_previous {
1.795     www      6187:   background: lightblue;
                   6188:   color: darkblue;
                   6189:   padding: 6px;
1.523     albertel 6190: }
1.795     www      6191: 
1.779     bisitz   6192: .LC_answer_no_message {
1.777     tempelho 6193:   background: #FFFFFF;
                   6194:   color: black;
1.795     www      6195:   padding: 6px;
1.779     bisitz   6196: }
1.795     www      6197: 
1.779     bisitz   6198: .LC_answer_unknown {
                   6199:   background: orange;
                   6200:   color: black;
1.795     www      6201:   padding: 6px;
1.777     tempelho 6202: }
1.795     www      6203: 
1.529     albertel 6204: span.LC_prior_numerical,
                   6205: span.LC_prior_string,
                   6206: span.LC_prior_custom,
                   6207: span.LC_prior_reaction,
                   6208: span.LC_prior_math {
1.925     bisitz   6209:   font-family: $mono;
1.523     albertel 6210:   white-space: pre;
                   6211: }
                   6212: 
1.525     albertel 6213: span.LC_prior_string {
1.925     bisitz   6214:   font-family: $mono;
1.525     albertel 6215:   white-space: pre;
                   6216: }
                   6217: 
1.523     albertel 6218: table.LC_prior_option {
                   6219:   width: 100%;
                   6220:   border-collapse: collapse;
                   6221: }
1.795     www      6222: 
1.911     bisitz   6223: table.LC_prior_rank,
1.795     www      6224: table.LC_prior_match {
1.528     albertel 6225:   border-collapse: collapse;
                   6226: }
1.795     www      6227: 
1.528     albertel 6228: table.LC_prior_option tr td,
                   6229: table.LC_prior_rank tr td,
                   6230: table.LC_prior_match tr td {
1.524     albertel 6231:   border: 1px solid #000000;
1.515     albertel 6232: }
                   6233: 
1.855     bisitz   6234: .LC_nobreak {
1.544     albertel 6235:   white-space: nowrap;
1.519     raeburn  6236: }
                   6237: 
1.576     raeburn  6238: span.LC_cusr_emph {
                   6239:   font-style: italic;
                   6240: }
                   6241: 
1.633     raeburn  6242: span.LC_cusr_subheading {
                   6243:   font-weight: normal;
                   6244:   font-size: 85%;
                   6245: }
                   6246: 
1.861     bisitz   6247: div.LC_docs_entry_move {
1.859     bisitz   6248:   border: 1px solid #BBBBBB;
1.545     albertel 6249:   background: #DDDDDD;
1.861     bisitz   6250:   width: 22px;
1.859     bisitz   6251:   padding: 1px;
                   6252:   margin: 0;
1.545     albertel 6253: }
                   6254: 
1.861     bisitz   6255: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6256: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6257:   background: #DDDDDD;
                   6258:   font-size: x-small;
                   6259: }
1.795     www      6260: 
1.861     bisitz   6261: .LC_docs_entry_parameter {
                   6262:   white-space: nowrap;
                   6263: }
                   6264: 
1.544     albertel 6265: .LC_docs_copy {
1.545     albertel 6266:   color: #000099;
1.544     albertel 6267: }
1.795     www      6268: 
1.544     albertel 6269: .LC_docs_cut {
1.545     albertel 6270:   color: #550044;
1.544     albertel 6271: }
1.795     www      6272: 
1.544     albertel 6273: .LC_docs_rename {
1.545     albertel 6274:   color: #009900;
1.544     albertel 6275: }
1.795     www      6276: 
1.544     albertel 6277: .LC_docs_remove {
1.545     albertel 6278:   color: #990000;
                   6279: }
                   6280: 
1.547     albertel 6281: .LC_docs_reinit_warn,
                   6282: .LC_docs_ext_edit {
                   6283:   font-size: x-small;
                   6284: }
                   6285: 
1.545     albertel 6286: table.LC_docs_adddocs td,
                   6287: table.LC_docs_adddocs th {
                   6288:   border: 1px solid #BBBBBB;
                   6289:   padding: 4px;
                   6290:   background: #DDDDDD;
1.543     albertel 6291: }
                   6292: 
1.584     albertel 6293: table.LC_sty_begin {
                   6294:   background: #BBFFBB;
                   6295: }
1.795     www      6296: 
1.584     albertel 6297: table.LC_sty_end {
                   6298:   background: #FFBBBB;
                   6299: }
                   6300: 
1.589     raeburn  6301: table.LC_double_column {
1.803     bisitz   6302:   border-width: 0;
1.589     raeburn  6303:   border-collapse: collapse;
                   6304:   width: 100%;
                   6305:   padding: 2px;
                   6306: }
                   6307: 
                   6308: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6309:   top: 2px;
1.589     raeburn  6310:   left: 2px;
                   6311:   width: 47%;
                   6312:   vertical-align: top;
                   6313: }
                   6314: 
                   6315: table.LC_double_column tr td.LC_right_col {
                   6316:   top: 2px;
1.779     bisitz   6317:   right: 2px;
1.589     raeburn  6318:   width: 47%;
                   6319:   vertical-align: top;
                   6320: }
                   6321: 
1.591     raeburn  6322: div.LC_left_float {
                   6323:   float: left;
                   6324:   padding-right: 5%;
1.597     albertel 6325:   padding-bottom: 4px;
1.591     raeburn  6326: }
                   6327: 
                   6328: div.LC_clear_float_header {
1.597     albertel 6329:   padding-bottom: 2px;
1.591     raeburn  6330: }
                   6331: 
                   6332: div.LC_clear_float_footer {
1.597     albertel 6333:   padding-top: 10px;
1.591     raeburn  6334:   clear: both;
                   6335: }
                   6336: 
1.597     albertel 6337: div.LC_grade_show_user {
1.941     bisitz   6338: /*  border-left: 5px solid $sidebg; */
                   6339:   border-top: 5px solid #000000;
                   6340:   margin: 50px 0 0 0;
1.936     bisitz   6341:   padding: 15px 0 5px 10px;
1.597     albertel 6342: }
1.795     www      6343: 
1.936     bisitz   6344: div.LC_grade_show_user_odd_row {
1.941     bisitz   6345: /*  border-left: 5px solid #000000; */
                   6346: }
                   6347: 
                   6348: div.LC_grade_show_user div.LC_Box {
                   6349:   margin-right: 50px;
1.597     albertel 6350: }
                   6351: 
                   6352: div.LC_grade_submissions,
                   6353: div.LC_grade_message_center,
1.936     bisitz   6354: div.LC_grade_info_links {
1.597     albertel 6355:   margin: 5px;
                   6356:   width: 99%;
                   6357:   background: #FFFFFF;
                   6358: }
1.795     www      6359: 
1.597     albertel 6360: div.LC_grade_submissions_header,
1.936     bisitz   6361: div.LC_grade_message_center_header {
1.705     tempelho 6362:   font-weight: bold;
                   6363:   font-size: large;
1.597     albertel 6364: }
1.795     www      6365: 
1.597     albertel 6366: div.LC_grade_submissions_body,
1.936     bisitz   6367: div.LC_grade_message_center_body {
1.597     albertel 6368:   border: 1px solid black;
                   6369:   width: 99%;
                   6370:   background: #FFFFFF;
                   6371: }
1.795     www      6372: 
1.613     albertel 6373: table.LC_scantron_action {
                   6374:   width: 100%;
                   6375: }
1.795     www      6376: 
1.613     albertel 6377: table.LC_scantron_action tr th {
1.698     harmsja  6378:   font-weight:bold;
                   6379:   font-style:normal;
1.613     albertel 6380: }
1.795     www      6381: 
1.779     bisitz   6382: .LC_edit_problem_header,
1.614     albertel 6383: div.LC_edit_problem_footer {
1.705     tempelho 6384:   font-weight: normal;
                   6385:   font-size:  medium;
1.602     albertel 6386:   margin: 2px;
1.1060    bisitz   6387:   background-color: $sidebg;
1.600     albertel 6388: }
1.795     www      6389: 
1.600     albertel 6390: div.LC_edit_problem_header,
1.602     albertel 6391: div.LC_edit_problem_header div,
1.614     albertel 6392: div.LC_edit_problem_footer,
                   6393: div.LC_edit_problem_footer div,
1.602     albertel 6394: div.LC_edit_problem_editxml_header,
                   6395: div.LC_edit_problem_editxml_header div {
1.600     albertel 6396:   margin-top: 5px;
                   6397: }
1.795     www      6398: 
1.600     albertel 6399: div.LC_edit_problem_header_title {
1.705     tempelho 6400:   font-weight: bold;
                   6401:   font-size: larger;
1.602     albertel 6402:   background: $tabbg;
                   6403:   padding: 3px;
1.1060    bisitz   6404:   margin: 0 0 5px 0;
1.602     albertel 6405: }
1.795     www      6406: 
1.602     albertel 6407: table.LC_edit_problem_header_title {
                   6408:   width: 100%;
1.600     albertel 6409:   background: $tabbg;
1.602     albertel 6410: }
                   6411: 
                   6412: div.LC_edit_problem_discards {
                   6413:   float: left;
                   6414:   padding-bottom: 5px;
                   6415: }
1.795     www      6416: 
1.602     albertel 6417: div.LC_edit_problem_saves {
                   6418:   float: right;
                   6419:   padding-bottom: 5px;
1.600     albertel 6420: }
1.795     www      6421: 
1.911     bisitz   6422: img.stift {
1.803     bisitz   6423:   border-width: 0;
                   6424:   vertical-align: middle;
1.677     riegler  6425: }
1.680     riegler  6426: 
1.923     bisitz   6427: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6428:   vertical-align: top;
1.777     tempelho 6429: }
1.795     www      6430: 
1.716     raeburn  6431: div.LC_createcourse {
1.911     bisitz   6432:   margin: 10px 10px 10px 10px;
1.716     raeburn  6433: }
                   6434: 
1.917     raeburn  6435: .LC_dccid {
                   6436:   margin: 0.2em 0 0 0;
                   6437:   padding: 0;
                   6438:   font-size: 90%;
                   6439:   display:none;
                   6440: }
                   6441: 
1.897     wenzelju 6442: ol.LC_primary_menu a:hover,
1.721     harmsja  6443: ol#LC_MenuBreadcrumbs a:hover,
                   6444: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6445: ul#LC_secondary_menu a:hover,
1.721     harmsja  6446: .LC_FormSectionClearButton input:hover
1.795     www      6447: ul.LC_TabContent   li:hover a {
1.952     onken    6448:   color:$button_hover;
1.911     bisitz   6449:   text-decoration:none;
1.693     droeschl 6450: }
                   6451: 
1.779     bisitz   6452: h1 {
1.911     bisitz   6453:   padding: 0;
                   6454:   line-height:130%;
1.693     droeschl 6455: }
1.698     harmsja  6456: 
1.911     bisitz   6457: h2,
                   6458: h3,
                   6459: h4,
                   6460: h5,
                   6461: h6 {
                   6462:   margin: 5px 0 5px 0;
                   6463:   padding: 0;
                   6464:   line-height:130%;
1.693     droeschl 6465: }
1.795     www      6466: 
                   6467: .LC_hcell {
1.911     bisitz   6468:   padding:3px 15px 3px 15px;
                   6469:   margin: 0;
                   6470:   background-color:$tabbg;
                   6471:   color:$fontmenu;
                   6472:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6473: }
1.795     www      6474: 
1.840     bisitz   6475: .LC_Box > .LC_hcell {
1.911     bisitz   6476:   margin: 0 -10px 10px -10px;
1.835     bisitz   6477: }
                   6478: 
1.721     harmsja  6479: .LC_noBorder {
1.911     bisitz   6480:   border: 0;
1.698     harmsja  6481: }
1.693     droeschl 6482: 
1.721     harmsja  6483: .LC_FormSectionClearButton input {
1.911     bisitz   6484:   background-color:transparent;
                   6485:   border: none;
                   6486:   cursor:pointer;
                   6487:   text-decoration:underline;
1.693     droeschl 6488: }
1.763     bisitz   6489: 
                   6490: .LC_help_open_topic {
1.911     bisitz   6491:   color: #FFFFFF;
                   6492:   background-color: #EEEEFF;
                   6493:   margin: 1px;
                   6494:   padding: 4px;
                   6495:   border: 1px solid #000033;
                   6496:   white-space: nowrap;
                   6497:   /* vertical-align: middle; */
1.759     neumanie 6498: }
1.693     droeschl 6499: 
1.911     bisitz   6500: dl,
                   6501: ul,
                   6502: div,
                   6503: fieldset {
                   6504:   margin: 10px 10px 10px 0;
                   6505:   /* overflow: hidden; */
1.693     droeschl 6506: }
1.795     www      6507: 
1.838     bisitz   6508: fieldset > legend {
1.911     bisitz   6509:   font-weight: bold;
                   6510:   padding: 0 5px 0 5px;
1.838     bisitz   6511: }
                   6512: 
1.813     bisitz   6513: #LC_nav_bar {
1.911     bisitz   6514:   float: left;
1.995     raeburn  6515:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6516:   margin: 0 0 2px 0;
1.807     droeschl 6517: }
                   6518: 
1.916     droeschl 6519: #LC_realm {
                   6520:   margin: 0.2em 0 0 0;
                   6521:   padding: 0;
                   6522:   font-weight: bold;
                   6523:   text-align: center;
1.995     raeburn  6524:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6525: }
                   6526: 
1.911     bisitz   6527: #LC_nav_bar em {
                   6528:   font-weight: bold;
                   6529:   font-style: normal;
1.807     droeschl 6530: }
                   6531: 
1.897     wenzelju 6532: ol.LC_primary_menu {
1.911     bisitz   6533:   float: right;
1.934     droeschl 6534:   margin: 0;
1.1075.2.2  raeburn  6535:   padding: 0;
1.995     raeburn  6536:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6537: }
                   6538: 
1.852     droeschl 6539: ol#LC_PathBreadcrumbs {
1.911     bisitz   6540:   margin: 0;
1.693     droeschl 6541: }
                   6542: 
1.897     wenzelju 6543: ol.LC_primary_menu li {
1.1075.2.2  raeburn  6544:   color: RGB(80, 80, 80);
                   6545:   vertical-align: middle;
                   6546:   text-align: left;
                   6547:   list-style: none;
                   6548:   float: left;
                   6549: }
                   6550: 
                   6551: ol.LC_primary_menu li a {
                   6552:   display: block;
                   6553:   margin: 0;
                   6554:   padding: 0 5px 0 10px;
                   6555:   text-decoration: none;
                   6556: }
                   6557: 
                   6558: ol.LC_primary_menu li ul {
                   6559:   display: none;
                   6560:   width: 10em;
                   6561:   background-color: $data_table_light;
                   6562: }
                   6563: 
                   6564: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
                   6565:   display: block;
                   6566:   position: absolute;
                   6567:   margin: 0;
                   6568:   padding: 0;
1.1075.2.5  raeburn  6569:   z-index: 2;
1.1075.2.2  raeburn  6570: }
                   6571: 
                   6572: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
                   6573:   font-size: 90%;
1.911     bisitz   6574:   vertical-align: top;
1.1075.2.2  raeburn  6575:   float: none;
1.1075.2.5  raeburn  6576:   border-left: 1px solid black;
                   6577:   border-right: 1px solid black;
1.1075.2.2  raeburn  6578: }
                   6579: 
                   6580: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1075.2.5  raeburn  6581:   background-color:$data_table_light;
1.1075.2.2  raeburn  6582: }
                   6583: 
                   6584: ol.LC_primary_menu li li a:hover {
                   6585:    color:$button_hover;
                   6586:    background-color:$data_table_dark;
1.693     droeschl 6587: }
                   6588: 
1.897     wenzelju 6589: ol.LC_primary_menu li img {
1.911     bisitz   6590:   vertical-align: bottom;
1.934     droeschl 6591:   height: 1.1em;
1.1075.2.3  raeburn  6592:   margin: 0.2em 0 0 0;
1.693     droeschl 6593: }
                   6594: 
1.897     wenzelju 6595: ol.LC_primary_menu a {
1.911     bisitz   6596:   color: RGB(80, 80, 80);
                   6597:   text-decoration: none;
1.693     droeschl 6598: }
1.795     www      6599: 
1.949     droeschl 6600: ol.LC_primary_menu a.LC_new_message {
                   6601:   font-weight:bold;
                   6602:   color: darkred;
                   6603: }
                   6604: 
1.975     raeburn  6605: ol.LC_docs_parameters {
                   6606:   margin-left: 0;
                   6607:   padding: 0;
                   6608:   list-style: none;
                   6609: }
                   6610: 
                   6611: ol.LC_docs_parameters li {
                   6612:   margin: 0;
                   6613:   padding-right: 20px;
                   6614:   display: inline;
                   6615: }
                   6616: 
1.976     raeburn  6617: ol.LC_docs_parameters li:before {
                   6618:   content: "\\002022 \\0020";
                   6619: }
                   6620: 
                   6621: li.LC_docs_parameters_title {
                   6622:   font-weight: bold;
                   6623: }
                   6624: 
                   6625: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6626:   content: "";
                   6627: }
                   6628: 
1.897     wenzelju 6629: ul#LC_secondary_menu {
1.911     bisitz   6630:   clear: both;
                   6631:   color: $fontmenu;
                   6632:   background: $tabbg;
                   6633:   list-style: none;
                   6634:   padding: 0;
                   6635:   margin: 0;
                   6636:   width: 100%;
1.995     raeburn  6637:   text-align: left;
1.1075.2.4  raeburn  6638:   float: left;
1.808     droeschl 6639: }
                   6640: 
1.897     wenzelju 6641: ul#LC_secondary_menu li {
1.911     bisitz   6642:   font-weight: bold;
                   6643:   line-height: 1.8em;
                   6644:   border-right: 1px solid black;
                   6645:   vertical-align: middle;
1.1075.2.4  raeburn  6646:   float: left;
                   6647: }
                   6648: 
                   6649: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   6650:   background-color: $data_table_light;
                   6651: }
                   6652: 
                   6653: ul#LC_secondary_menu li a {
                   6654:   padding: 0 0.8em;
                   6655: }
                   6656: 
                   6657: ul#LC_secondary_menu li ul {
                   6658:   display: none;
                   6659: }
                   6660: 
                   6661: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   6662:   display: block;
                   6663:   position: absolute;
                   6664:   margin: 0;
                   6665:   padding: 0;
                   6666:   list-style:none;
                   6667:   float: none;
                   6668:   background-color: $data_table_light;
1.1075.2.5  raeburn  6669:   z-index: 2;
1.1075.2.10  raeburn  6670:   margin-left: -1px;
1.1075.2.4  raeburn  6671: }
                   6672: 
                   6673: ul#LC_secondary_menu li ul li {
                   6674:   font-size: 90%;
                   6675:   vertical-align: top;
                   6676:   border-left: 1px solid black;
                   6677:   border-right: 1px solid black;
                   6678:   background-color: $data_table_light
                   6679:   list-style:none;
                   6680:   float: none;
                   6681: }
                   6682: 
                   6683: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   6684:   background-color: $data_table_dark;
1.807     droeschl 6685: }
                   6686: 
1.847     tempelho 6687: ul.LC_TabContent {
1.911     bisitz   6688:   display:block;
                   6689:   background: $sidebg;
                   6690:   border-bottom: solid 1px $lg_border_color;
                   6691:   list-style:none;
1.1020    raeburn  6692:   margin: -1px -10px 0 -10px;
1.911     bisitz   6693:   padding: 0;
1.693     droeschl 6694: }
                   6695: 
1.795     www      6696: ul.LC_TabContent li,
                   6697: ul.LC_TabContentBigger li {
1.911     bisitz   6698:   float:left;
1.741     harmsja  6699: }
1.795     www      6700: 
1.897     wenzelju 6701: ul#LC_secondary_menu li a {
1.911     bisitz   6702:   color: $fontmenu;
                   6703:   text-decoration: none;
1.693     droeschl 6704: }
1.795     www      6705: 
1.721     harmsja  6706: ul.LC_TabContent {
1.952     onken    6707:   min-height:20px;
1.721     harmsja  6708: }
1.795     www      6709: 
                   6710: ul.LC_TabContent li {
1.911     bisitz   6711:   vertical-align:middle;
1.959     onken    6712:   padding: 0 16px 0 10px;
1.911     bisitz   6713:   background-color:$tabbg;
                   6714:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6715:   border-left: solid 1px $font;
1.721     harmsja  6716: }
1.795     www      6717: 
1.847     tempelho 6718: ul.LC_TabContent .right {
1.911     bisitz   6719:   float:right;
1.847     tempelho 6720: }
                   6721: 
1.911     bisitz   6722: ul.LC_TabContent li a,
                   6723: ul.LC_TabContent li {
                   6724:   color:rgb(47,47,47);
                   6725:   text-decoration:none;
                   6726:   font-size:95%;
                   6727:   font-weight:bold;
1.952     onken    6728:   min-height:20px;
                   6729: }
                   6730: 
1.959     onken    6731: ul.LC_TabContent li a:hover,
                   6732: ul.LC_TabContent li a:focus {
1.952     onken    6733:   color: $button_hover;
1.959     onken    6734:   background:none;
                   6735:   outline:none;
1.952     onken    6736: }
                   6737: 
                   6738: ul.LC_TabContent li:hover {
                   6739:   color: $button_hover;
                   6740:   cursor:pointer;
1.721     harmsja  6741: }
1.795     www      6742: 
1.911     bisitz   6743: ul.LC_TabContent li.active {
1.952     onken    6744:   color: $font;
1.911     bisitz   6745:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6746:   border-bottom:solid 1px #FFFFFF;
                   6747:   cursor: default;
1.744     ehlerst  6748: }
1.795     www      6749: 
1.959     onken    6750: ul.LC_TabContent li.active a {
                   6751:   color:$font;
                   6752:   background:#FFFFFF;
                   6753:   outline: none;
                   6754: }
1.1047    raeburn  6755: 
                   6756: ul.LC_TabContent li.goback {
                   6757:   float: left;
                   6758:   border-left: none;
                   6759: }
                   6760: 
1.870     tempelho 6761: #maincoursedoc {
1.911     bisitz   6762:   clear:both;
1.870     tempelho 6763: }
                   6764: 
                   6765: ul.LC_TabContentBigger {
1.911     bisitz   6766:   display:block;
                   6767:   list-style:none;
                   6768:   padding: 0;
1.870     tempelho 6769: }
                   6770: 
1.795     www      6771: ul.LC_TabContentBigger li {
1.911     bisitz   6772:   vertical-align:bottom;
                   6773:   height: 30px;
                   6774:   font-size:110%;
                   6775:   font-weight:bold;
                   6776:   color: #737373;
1.841     tempelho 6777: }
                   6778: 
1.957     onken    6779: ul.LC_TabContentBigger li.active {
                   6780:   position: relative;
                   6781:   top: 1px;
                   6782: }
                   6783: 
1.870     tempelho 6784: ul.LC_TabContentBigger li a {
1.911     bisitz   6785:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6786:   height: 30px;
                   6787:   line-height: 30px;
                   6788:   text-align: center;
                   6789:   display: block;
                   6790:   text-decoration: none;
1.958     onken    6791:   outline: none;  
1.741     harmsja  6792: }
1.795     www      6793: 
1.870     tempelho 6794: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6795:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6796:   color:$font;
1.744     ehlerst  6797: }
1.795     www      6798: 
1.870     tempelho 6799: ul.LC_TabContentBigger li b {
1.911     bisitz   6800:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6801:   display: block;
                   6802:   float: left;
                   6803:   padding: 0 30px;
1.957     onken    6804:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6805: }
                   6806: 
1.956     onken    6807: ul.LC_TabContentBigger li:hover b {
                   6808:   color:$button_hover;
                   6809: }
                   6810: 
1.870     tempelho 6811: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6812:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6813:   color:$font;
1.957     onken    6814:   border: 0;
1.741     harmsja  6815: }
1.693     droeschl 6816: 
1.870     tempelho 6817: 
1.862     bisitz   6818: ul.LC_CourseBreadcrumbs {
                   6819:   background: $sidebg;
1.1020    raeburn  6820:   height: 2em;
1.862     bisitz   6821:   padding-left: 10px;
1.1020    raeburn  6822:   margin: 0;
1.862     bisitz   6823:   list-style-position: inside;
                   6824: }
                   6825: 
1.911     bisitz   6826: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6827: ol#LC_PathBreadcrumbs {
1.911     bisitz   6828:   padding-left: 10px;
                   6829:   margin: 0;
1.933     droeschl 6830:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6831: }
                   6832: 
1.911     bisitz   6833: ol#LC_MenuBreadcrumbs li,
                   6834: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6835: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6836:   display: inline;
1.933     droeschl 6837:   white-space: normal;  
1.693     droeschl 6838: }
                   6839: 
1.823     bisitz   6840: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6841: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6842:   text-decoration: none;
                   6843:   font-size:90%;
1.693     droeschl 6844: }
1.795     www      6845: 
1.969     droeschl 6846: ol#LC_MenuBreadcrumbs h1 {
                   6847:   display: inline;
                   6848:   font-size: 90%;
                   6849:   line-height: 2.5em;
                   6850:   margin: 0;
                   6851:   padding: 0;
                   6852: }
                   6853: 
1.795     www      6854: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6855:   text-decoration:none;
                   6856:   font-size:100%;
                   6857:   font-weight:bold;
1.693     droeschl 6858: }
1.795     www      6859: 
1.840     bisitz   6860: .LC_Box {
1.911     bisitz   6861:   border: solid 1px $lg_border_color;
                   6862:   padding: 0 10px 10px 10px;
1.746     neumanie 6863: }
1.795     www      6864: 
1.1020    raeburn  6865: .LC_DocsBox {
                   6866:   border: solid 1px $lg_border_color;
                   6867:   padding: 0 0 10px 10px;
                   6868: }
                   6869: 
1.795     www      6870: .LC_AboutMe_Image {
1.911     bisitz   6871:   float:left;
                   6872:   margin-right:10px;
1.747     neumanie 6873: }
1.795     www      6874: 
                   6875: .LC_Clear_AboutMe_Image {
1.911     bisitz   6876:   clear:left;
1.747     neumanie 6877: }
1.795     www      6878: 
1.721     harmsja  6879: dl.LC_ListStyleClean dt {
1.911     bisitz   6880:   padding-right: 5px;
                   6881:   display: table-header-group;
1.693     droeschl 6882: }
                   6883: 
1.721     harmsja  6884: dl.LC_ListStyleClean dd {
1.911     bisitz   6885:   display: table-row;
1.693     droeschl 6886: }
                   6887: 
1.721     harmsja  6888: .LC_ListStyleClean,
                   6889: .LC_ListStyleSimple,
                   6890: .LC_ListStyleNormal,
1.795     www      6891: .LC_ListStyleSpecial {
1.911     bisitz   6892:   /* display:block; */
                   6893:   list-style-position: inside;
                   6894:   list-style-type: none;
                   6895:   overflow: hidden;
                   6896:   padding: 0;
1.693     droeschl 6897: }
                   6898: 
1.721     harmsja  6899: .LC_ListStyleSimple li,
                   6900: .LC_ListStyleSimple dd,
                   6901: .LC_ListStyleNormal li,
                   6902: .LC_ListStyleNormal dd,
                   6903: .LC_ListStyleSpecial li,
1.795     www      6904: .LC_ListStyleSpecial dd {
1.911     bisitz   6905:   margin: 0;
                   6906:   padding: 5px 5px 5px 10px;
                   6907:   clear: both;
1.693     droeschl 6908: }
                   6909: 
1.721     harmsja  6910: .LC_ListStyleClean li,
                   6911: .LC_ListStyleClean dd {
1.911     bisitz   6912:   padding-top: 0;
                   6913:   padding-bottom: 0;
1.693     droeschl 6914: }
                   6915: 
1.721     harmsja  6916: .LC_ListStyleSimple dd,
1.795     www      6917: .LC_ListStyleSimple li {
1.911     bisitz   6918:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 6919: }
                   6920: 
1.721     harmsja  6921: .LC_ListStyleSpecial li,
                   6922: .LC_ListStyleSpecial dd {
1.911     bisitz   6923:   list-style-type: none;
                   6924:   background-color: RGB(220, 220, 220);
                   6925:   margin-bottom: 4px;
1.693     droeschl 6926: }
                   6927: 
1.721     harmsja  6928: table.LC_SimpleTable {
1.911     bisitz   6929:   margin:5px;
                   6930:   border:solid 1px $lg_border_color;
1.795     www      6931: }
1.693     droeschl 6932: 
1.721     harmsja  6933: table.LC_SimpleTable tr {
1.911     bisitz   6934:   padding: 0;
                   6935:   border:solid 1px $lg_border_color;
1.693     droeschl 6936: }
1.795     www      6937: 
                   6938: table.LC_SimpleTable thead {
1.911     bisitz   6939:   background:rgb(220,220,220);
1.693     droeschl 6940: }
                   6941: 
1.721     harmsja  6942: div.LC_columnSection {
1.911     bisitz   6943:   display: block;
                   6944:   clear: both;
                   6945:   overflow: hidden;
                   6946:   margin: 0;
1.693     droeschl 6947: }
                   6948: 
1.721     harmsja  6949: div.LC_columnSection>* {
1.911     bisitz   6950:   float: left;
                   6951:   margin: 10px 20px 10px 0;
                   6952:   overflow:hidden;
1.693     droeschl 6953: }
1.721     harmsja  6954: 
1.795     www      6955: table em {
1.911     bisitz   6956:   font-weight: bold;
                   6957:   font-style: normal;
1.748     schulted 6958: }
1.795     www      6959: 
1.779     bisitz   6960: table.LC_tableBrowseRes,
1.795     www      6961: table.LC_tableOfContent {
1.911     bisitz   6962:   border:none;
                   6963:   border-spacing: 1px;
                   6964:   padding: 3px;
                   6965:   background-color: #FFFFFF;
                   6966:   font-size: 90%;
1.753     droeschl 6967: }
1.789     droeschl 6968: 
1.911     bisitz   6969: table.LC_tableOfContent {
                   6970:   border-collapse: collapse;
1.789     droeschl 6971: }
                   6972: 
1.771     droeschl 6973: table.LC_tableBrowseRes a,
1.768     schulted 6974: table.LC_tableOfContent a {
1.911     bisitz   6975:   background-color: transparent;
                   6976:   text-decoration: none;
1.753     droeschl 6977: }
                   6978: 
1.795     www      6979: table.LC_tableOfContent img {
1.911     bisitz   6980:   border: none;
                   6981:   height: 1.3em;
                   6982:   vertical-align: text-bottom;
                   6983:   margin-right: 0.3em;
1.753     droeschl 6984: }
1.757     schulted 6985: 
1.795     www      6986: a#LC_content_toolbar_firsthomework {
1.911     bisitz   6987:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  6988: }
                   6989: 
1.795     www      6990: a#LC_content_toolbar_everything {
1.911     bisitz   6991:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  6992: }
                   6993: 
1.795     www      6994: a#LC_content_toolbar_uncompleted {
1.911     bisitz   6995:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  6996: }
                   6997: 
1.795     www      6998: #LC_content_toolbar_clearbubbles {
1.911     bisitz   6999:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7000: }
                   7001: 
1.795     www      7002: a#LC_content_toolbar_changefolder {
1.911     bisitz   7003:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7004: }
                   7005: 
1.795     www      7006: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7007:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7008: }
                   7009: 
1.1043    raeburn  7010: a#LC_content_toolbar_edittoplevel {
                   7011:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7012: }
                   7013: 
1.795     www      7014: ul#LC_toolbar li a:hover {
1.911     bisitz   7015:   background-position: bottom center;
1.757     schulted 7016: }
                   7017: 
1.795     www      7018: ul#LC_toolbar {
1.911     bisitz   7019:   padding: 0;
                   7020:   margin: 2px;
                   7021:   list-style:none;
                   7022:   position:relative;
                   7023:   background-color:white;
1.1075.2.9  raeburn  7024:   overflow: auto;
1.757     schulted 7025: }
                   7026: 
1.795     www      7027: ul#LC_toolbar li {
1.911     bisitz   7028:   border:1px solid white;
                   7029:   padding: 0;
                   7030:   margin: 0;
                   7031:   float: left;
                   7032:   display:inline;
                   7033:   vertical-align:middle;
1.1075.2.9  raeburn  7034:   white-space: nowrap;
1.911     bisitz   7035: }
1.757     schulted 7036: 
1.783     amueller 7037: 
1.795     www      7038: a.LC_toolbarItem {
1.911     bisitz   7039:   display:block;
                   7040:   padding: 0;
                   7041:   margin: 0;
                   7042:   height: 32px;
                   7043:   width: 32px;
                   7044:   color:white;
                   7045:   border: none;
                   7046:   background-repeat:no-repeat;
                   7047:   background-color:transparent;
1.757     schulted 7048: }
                   7049: 
1.915     droeschl 7050: ul.LC_funclist {
                   7051:     margin: 0;
                   7052:     padding: 0.5em 1em 0.5em 0;
                   7053: }
                   7054: 
1.933     droeschl 7055: ul.LC_funclist > li:first-child {
                   7056:     font-weight:bold; 
                   7057:     margin-left:0.8em;
                   7058: }
                   7059: 
1.915     droeschl 7060: ul.LC_funclist + ul.LC_funclist {
                   7061:     /* 
                   7062:        left border as a seperator if we have more than
                   7063:        one list 
                   7064:     */
                   7065:     border-left: 1px solid $sidebg;
                   7066:     /* 
                   7067:        this hides the left border behind the border of the 
                   7068:        outer box if element is wrapped to the next 'line' 
                   7069:     */
                   7070:     margin-left: -1px;
                   7071: }
                   7072: 
1.843     bisitz   7073: ul.LC_funclist li {
1.915     droeschl 7074:   display: inline;
1.782     bisitz   7075:   white-space: nowrap;
1.915     droeschl 7076:   margin: 0 0 0 25px;
                   7077:   line-height: 150%;
1.782     bisitz   7078: }
                   7079: 
1.974     wenzelju 7080: .LC_hidden {
                   7081:   display: none;
                   7082: }
                   7083: 
1.1030    www      7084: .LCmodal-overlay {
                   7085: 		position:fixed;
                   7086: 		top:0;
                   7087: 		right:0;
                   7088: 		bottom:0;
                   7089: 		left:0;
                   7090: 		height:100%;
                   7091: 		width:100%;
                   7092: 		margin:0;
                   7093: 		padding:0;
                   7094: 		background:#999;
                   7095: 		opacity:.75;
                   7096: 		filter: alpha(opacity=75);
                   7097: 		-moz-opacity: 0.75;
                   7098: 		z-index:101;
                   7099: }
                   7100: 
                   7101: * html .LCmodal-overlay {   
                   7102: 		position: absolute;
                   7103: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7104: }
                   7105: 
                   7106: .LCmodal-window {
                   7107: 		position:fixed;
                   7108: 		top:50%;
                   7109: 		left:50%;
                   7110: 		margin:0;
                   7111: 		padding:0;
                   7112: 		z-index:102;
                   7113: 	}
                   7114: 
                   7115: * html .LCmodal-window {
                   7116: 		position:absolute;
                   7117: }
                   7118: 
                   7119: .LCclose-window {
                   7120: 		position:absolute;
                   7121: 		width:32px;
                   7122: 		height:32px;
                   7123: 		right:8px;
                   7124: 		top:8px;
                   7125: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7126: 		text-indent:-99999px;
                   7127: 		overflow:hidden;
                   7128: 		cursor:pointer;
                   7129: }
                   7130: 
1.343     albertel 7131: END
                   7132: }
                   7133: 
1.306     albertel 7134: =pod
                   7135: 
                   7136: =item * &headtag()
                   7137: 
                   7138: Returns a uniform footer for LON-CAPA web pages.
                   7139: 
1.307     albertel 7140: Inputs: $title - optional title for the head
                   7141:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7142:         $args - optional arguments
1.319     albertel 7143:             force_register - if is true call registerurl so the remote is 
                   7144:                              informed
1.415     albertel 7145:             redirect       -> array ref of
                   7146:                                    1- seconds before redirect occurs
                   7147:                                    2- url to redirect to
                   7148:                                    3- whether the side effect should occur
1.315     albertel 7149:                            (side effect of setting 
                   7150:                                $env{'internal.head.redirect'} to the url 
                   7151:                                redirected too)
1.352     albertel 7152:             domain         -> force to color decorate a page for a specific
                   7153:                                domain
                   7154:             function       -> force usage of a specific rolish color scheme
                   7155:             bgcolor        -> override the default page bgcolor
1.460     albertel 7156:             no_auto_mt_title
                   7157:                            -> prevent &mt()ing the title arg
1.464     albertel 7158: 
1.306     albertel 7159: =cut
                   7160: 
                   7161: sub headtag {
1.313     albertel 7162:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7163:     
1.363     albertel 7164:     my $function = $args->{'function'} || &get_users_function();
                   7165:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7166:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.418     albertel 7167:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7168: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7169: 		   #time(),
1.418     albertel 7170: 		   $env{'environment.color.timestamp'},
1.363     albertel 7171: 		   $function,$domain,$bgcolor);
                   7172: 
1.369     www      7173:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7174: 
1.308     albertel 7175:     my $result =
                   7176: 	'<head>'.
1.461     albertel 7177: 	&font_settings();
1.319     albertel 7178: 
1.1064    raeburn  7179:     my $inhibitprint = &print_suppression();
                   7180: 
1.461     albertel 7181:     if (!$args->{'frameset'}) {
                   7182: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7183:     }
1.1075.2.12  raeburn  7184:     if ($args->{'force_register'}) {
                   7185:         $result .= &Apache::lonmenu::registerurl(1);
1.319     albertel 7186:     }
1.436     albertel 7187:     if (!$args->{'no_nav_bar'} 
                   7188: 	&& !$args->{'only_body'}
                   7189: 	&& !$args->{'frameset'}) {
                   7190: 	$result .= &help_menu_js();
1.1032    www      7191:         $result.=&modal_window();
1.1038    www      7192:         $result.=&togglebox_script();
1.1034    www      7193:         $result.=&wishlist_window();
1.1041    www      7194:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7195:     } else {
                   7196:         if ($args->{'add_modal'}) {
                   7197:            $result.=&modal_window();
                   7198:         }
                   7199:         if ($args->{'add_wishlist'}) {
                   7200:            $result.=&wishlist_window();
                   7201:         }
1.1038    www      7202:         if ($args->{'add_togglebox'}) {
                   7203:            $result.=&togglebox_script();
                   7204:         }
1.1041    www      7205:         if ($args->{'add_progressbar'}) {
                   7206:            $result.=&LCprogressbarUpdate_script();
                   7207:         }
1.436     albertel 7208:     }
1.314     albertel 7209:     if (ref($args->{'redirect'})) {
1.414     albertel 7210: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7211: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7212: 	if (!$inhibit_continue) {
                   7213: 	    $env{'internal.head.redirect'} = $url;
                   7214: 	}
1.313     albertel 7215: 	$result.=<<ADDMETA
                   7216: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7217: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7218: ADDMETA
                   7219:     }
1.306     albertel 7220:     if (!defined($title)) {
                   7221: 	$title = 'The LearningOnline Network with CAPA';
                   7222:     }
1.460     albertel 7223:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7224:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 7225: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
1.1064    raeburn  7226:         .$inhibitprint
1.414     albertel 7227: 	.$head_extra;
1.962     droeschl 7228:     return $result.'</head>';
1.306     albertel 7229: }
                   7230: 
                   7231: =pod
                   7232: 
1.340     albertel 7233: =item * &font_settings()
                   7234: 
                   7235: Returns neccessary <meta> to set the proper encoding
                   7236: 
                   7237: Inputs: none
                   7238: 
                   7239: =cut
                   7240: 
                   7241: sub font_settings {
                   7242:     my $headerstring='';
1.647     www      7243:     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340     albertel 7244: 	$headerstring.=
                   7245: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   7246:     }
                   7247:     return $headerstring;
                   7248: }
                   7249: 
1.341     albertel 7250: =pod
                   7251: 
1.1064    raeburn  7252: =item * &print_suppression()
                   7253: 
                   7254: In course context returns css which causes the body to be blank when media="print",
                   7255: if printout generation is unavailable for the current resource.
                   7256: 
                   7257: This could be because:
                   7258: 
                   7259: (a) printstartdate is in the future
                   7260: 
                   7261: (b) printenddate is in the past
                   7262: 
                   7263: (c) there is an active exam block with "printout"
                   7264: functionality blocked
                   7265: 
                   7266: Users with pav, pfo or evb privileges are exempt.
                   7267: 
                   7268: Inputs: none
                   7269: 
                   7270: =cut
                   7271: 
                   7272: 
                   7273: sub print_suppression {
                   7274:     my $noprint;
                   7275:     if ($env{'request.course.id'}) {
                   7276:         my $scope = $env{'request.course.id'};
                   7277:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7278:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7279:             return;
                   7280:         }
                   7281:         if ($env{'request.course.sec'} ne '') {
                   7282:             $scope .= "/$env{'request.course.sec'}";
                   7283:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7284:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7285:                 return;
1.1064    raeburn  7286:             }
                   7287:         }
                   7288:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7289:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1065    raeburn  7290:         my $blocked = &blocking_status('printout',$cnum,$cdom);
1.1064    raeburn  7291:         if ($blocked) {
                   7292:             my $checkrole = "cm./$cdom/$cnum";
                   7293:             if ($env{'request.course.sec'} ne '') {
                   7294:                 $checkrole .= "/$env{'request.course.sec'}";
                   7295:             }
                   7296:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7297:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7298:                 $noprint = 1;
                   7299:             }
                   7300:         }
                   7301:         unless ($noprint) {
                   7302:             my $symb = &Apache::lonnet::symbread();
                   7303:             if ($symb ne '') {
                   7304:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7305:                 if (ref($navmap)) {
                   7306:                     my $res = $navmap->getBySymb($symb);
                   7307:                     if (ref($res)) {
                   7308:                         if (!$res->resprintable()) {
                   7309:                             $noprint = 1;
                   7310:                         }
                   7311:                     }
                   7312:                 }
                   7313:             }
                   7314:         }
                   7315:         if ($noprint) {
                   7316:             return <<"ENDSTYLE";
                   7317: <style type="text/css" media="print">
                   7318:     body { display:none }
                   7319: </style>
                   7320: ENDSTYLE
                   7321:         }
                   7322:     }
                   7323:     return;
                   7324: }
                   7325: 
                   7326: =pod
                   7327: 
1.341     albertel 7328: =item * &xml_begin()
                   7329: 
                   7330: Returns the needed doctype and <html>
                   7331: 
                   7332: Inputs: none
                   7333: 
                   7334: =cut
                   7335: 
                   7336: sub xml_begin {
                   7337:     my $output='';
                   7338: 
                   7339:     if ($env{'browser.mathml'}) {
                   7340: 	$output='<?xml version="1.0"?>'
                   7341:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7342: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7343:             
                   7344: #	    .'<!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">] >'
                   7345: 	    .'<!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">'
                   7346:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7347: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   7348:     } else {
1.849     bisitz   7349: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
                   7350:            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341     albertel 7351:     }
                   7352:     return $output;
                   7353: }
1.340     albertel 7354: 
                   7355: =pod
                   7356: 
1.306     albertel 7357: =item * &start_page()
                   7358: 
                   7359: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7360: 
1.648     raeburn  7361: Inputs:
                   7362: 
                   7363: =over 4
                   7364: 
                   7365: $title - optional title for the page
                   7366: 
                   7367: $head_extra - optional extra HTML to incude inside the <head>
                   7368: 
                   7369: $args - additional optional args supported are:
                   7370: 
                   7371: =over 8
                   7372: 
                   7373:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 7374:                                     arg on
1.814     bisitz   7375:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  7376:              add_entries    -> additional attributes to add to the  <body>
                   7377:              domain         -> force to color decorate a page for a 
1.317     albertel 7378:                                     specific domain
1.648     raeburn  7379:              function       -> force usage of a specific rolish color
1.317     albertel 7380:                                     scheme
1.648     raeburn  7381:              redirect       -> see &headtag()
                   7382:              bgcolor        -> override the default page bg color
                   7383:              js_ready       -> return a string ready for being used in 
1.317     albertel 7384:                                     a javascript writeln
1.648     raeburn  7385:              html_encode    -> return a string ready for being used in 
1.320     albertel 7386:                                     a html attribute
1.648     raeburn  7387:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 7388:                                     $forcereg arg
1.648     raeburn  7389:              frameset       -> if true will start with a <frameset>
1.330     albertel 7390:                                     rather than <body>
1.648     raeburn  7391:              skip_phases    -> hash ref of 
1.338     albertel 7392:                                     head -> skip the <html><head> generation
                   7393:                                     body -> skip all <body> generation
1.1075.2.12  raeburn  7394:              no_inline_link -> if true and in remote mode, don't show the
                   7395:                                     'Switch To Inline Menu' link
1.648     raeburn  7396:              no_auto_mt_title -> prevent &mt()ing the title arg
                   7397:              inherit_jsmath -> when creating popup window in a page,
                   7398:                                     should it have jsmath forced on by the
                   7399:                                     current page
1.867     kalberla 7400:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  7401:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1075.2.15! raeburn  7402:              group          -> includes the current group, if page is for a
        !          7403:                                specific group
1.361     albertel 7404: 
1.648     raeburn  7405: =back
1.460     albertel 7406: 
1.648     raeburn  7407: =back
1.562     albertel 7408: 
1.306     albertel 7409: =cut
                   7410: 
                   7411: sub start_page {
1.309     albertel 7412:     my ($title,$head_extra,$args) = @_;
1.318     albertel 7413:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 7414: 
1.315     albertel 7415:     $env{'internal.start_page'}++;
1.1075.2.15! raeburn  7416:     my ($result,@advtools);
1.964     droeschl 7417: 
1.338     albertel 7418:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1030    www      7419:         $result .= &xml_begin() . &headtag($title, $head_extra, $args);
1.338     albertel 7420:     }
                   7421:     
                   7422:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   7423: 	if ($args->{'frameset'}) {
                   7424: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   7425: 						$args->{'add_entries'});
                   7426: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   7427:         } else {
                   7428:             $result .=
                   7429:                 &bodytag($title, 
                   7430:                          $args->{'function'},       $args->{'add_entries'},
                   7431:                          $args->{'only_body'},      $args->{'domain'},
                   7432:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12  raeburn  7433:                          $args->{'bgcolor'},        $args->{'no_inline_link'},
1.1075.2.15! raeburn  7434:                          $args,                     \@advtools);
1.831     bisitz   7435:         }
1.330     albertel 7436:     }
1.338     albertel 7437: 
1.315     albertel 7438:     if ($args->{'js_ready'}) {
1.713     kaisler  7439: 		$result = &js_ready($result);
1.315     albertel 7440:     }
1.320     albertel 7441:     if ($args->{'html_encode'}) {
1.713     kaisler  7442: 		$result = &html_encode($result);
                   7443:     }
                   7444: 
1.813     bisitz   7445:     # Preparation for new and consistent functionlist at top of screen
                   7446:     # if ($args->{'functionlist'}) {
                   7447:     #            $result .= &build_functionlist();
                   7448:     #}
                   7449: 
1.964     droeschl 7450:     # Don't add anything more if only_body wanted or in const space
                   7451:     return $result if    $args->{'only_body'} 
                   7452:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   7453: 
                   7454:     #Breadcrumbs
1.758     kaisler  7455:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   7456: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   7457: 		#if any br links exists, add them to the breadcrumbs
                   7458: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   7459: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   7460: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   7461: 			}
                   7462: 		}
                   7463: 
                   7464: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   7465: 		if(exists($args->{'bread_crumbs_component'})){
                   7466: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   7467: 		}else{
                   7468: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   7469: 		}
1.320     albertel 7470:     }
1.315     albertel 7471:     return $result;
1.306     albertel 7472: }
                   7473: 
                   7474: sub end_page {
1.315     albertel 7475:     my ($args) = @_;
                   7476:     $env{'internal.end_page'}++;
1.330     albertel 7477:     my $result;
1.335     albertel 7478:     if ($args->{'discussion'}) {
                   7479: 	my ($target,$parser);
                   7480: 	if (ref($args->{'discussion'})) {
                   7481: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   7482: 				$args->{'discussion'}{'parser'});
                   7483: 	}
                   7484: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   7485:     }
1.330     albertel 7486:     if ($args->{'frameset'}) {
                   7487: 	$result .= '</frameset>';
                   7488:     } else {
1.635     raeburn  7489: 	$result .= &endbodytag($args);
1.330     albertel 7490:     }
1.1075.2.6  raeburn  7491:     unless ($args->{'notbody'}) {
                   7492:         $result .= "\n</html>";
                   7493:     }
1.330     albertel 7494: 
1.315     albertel 7495:     if ($args->{'js_ready'}) {
1.317     albertel 7496: 	$result = &js_ready($result);
1.315     albertel 7497:     }
1.335     albertel 7498: 
1.320     albertel 7499:     if ($args->{'html_encode'}) {
                   7500: 	$result = &html_encode($result);
                   7501:     }
1.335     albertel 7502: 
1.315     albertel 7503:     return $result;
                   7504: }
                   7505: 
1.1034    www      7506: sub wishlist_window {
                   7507:     return(<<'ENDWISHLIST');
1.1046    raeburn  7508: <script type="text/javascript">
1.1034    www      7509: // <![CDATA[
                   7510: // <!-- BEGIN LON-CAPA Internal
                   7511: function set_wishlistlink(title, path) {
                   7512:     if (!title) {
                   7513:         title = document.title;
                   7514:         title = title.replace(/^LON-CAPA /,'');
                   7515:     }
                   7516:     if (!path) {
                   7517:         path = location.pathname;
                   7518:     }
                   7519:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   7520:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   7521: }
                   7522: // END LON-CAPA Internal -->
                   7523: // ]]>
                   7524: </script>
                   7525: ENDWISHLIST
                   7526: }
                   7527: 
1.1030    www      7528: sub modal_window {
                   7529:     return(<<'ENDMODAL');
1.1046    raeburn  7530: <script type="text/javascript">
1.1030    www      7531: // <![CDATA[
                   7532: // <!-- BEGIN LON-CAPA Internal
                   7533: var modalWindow = {
                   7534: 	parent:"body",
                   7535: 	windowId:null,
                   7536: 	content:null,
                   7537: 	width:null,
                   7538: 	height:null,
                   7539: 	close:function()
                   7540: 	{
                   7541: 	        $(".LCmodal-window").remove();
                   7542: 	        $(".LCmodal-overlay").remove();
                   7543: 	},
                   7544: 	open:function()
                   7545: 	{
                   7546: 		var modal = "";
                   7547: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7548: 		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;\">";
                   7549: 		modal += this.content;
                   7550: 		modal += "</div>";	
                   7551: 
                   7552: 		$(this.parent).append(modal);
                   7553: 
                   7554: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7555: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7556: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7557: 	}
                   7558: };
1.1031    www      7559: 	var openMyModal = function(source,width,height,scrolling)
1.1030    www      7560: 	{
                   7561: 		modalWindow.windowId = "myModal";
                   7562: 		modalWindow.width = width;
                   7563: 		modalWindow.height = height;
1.1031    www      7564: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='true' src='" + source + "'>&lt/iframe>";
1.1030    www      7565: 		modalWindow.open();
                   7566: 	};	
                   7567: // END LON-CAPA Internal -->
                   7568: // ]]>
                   7569: </script>
                   7570: ENDMODAL
                   7571: }
                   7572: 
                   7573: sub modal_link {
1.1052    www      7574:     my ($link,$linktext,$width,$height,$target,$scrolling,$title)=@_;
1.1030    www      7575:     unless ($width) { $width=480; }
                   7576:     unless ($height) { $height=400; }
1.1031    www      7577:     unless ($scrolling) { $scrolling='yes'; }
1.1074    raeburn  7578:     my $target_attr;
                   7579:     if (defined($target)) {
                   7580:         $target_attr = 'target="'.$target.'"';
                   7581:     }
                   7582:     return <<"ENDLINK";
                   7583: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling'); return false;">
                   7584:            $linktext</a>
                   7585: ENDLINK
1.1030    www      7586: }
                   7587: 
1.1032    www      7588: sub modal_adhoc_script {
                   7589:     my ($funcname,$width,$height,$content)=@_;
                   7590:     return (<<ENDADHOC);
1.1046    raeburn  7591: <script type="text/javascript">
1.1032    www      7592: // <![CDATA[
                   7593:         var $funcname = function()
                   7594:         {
                   7595:                 modalWindow.windowId = "myModal";
                   7596:                 modalWindow.width = $width;
                   7597:                 modalWindow.height = $height;
                   7598:                 modalWindow.content = '$content';
                   7599:                 modalWindow.open();
                   7600:         };  
                   7601: // ]]>
                   7602: </script>
                   7603: ENDADHOC
                   7604: }
                   7605: 
1.1041    www      7606: sub modal_adhoc_inner {
                   7607:     my ($funcname,$width,$height,$content)=@_;
                   7608:     my $innerwidth=$width-20;
                   7609:     $content=&js_ready(
1.1042    www      7610:                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1041    www      7611:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px').
                   7612:                     $content.
                   7613:                  &end_scrollbox().
                   7614:                &end_page()
                   7615:              );
                   7616:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   7617: }
                   7618: 
                   7619: sub modal_adhoc_window {
                   7620:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7621:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   7622:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7623: }
                   7624: 
                   7625: sub modal_adhoc_launch {
                   7626:     my ($funcname,$width,$height,$content)=@_;
                   7627:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   7628: <script type="text/javascript">
                   7629: // <![CDATA[
                   7630: $funcname();
                   7631: // ]]>
                   7632: </script>
                   7633: ENDLAUNCH
                   7634: }
                   7635: 
                   7636: sub modal_adhoc_close {
                   7637:     return (<<ENDCLOSE);
                   7638: <script type="text/javascript">
                   7639: // <![CDATA[
                   7640: modalWindow.close();
                   7641: // ]]>
                   7642: </script>
                   7643: ENDCLOSE
                   7644: }
                   7645: 
1.1038    www      7646: sub togglebox_script {
                   7647:    return(<<ENDTOGGLE);
                   7648: <script type="text/javascript"> 
                   7649: // <![CDATA[
                   7650: function LCtoggleDisplay(id,hidetext,showtext) {
                   7651:    link = document.getElementById(id + "link").childNodes[0];
                   7652:    with (document.getElementById(id).style) {
                   7653:       if (display == "none" ) {
                   7654:           display = "inline";
                   7655:           link.nodeValue = hidetext;
                   7656:         } else {
                   7657:           display = "none";
                   7658:           link.nodeValue = showtext;
                   7659:        }
                   7660:    }
                   7661: }
                   7662: // ]]>
                   7663: </script>
                   7664: ENDTOGGLE
                   7665: }
                   7666: 
1.1039    www      7667: sub start_togglebox {
                   7668:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7669:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7670:     unless ($showtext) { $showtext=&mt('show'); }
                   7671:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7672:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7673:     return &start_data_table().
                   7674:            &start_data_table_header_row().
                   7675:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7676:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7677:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7678:            &end_data_table_header_row().
                   7679:            '<tr id="'.$id.'" style="display:none""><td>';
                   7680: }
                   7681: 
                   7682: sub end_togglebox {
                   7683:     return '</td></tr>'.&end_data_table();
                   7684: }
                   7685: 
1.1041    www      7686: sub LCprogressbar_script {
1.1045    www      7687:    my ($id)=@_;
1.1041    www      7688:    return(<<ENDPROGRESS);
                   7689: <script type="text/javascript">
                   7690: // <![CDATA[
1.1045    www      7691: \$('#progressbar$id').progressbar({
1.1041    www      7692:   value: 0,
                   7693:   change: function(event, ui) {
                   7694:     var newVal = \$(this).progressbar('option', 'value');
                   7695:     \$('.pblabel', this).text(LCprogressTxt);
                   7696:   }
                   7697: });
                   7698: // ]]>
                   7699: </script>
                   7700: ENDPROGRESS
                   7701: }
                   7702: 
                   7703: sub LCprogressbarUpdate_script {
                   7704:    return(<<ENDPROGRESSUPDATE);
                   7705: <style type="text/css">
                   7706: .ui-progressbar { position:relative; }
                   7707: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   7708: </style>
                   7709: <script type="text/javascript">
                   7710: // <![CDATA[
1.1045    www      7711: var LCprogressTxt='---';
                   7712: 
                   7713: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      7714:    LCprogressTxt=progresstext;
1.1045    www      7715:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      7716: }
                   7717: // ]]>
                   7718: </script>
                   7719: ENDPROGRESSUPDATE
                   7720: }
                   7721: 
1.1042    www      7722: my $LClastpercent;
1.1045    www      7723: my $LCidcnt;
                   7724: my $LCcurrentid;
1.1042    www      7725: 
1.1041    www      7726: sub LCprogressbar {
1.1042    www      7727:     my ($r)=(@_);
                   7728:     $LClastpercent=0;
1.1045    www      7729:     $LCidcnt++;
                   7730:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      7731:     my $starting=&mt('Starting');
                   7732:     my $content=(<<ENDPROGBAR);
                   7733: <p>
1.1045    www      7734:   <div id="progressbar$LCcurrentid">
1.1041    www      7735:     <span class="pblabel">$starting</span>
                   7736:   </div>
                   7737: </p>
                   7738: ENDPROGBAR
1.1045    www      7739:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      7740: }
                   7741: 
                   7742: sub LCprogressbarUpdate {
1.1042    www      7743:     my ($r,$val,$text)=@_;
                   7744:     unless ($val) { 
                   7745:        if ($LClastpercent) {
                   7746:            $val=$LClastpercent;
                   7747:        } else {
                   7748:            $val=0;
                   7749:        }
                   7750:     }
1.1041    www      7751:     if ($val<0) { $val=0; }
                   7752:     if ($val>100) { $val=0; }
1.1042    www      7753:     $LClastpercent=$val;
1.1041    www      7754:     unless ($text) { $text=$val.'%'; }
                   7755:     $text=&js_ready($text);
1.1044    www      7756:     &r_print($r,<<ENDUPDATE);
1.1041    www      7757: <script type="text/javascript">
                   7758: // <![CDATA[
1.1045    www      7759: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      7760: // ]]>
                   7761: </script>
                   7762: ENDUPDATE
1.1035    www      7763: }
                   7764: 
1.1042    www      7765: sub LCprogressbarClose {
                   7766:     my ($r)=@_;
                   7767:     $LClastpercent=0;
1.1044    www      7768:     &r_print($r,<<ENDCLOSE);
1.1042    www      7769: <script type="text/javascript">
                   7770: // <![CDATA[
1.1045    www      7771: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      7772: // ]]>
                   7773: </script>
                   7774: ENDCLOSE
1.1044    www      7775: }
                   7776: 
                   7777: sub r_print {
                   7778:     my ($r,$to_print)=@_;
                   7779:     if ($r) {
                   7780:       $r->print($to_print);
                   7781:       $r->rflush();
                   7782:     } else {
                   7783:       print($to_print);
                   7784:     }
1.1042    www      7785: }
                   7786: 
1.320     albertel 7787: sub html_encode {
                   7788:     my ($result) = @_;
                   7789: 
1.322     albertel 7790:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7791:     
                   7792:     return $result;
                   7793: }
1.1044    www      7794: 
1.317     albertel 7795: sub js_ready {
                   7796:     my ($result) = @_;
                   7797: 
1.323     albertel 7798:     $result =~ s/[\n\r]/ /xmsg;
                   7799:     $result =~ s/\\/\\\\/xmsg;
                   7800:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7801:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7802:     
                   7803:     return $result;
                   7804: }
                   7805: 
1.315     albertel 7806: sub validate_page {
                   7807:     if (  exists($env{'internal.start_page'})
1.316     albertel 7808: 	  &&     $env{'internal.start_page'} > 1) {
                   7809: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7810: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7811: 				 $ENV{'request.filename'});
1.315     albertel 7812:     }
                   7813:     if (  exists($env{'internal.end_page'})
1.316     albertel 7814: 	  &&     $env{'internal.end_page'} > 1) {
                   7815: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7816: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7817: 				 $env{'request.filename'});
1.315     albertel 7818:     }
                   7819:     if (     exists($env{'internal.start_page'})
                   7820: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7821: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7822: 				 $env{'request.filename'});
1.315     albertel 7823:     }
                   7824:     if (   ! exists($env{'internal.start_page'})
                   7825: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7826: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7827: 				 $env{'request.filename'});
1.315     albertel 7828:     }
1.306     albertel 7829: }
1.315     albertel 7830: 
1.996     www      7831: 
                   7832: sub start_scrollbox {
1.1075    raeburn  7833:     my ($outerwidth,$width,$height,$id,$bgcolor)=@_;
1.998     raeburn  7834:     unless ($outerwidth) { $outerwidth='520px'; }
                   7835:     unless ($width) { $width='500px'; }
                   7836:     unless ($height) { $height='200px'; }
1.1075    raeburn  7837:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  7838:     if ($id ne '') {
1.1020    raeburn  7839:         $table_id = " id='table_$id'";
                   7840:         $div_id = " id='div_$id'";
1.1018    raeburn  7841:     }
1.1075    raeburn  7842:     if ($bgcolor ne '') {
                   7843:         $tdcol = "background-color: $bgcolor;";
                   7844:     }
                   7845:     return <<"END";
                   7846: <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>
                   7847: END
1.996     www      7848: }
                   7849: 
                   7850: sub end_scrollbox {
1.1036    www      7851:     return '</div></td></tr></table>';
1.996     www      7852: }
                   7853: 
1.318     albertel 7854: sub simple_error_page {
                   7855:     my ($r,$title,$msg) = @_;
                   7856:     my $page =
                   7857: 	&Apache::loncommon::start_page($title).
1.1075.2.15! raeburn  7858: 	'<p class="LC_error">'.&mt($msg).'</p>'.
1.318     albertel 7859: 	&Apache::loncommon::end_page();
                   7860:     if (ref($r)) {
                   7861: 	$r->print($page);
1.327     albertel 7862: 	return;
1.318     albertel 7863:     }
                   7864:     return $page;
                   7865: }
1.347     albertel 7866: 
                   7867: {
1.610     albertel 7868:     my @row_count;
1.961     onken    7869: 
                   7870:     sub start_data_table_count {
                   7871:         unshift(@row_count, 0);
                   7872:         return;
                   7873:     }
                   7874: 
                   7875:     sub end_data_table_count {
                   7876:         shift(@row_count);
                   7877:         return;
                   7878:     }
                   7879: 
1.347     albertel 7880:     sub start_data_table {
1.1018    raeburn  7881: 	my ($add_class,$id) = @_;
1.422     albertel 7882: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  7883:         my $table_id;
                   7884:         if (defined($id)) {
                   7885:             $table_id = ' id="'.$id.'"';
                   7886:         }
1.961     onken    7887: 	&start_data_table_count();
1.1018    raeburn  7888: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 7889:     }
                   7890: 
                   7891:     sub end_data_table {
1.961     onken    7892: 	&end_data_table_count();
1.389     albertel 7893: 	return '</table>'."\n";;
1.347     albertel 7894:     }
                   7895: 
                   7896:     sub start_data_table_row {
1.974     wenzelju 7897: 	my ($add_class, $id) = @_;
1.610     albertel 7898: 	$row_count[0]++;
                   7899: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   7900: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 7901:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7902:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 7903:     }
1.471     banghart 7904:     
                   7905:     sub continue_data_table_row {
1.974     wenzelju 7906: 	my ($add_class, $id) = @_;
1.610     albertel 7907: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 7908: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   7909:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7910:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 7911:     }
1.347     albertel 7912: 
                   7913:     sub end_data_table_row {
1.389     albertel 7914: 	return '</tr>'."\n";;
1.347     albertel 7915:     }
1.367     www      7916: 
1.421     albertel 7917:     sub start_data_table_empty_row {
1.707     bisitz   7918: #	$row_count[0]++;
1.421     albertel 7919: 	return  '<tr class="LC_empty_row" >'."\n";;
                   7920:     }
                   7921: 
                   7922:     sub end_data_table_empty_row {
                   7923: 	return '</tr>'."\n";;
                   7924:     }
                   7925: 
1.367     www      7926:     sub start_data_table_header_row {
1.389     albertel 7927: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      7928:     }
                   7929: 
                   7930:     sub end_data_table_header_row {
1.389     albertel 7931: 	return '</tr>'."\n";;
1.367     www      7932:     }
1.890     droeschl 7933: 
                   7934:     sub data_table_caption {
                   7935:         my $caption = shift;
                   7936:         return "<caption class=\"LC_caption\">$caption</caption>";
                   7937:     }
1.347     albertel 7938: }
                   7939: 
1.548     albertel 7940: =pod
                   7941: 
                   7942: =item * &inhibit_menu_check($arg)
                   7943: 
                   7944: Checks for a inhibitmenu state and generates output to preserve it
                   7945: 
                   7946: Inputs:         $arg - can be any of
                   7947:                      - undef - in which case the return value is a string 
                   7948:                                to add  into arguments list of a uri
                   7949:                      - 'input' - in which case the return value is a HTML
                   7950:                                  <form> <input> field of type hidden to
                   7951:                                  preserve the value
                   7952:                      - a url - in which case the return value is the url with
                   7953:                                the neccesary cgi args added to preserve the
                   7954:                                inhibitmenu state
                   7955:                      - a ref to a url - no return value, but the string is
                   7956:                                         updated to include the neccessary cgi
                   7957:                                         args to preserve the inhibitmenu state
                   7958: 
                   7959: =cut
                   7960: 
                   7961: sub inhibit_menu_check {
                   7962:     my ($arg) = @_;
                   7963:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   7964:     if ($arg eq 'input') {
                   7965: 	if ($env{'form.inhibitmenu'}) {
                   7966: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   7967: 	} else {
                   7968: 	    return
                   7969: 	}
                   7970:     }
                   7971:     if ($env{'form.inhibitmenu'}) {
                   7972: 	if (ref($arg)) {
                   7973: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   7974: 	} elsif ($arg eq '') {
                   7975: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   7976: 	} else {
                   7977: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   7978: 	}
                   7979:     }
                   7980:     if (!ref($arg)) {
                   7981: 	return $arg;
                   7982:     }
                   7983: }
                   7984: 
1.251     albertel 7985: ###############################################
1.182     matthew  7986: 
                   7987: =pod
                   7988: 
1.549     albertel 7989: =back
                   7990: 
                   7991: =head1 User Information Routines
                   7992: 
                   7993: =over 4
                   7994: 
1.405     albertel 7995: =item * &get_users_function()
1.182     matthew  7996: 
                   7997: Used by &bodytag to determine the current users primary role.
                   7998: Returns either 'student','coordinator','admin', or 'author'.
                   7999: 
                   8000: =cut
                   8001: 
                   8002: ###############################################
                   8003: sub get_users_function {
1.815     tempelho 8004:     my $function = 'norole';
1.818     tempelho 8005:     if ($env{'request.role'}=~/^(st)/) {
                   8006:         $function='student';
                   8007:     }
1.907     raeburn  8008:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8009:         $function='coordinator';
                   8010:     }
1.258     albertel 8011:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8012:         $function='admin';
                   8013:     }
1.826     bisitz   8014:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8015:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8016:         $function='author';
                   8017:     }
                   8018:     return $function;
1.54      www      8019: }
1.99      www      8020: 
                   8021: ###############################################
                   8022: 
1.233     raeburn  8023: =pod
                   8024: 
1.821     raeburn  8025: =item * &show_course()
                   8026: 
                   8027: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8028: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8029: 
                   8030: Inputs:
                   8031: None
                   8032: 
                   8033: Outputs:
                   8034: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8035: 
                   8036: =cut
                   8037: 
                   8038: ###############################################
                   8039: sub show_course {
                   8040:     my $course = !$env{'user.adv'};
                   8041:     if (!$env{'user.adv'}) {
                   8042:         foreach my $env (keys(%env)) {
                   8043:             next if ($env !~ m/^user\.priv\./);
                   8044:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8045:                 $course = 0;
                   8046:                 last;
                   8047:             }
                   8048:         }
                   8049:     }
                   8050:     return $course;
                   8051: }
                   8052: 
                   8053: ###############################################
                   8054: 
                   8055: =pod
                   8056: 
1.542     raeburn  8057: =item * &check_user_status()
1.274     raeburn  8058: 
                   8059: Determines current status of supplied role for a
                   8060: specific user. Roles can be active, previous or future.
                   8061: 
                   8062: Inputs: 
                   8063: user's domain, user's username, course's domain,
1.375     raeburn  8064: course's number, optional section ID.
1.274     raeburn  8065: 
                   8066: Outputs:
                   8067: role status: active, previous or future. 
                   8068: 
                   8069: =cut
                   8070: 
                   8071: sub check_user_status {
1.412     raeburn  8072:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8073:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274     raeburn  8074:     my @uroles = keys %userinfo;
                   8075:     my $srchstr;
                   8076:     my $active_chk = 'none';
1.412     raeburn  8077:     my $now = time;
1.274     raeburn  8078:     if (@uroles > 0) {
1.908     raeburn  8079:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8080:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8081:         } else {
1.412     raeburn  8082:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8083:         }
                   8084:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8085:             my $role_end = 0;
                   8086:             my $role_start = 0;
                   8087:             $active_chk = 'active';
1.412     raeburn  8088:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8089:                 $role_end = $1;
                   8090:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8091:                     $role_start = $1;
1.274     raeburn  8092:                 }
                   8093:             }
                   8094:             if ($role_start > 0) {
1.412     raeburn  8095:                 if ($now < $role_start) {
1.274     raeburn  8096:                     $active_chk = 'future';
                   8097:                 }
                   8098:             }
                   8099:             if ($role_end > 0) {
1.412     raeburn  8100:                 if ($now > $role_end) {
1.274     raeburn  8101:                     $active_chk = 'previous';
                   8102:                 }
                   8103:             }
                   8104:         }
                   8105:     }
                   8106:     return $active_chk;
                   8107: }
                   8108: 
                   8109: ###############################################
                   8110: 
                   8111: =pod
                   8112: 
1.405     albertel 8113: =item * &get_sections()
1.233     raeburn  8114: 
                   8115: Determines all the sections for a course including
                   8116: sections with students and sections containing other roles.
1.419     raeburn  8117: Incoming parameters: 
                   8118: 
                   8119: 1. domain
                   8120: 2. course number 
                   8121: 3. reference to array containing roles for which sections should 
                   8122: be gathered (optional).
                   8123: 4. reference to array containing status types for which sections 
                   8124: should be gathered (optional).
                   8125: 
                   8126: If the third argument is undefined, sections are gathered for any role. 
                   8127: If the fourth argument is undefined, sections are gathered for any status.
                   8128: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  8129:  
1.374     raeburn  8130: Returns section hash (keys are section IDs, values are
                   8131: number of users in each section), subject to the
1.419     raeburn  8132: optional roles filter, optional status filter 
1.233     raeburn  8133: 
                   8134: =cut
                   8135: 
                   8136: ###############################################
                   8137: sub get_sections {
1.419     raeburn  8138:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 8139:     if (!defined($cdom) || !defined($cnum)) {
                   8140:         my $cid =  $env{'request.course.id'};
                   8141: 
                   8142: 	return if (!defined($cid));
                   8143: 
                   8144:         $cdom = $env{'course.'.$cid.'.domain'};
                   8145:         $cnum = $env{'course.'.$cid.'.num'};
                   8146:     }
                   8147: 
                   8148:     my %sectioncount;
1.419     raeburn  8149:     my $now = time;
1.240     albertel 8150: 
1.366     albertel 8151:     if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276     albertel 8152: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 8153: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   8154: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  8155:         my $start_index = &Apache::loncoursedata::CL_START();
                   8156:         my $end_index = &Apache::loncoursedata::CL_END();
                   8157:         my $status;
1.366     albertel 8158: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  8159: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   8160: 				                     $data->[$status_index],
                   8161:                                                      $data->[$start_index],
                   8162:                                                      $data->[$end_index]);
                   8163:             if ($stu_status eq 'Active') {
                   8164:                 $status = 'active';
                   8165:             } elsif ($end < $now) {
                   8166:                 $status = 'previous';
                   8167:             } elsif ($start > $now) {
                   8168:                 $status = 'future';
                   8169:             } 
                   8170: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   8171:                 if ((!defined($possible_status)) || (($status ne '') && 
                   8172:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   8173: 		    $sectioncount{$section}++;
                   8174:                 }
1.240     albertel 8175: 	    }
                   8176: 	}
                   8177:     }
                   8178:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8179:     foreach my $user (sort(keys(%courseroles))) {
                   8180: 	if ($user !~ /^(\w{2})/) { next; }
                   8181: 	my ($role) = ($user =~ /^(\w{2})/);
                   8182: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  8183: 	my ($section,$status);
1.240     albertel 8184: 	if ($role eq 'cr' &&
                   8185: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   8186: 	    $section=$1;
                   8187: 	}
                   8188: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   8189: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  8190:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   8191:         if ($end == -1 && $start == -1) {
                   8192:             next; #deleted role
                   8193:         }
                   8194:         if (!defined($possible_status)) { 
                   8195:             $sectioncount{$section}++;
                   8196:         } else {
                   8197:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   8198:                 $status = 'active';
                   8199:             } elsif ($end < $now) {
                   8200:                 $status = 'future';
                   8201:             } elsif ($start > $now) {
                   8202:                 $status = 'previous';
                   8203:             }
                   8204:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   8205:                 $sectioncount{$section}++;
                   8206:             }
                   8207:         }
1.233     raeburn  8208:     }
1.366     albertel 8209:     return %sectioncount;
1.233     raeburn  8210: }
                   8211: 
1.274     raeburn  8212: ###############################################
1.294     raeburn  8213: 
                   8214: =pod
1.405     albertel 8215: 
                   8216: =item * &get_course_users()
                   8217: 
1.275     raeburn  8218: Retrieves usernames:domains for users in the specified course
                   8219: with specific role(s), and access status. 
                   8220: 
                   8221: Incoming parameters:
1.277     albertel 8222: 1. course domain
                   8223: 2. course number
                   8224: 3. access status: users must have - either active, 
1.275     raeburn  8225: previous, future, or all.
1.277     albertel 8226: 4. reference to array of permissible roles
1.288     raeburn  8227: 5. reference to array of section restrictions (optional)
                   8228: 6. reference to results object (hash of hashes).
                   8229: 7. reference to optional userdata hash
1.609     raeburn  8230: 8. reference to optional statushash
1.630     raeburn  8231: 9. flag if privileged users (except those set to unhide in
                   8232:    course settings) should be excluded    
1.609     raeburn  8233: Keys of top level results hash are roles.
1.275     raeburn  8234: Keys of inner hashes are username:domain, with 
                   8235: values set to access type.
1.288     raeburn  8236: Optional userdata hash returns an array with arguments in the 
                   8237: same order as loncoursedata::get_classlist() for student data.
                   8238: 
1.609     raeburn  8239: Optional statushash returns
                   8240: 
1.288     raeburn  8241: Entries for end, start, section and status are blank because
                   8242: of the possibility of multiple values for non-student roles.
                   8243: 
1.275     raeburn  8244: =cut
1.405     albertel 8245: 
1.275     raeburn  8246: ###############################################
1.405     albertel 8247: 
1.275     raeburn  8248: sub get_course_users {
1.630     raeburn  8249:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  8250:     my %idx = ();
1.419     raeburn  8251:     my %seclists;
1.288     raeburn  8252: 
                   8253:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   8254:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   8255:     $idx{end} = &Apache::loncoursedata::CL_END();
                   8256:     $idx{start} = &Apache::loncoursedata::CL_START();
                   8257:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   8258:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   8259:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   8260:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   8261: 
1.290     albertel 8262:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 8263:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  8264:         my $now = time;
1.277     albertel 8265:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  8266:             my $match = 0;
1.412     raeburn  8267:             my $secmatch = 0;
1.419     raeburn  8268:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  8269:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  8270:             if ($section eq '') {
                   8271:                 $section = 'none';
                   8272:             }
1.291     albertel 8273:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8274:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8275:                     $secmatch = 1;
                   8276:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 8277:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8278:                         $secmatch = 1;
                   8279:                     }
                   8280:                 } else {  
1.419     raeburn  8281: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  8282: 		        $secmatch = 1;
                   8283:                     }
1.290     albertel 8284: 		}
1.412     raeburn  8285:                 if (!$secmatch) {
                   8286:                     next;
                   8287:                 }
1.419     raeburn  8288:             }
1.275     raeburn  8289:             if (defined($$types{'active'})) {
1.288     raeburn  8290:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  8291:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  8292:                     $match = 1;
1.275     raeburn  8293:                 }
                   8294:             }
                   8295:             if (defined($$types{'previous'})) {
1.609     raeburn  8296:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  8297:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  8298:                     $match = 1;
1.275     raeburn  8299:                 }
                   8300:             }
                   8301:             if (defined($$types{'future'})) {
1.609     raeburn  8302:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  8303:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  8304:                     $match = 1;
1.275     raeburn  8305:                 }
                   8306:             }
1.609     raeburn  8307:             if ($match) {
                   8308:                 push(@{$seclists{$student}},$section);
                   8309:                 if (ref($userdata) eq 'HASH') {
                   8310:                     $$userdata{$student} = $$classlist{$student};
                   8311:                 }
                   8312:                 if (ref($statushash) eq 'HASH') {
                   8313:                     $statushash->{$student}{'st'}{$section} = $status;
                   8314:                 }
1.288     raeburn  8315:             }
1.275     raeburn  8316:         }
                   8317:     }
1.412     raeburn  8318:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  8319:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8320:         my $now = time;
1.609     raeburn  8321:         my %displaystatus = ( previous => 'Expired',
                   8322:                               active   => 'Active',
                   8323:                               future   => 'Future',
                   8324:                             );
1.630     raeburn  8325:         my %nothide;
                   8326:         if ($hidepriv) {
                   8327:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   8328:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   8329:                 if ($user !~ /:/) {
                   8330:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   8331:                 } else {
                   8332:                     $nothide{$user} = 1;
                   8333:                 }
                   8334:             }
                   8335:         }
1.439     raeburn  8336:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  8337:             my $match = 0;
1.412     raeburn  8338:             my $secmatch = 0;
1.439     raeburn  8339:             my $status;
1.412     raeburn  8340:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  8341:             $user =~ s/:$//;
1.439     raeburn  8342:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   8343:             if ($end == -1 || $start == -1) {
                   8344:                 next;
                   8345:             }
                   8346:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   8347:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  8348:                 my ($uname,$udom) = split(/:/,$user);
                   8349:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8350:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8351:                         $secmatch = 1;
                   8352:                     } elsif ($usec eq '') {
1.420     albertel 8353:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8354:                             $secmatch = 1;
                   8355:                         }
                   8356:                     } else {
                   8357:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   8358:                             $secmatch = 1;
                   8359:                         }
                   8360:                     }
                   8361:                     if (!$secmatch) {
                   8362:                         next;
                   8363:                     }
1.288     raeburn  8364:                 }
1.419     raeburn  8365:                 if ($usec eq '') {
                   8366:                     $usec = 'none';
                   8367:                 }
1.275     raeburn  8368:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  8369:                     if ($hidepriv) {
                   8370:                         if ((&Apache::lonnet::privileged($uname,$udom)) &&
                   8371:                             (!$nothide{$uname.':'.$udom})) {
                   8372:                             next;
                   8373:                         }
                   8374:                     }
1.503     raeburn  8375:                     if ($end > 0 && $end < $now) {
1.439     raeburn  8376:                         $status = 'previous';
                   8377:                     } elsif ($start > $now) {
                   8378:                         $status = 'future';
                   8379:                     } else {
                   8380:                         $status = 'active';
                   8381:                     }
1.277     albertel 8382:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  8383:                         if ($status eq $type) {
1.420     albertel 8384:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  8385:                                 push(@{$$users{$role}{$user}},$type);
                   8386:                             }
1.288     raeburn  8387:                             $match = 1;
                   8388:                         }
                   8389:                     }
1.419     raeburn  8390:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   8391:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   8392: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   8393:                         }
1.420     albertel 8394:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  8395:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   8396:                         }
1.609     raeburn  8397:                         if (ref($statushash) eq 'HASH') {
                   8398:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   8399:                         }
1.275     raeburn  8400:                     }
                   8401:                 }
                   8402:             }
                   8403:         }
1.290     albertel 8404:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  8405:             if ((defined($cdom)) && (defined($cnum))) {
                   8406:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   8407:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   8408:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  8409:                     next if ($owner eq '');
                   8410:                     my ($ownername,$ownerdom);
                   8411:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   8412:                         $ownername = $1;
                   8413:                         $ownerdom = $2;
                   8414:                     } else {
                   8415:                         $ownername = $owner;
                   8416:                         $ownerdom = $cdom;
                   8417:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  8418:                     }
                   8419:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 8420:                     if (defined($userdata) && 
1.609     raeburn  8421: 			!exists($$userdata{$owner})) {
                   8422: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   8423:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   8424:                             push(@{$seclists{$owner}},'none');
                   8425:                         }
                   8426:                         if (ref($statushash) eq 'HASH') {
                   8427:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  8428:                         }
1.290     albertel 8429: 		    }
1.279     raeburn  8430:                 }
                   8431:             }
                   8432:         }
1.419     raeburn  8433:         foreach my $user (keys(%seclists)) {
                   8434:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   8435:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   8436:         }
1.275     raeburn  8437:     }
                   8438:     return;
                   8439: }
                   8440: 
1.288     raeburn  8441: sub get_user_info {
                   8442:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 8443:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   8444: 	&plainname($uname,$udom,'lastname');
1.291     albertel 8445:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  8446:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  8447:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   8448:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  8449:     return;
                   8450: }
1.275     raeburn  8451: 
1.472     raeburn  8452: ###############################################
                   8453: 
                   8454: =pod
                   8455: 
                   8456: =item * &get_user_quota()
                   8457: 
                   8458: Retrieves quota assigned for storage of portfolio files for a user  
                   8459: 
                   8460: Incoming parameters:
                   8461: 1. user's username
                   8462: 2. user's domain
                   8463: 
                   8464: Returns:
1.536     raeburn  8465: 1. Disk quota (in Mb) assigned to student.
                   8466: 2. (Optional) Type of setting: custom or default
                   8467:    (individually assigned or default for user's 
                   8468:    institutional status).
                   8469: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   8470:    or student - types as defined in localenroll::inst_usertypes 
                   8471:    for user's domain, which determines default quota for user.
                   8472: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  8473: 
                   8474: If a value has been stored in the user's environment, 
1.536     raeburn  8475: it will return that, otherwise it returns the maximal default
                   8476: defined for the user's instituional status(es) in the domain.
1.472     raeburn  8477: 
                   8478: =cut
                   8479: 
                   8480: ###############################################
                   8481: 
                   8482: 
                   8483: sub get_user_quota {
                   8484:     my ($uname,$udom) = @_;
1.536     raeburn  8485:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  8486:     if (!defined($udom)) {
                   8487:         $udom = $env{'user.domain'};
                   8488:     }
                   8489:     if (!defined($uname)) {
                   8490:         $uname = $env{'user.name'};
                   8491:     }
                   8492:     if (($udom eq '' || $uname eq '') ||
                   8493:         ($udom eq 'public') && ($uname eq 'public')) {
                   8494:         $quota = 0;
1.536     raeburn  8495:         $quotatype = 'default';
                   8496:         $defquota = 0; 
1.472     raeburn  8497:     } else {
1.536     raeburn  8498:         my $inststatus;
1.472     raeburn  8499:         if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   8500:             $quota = $env{'environment.portfolioquota'};
1.536     raeburn  8501:             $inststatus = $env{'environment.inststatus'};
1.472     raeburn  8502:         } else {
1.536     raeburn  8503:             my %userenv = 
                   8504:                 &Apache::lonnet::get('environment',['portfolioquota',
                   8505:                                      'inststatus'],$udom,$uname);
1.472     raeburn  8506:             my ($tmp) = keys(%userenv);
                   8507:             if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8508:                 $quota = $userenv{'portfolioquota'};
1.536     raeburn  8509:                 $inststatus = $userenv{'inststatus'};
1.472     raeburn  8510:             } else {
                   8511:                 undef(%userenv);
                   8512:             }
                   8513:         }
1.536     raeburn  8514:         ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472     raeburn  8515:         if ($quota eq '') {
1.536     raeburn  8516:             $quota = $defquota;
                   8517:             $quotatype = 'default';
                   8518:         } else {
                   8519:             $quotatype = 'custom';
1.472     raeburn  8520:         }
                   8521:     }
1.536     raeburn  8522:     if (wantarray) {
                   8523:         return ($quota,$quotatype,$settingstatus,$defquota);
                   8524:     } else {
                   8525:         return $quota;
                   8526:     }
1.472     raeburn  8527: }
                   8528: 
                   8529: ###############################################
                   8530: 
                   8531: =pod
                   8532: 
                   8533: =item * &default_quota()
                   8534: 
1.536     raeburn  8535: Retrieves default quota assigned for storage of user portfolio files,
                   8536: given an (optional) user's institutional status.
1.472     raeburn  8537: 
                   8538: Incoming parameters:
                   8539: 1. domain
1.536     raeburn  8540: 2. (Optional) institutional status(es).  This is a : separated list of 
                   8541:    status types (e.g., faculty, staff, student etc.)
                   8542:    which apply to the user for whom the default is being retrieved.
                   8543:    If the institutional status string in undefined, the domain
                   8544:    default quota will be returned. 
1.472     raeburn  8545: 
                   8546: Returns:
                   8547: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  8548: 2. (Optional) institutional type which determined the value of the
                   8549:    default quota.
1.472     raeburn  8550: 
                   8551: If a value has been stored in the domain's configuration db,
                   8552: it will return that, otherwise it returns 20 (for backwards 
                   8553: compatibility with domains which have not set up a configuration
                   8554: db file; the original statically defined portfolio quota was 20 Mb). 
                   8555: 
1.536     raeburn  8556: If the user's status includes multiple types (e.g., staff and student),
                   8557: the largest default quota which applies to the user determines the
                   8558: default quota returned.
                   8559: 
1.780     raeburn  8560: =back
                   8561: 
1.472     raeburn  8562: =cut
                   8563: 
                   8564: ###############################################
                   8565: 
                   8566: 
                   8567: sub default_quota {
1.536     raeburn  8568:     my ($udom,$inststatus) = @_;
                   8569:     my ($defquota,$settingstatus);
                   8570:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  8571:                                             ['quotas'],$udom);
                   8572:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  8573:         if ($inststatus ne '') {
1.765     raeburn  8574:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  8575:             foreach my $item (@statuses) {
1.711     raeburn  8576:                 if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   8577:                     if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
                   8578:                         if ($defquota eq '') {
                   8579:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   8580:                             $settingstatus = $item;
                   8581:                         } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
                   8582:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   8583:                             $settingstatus = $item;
                   8584:                         }
                   8585:                     }
                   8586:                 } else {
                   8587:                     if ($quotahash{'quotas'}{$item} ne '') {
                   8588:                         if ($defquota eq '') {
                   8589:                             $defquota = $quotahash{'quotas'}{$item};
                   8590:                             $settingstatus = $item;
                   8591:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   8592:                             $defquota = $quotahash{'quotas'}{$item};
                   8593:                             $settingstatus = $item;
                   8594:                         }
1.536     raeburn  8595:                     }
                   8596:                 }
                   8597:             }
                   8598:         }
                   8599:         if ($defquota eq '') {
1.711     raeburn  8600:             if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   8601:                 $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
                   8602:             } else {
                   8603:                 $defquota = $quotahash{'quotas'}{'default'};
                   8604:             }
1.536     raeburn  8605:             $settingstatus = 'default';
                   8606:         }
                   8607:     } else {
                   8608:         $settingstatus = 'default';
                   8609:         $defquota = 20;
                   8610:     }
                   8611:     if (wantarray) {
                   8612:         return ($defquota,$settingstatus);
1.472     raeburn  8613:     } else {
1.536     raeburn  8614:         return $defquota;
1.472     raeburn  8615:     }
                   8616: }
                   8617: 
1.384     raeburn  8618: sub get_secgrprole_info {
                   8619:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   8620:     my %sections_count = &get_sections($cdom,$cnum);
                   8621:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   8622:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   8623:     my @groups = sort(keys(%curr_groups));
                   8624:     my $allroles = [];
                   8625:     my $rolehash;
                   8626:     my $accesshash = {
                   8627:                      active => 'Currently has access',
                   8628:                      future => 'Will have future access',
                   8629:                      previous => 'Previously had access',
                   8630:                   };
                   8631:     if ($needroles) {
                   8632:         $rolehash = {'all' => 'all'};
1.385     albertel 8633:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8634: 	if (&Apache::lonnet::error(%user_roles)) {
                   8635: 	    undef(%user_roles);
                   8636: 	}
                   8637:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  8638:             my ($role)=split(/\:/,$item,2);
                   8639:             if ($role eq 'cr') { next; }
                   8640:             if ($role =~ /^cr/) {
                   8641:                 $$rolehash{$role} = (split('/',$role))[3];
                   8642:             } else {
                   8643:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   8644:             }
                   8645:         }
                   8646:         foreach my $key (sort(keys(%{$rolehash}))) {
                   8647:             push(@{$allroles},$key);
                   8648:         }
                   8649:         push (@{$allroles},'st');
                   8650:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   8651:     }
                   8652:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   8653: }
                   8654: 
1.555     raeburn  8655: sub user_picker {
1.994     raeburn  8656:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  8657:     my $currdom = $dom;
                   8658:     my %curr_selected = (
                   8659:                         srchin => 'dom',
1.580     raeburn  8660:                         srchby => 'lastname',
1.555     raeburn  8661:                       );
                   8662:     my $srchterm;
1.625     raeburn  8663:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  8664:         if ($srch->{'srchby'} ne '') {
                   8665:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   8666:         }
                   8667:         if ($srch->{'srchin'} ne '') {
                   8668:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   8669:         }
                   8670:         if ($srch->{'srchtype'} ne '') {
                   8671:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   8672:         }
                   8673:         if ($srch->{'srchdomain'} ne '') {
                   8674:             $currdom = $srch->{'srchdomain'};
                   8675:         }
                   8676:         $srchterm = $srch->{'srchterm'};
                   8677:     }
                   8678:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  8679:                     'usr'       => 'Search criteria',
1.563     raeburn  8680:                     'doma'      => 'Domain/institution to search',
1.558     albertel 8681:                     'uname'     => 'username',
                   8682:                     'lastname'  => 'last name',
1.555     raeburn  8683:                     'lastfirst' => 'last name, first name',
1.558     albertel 8684:                     'crs'       => 'in this course',
1.576     raeburn  8685:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 8686:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  8687:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 8688:                     'exact'     => 'is',
                   8689:                     'contains'  => 'contains',
1.569     raeburn  8690:                     'begins'    => 'begins with',
1.571     raeburn  8691:                     'youm'      => "You must include some text to search for.",
                   8692:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   8693:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   8694:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   8695:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   8696:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   8697:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   8698:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  8699:                                        );
1.563     raeburn  8700:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   8701:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  8702: 
                   8703:     my @srchins = ('crs','dom','alc','instd');
                   8704: 
                   8705:     foreach my $option (@srchins) {
                   8706:         # FIXME 'alc' option unavailable until 
                   8707:         #       loncreateuser::print_user_query_page()
                   8708:         #       has been completed.
                   8709:         next if ($option eq 'alc');
1.880     raeburn  8710:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  8711:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  8712:         if ($curr_selected{'srchin'} eq $option) {
                   8713:             $srchinsel .= ' 
                   8714:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8715:         } else {
                   8716:             $srchinsel .= '
                   8717:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8718:         }
1.555     raeburn  8719:     }
1.563     raeburn  8720:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  8721: 
                   8722:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  8723:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  8724:         if ($curr_selected{'srchby'} eq $option) {
                   8725:             $srchbysel .= '
                   8726:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8727:         } else {
                   8728:             $srchbysel .= '
                   8729:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8730:          }
                   8731:     }
                   8732:     $srchbysel .= "\n  </select>\n";
                   8733: 
                   8734:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  8735:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  8736:         if ($curr_selected{'srchtype'} eq $option) {
                   8737:             $srchtypesel .= '
                   8738:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8739:         } else {
                   8740:             $srchtypesel .= '
                   8741:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8742:         }
                   8743:     }
                   8744:     $srchtypesel .= "\n  </select>\n";
                   8745: 
1.558     albertel 8746:     my ($newuserscript,$new_user_create);
1.994     raeburn  8747:     my $context_dom = $env{'request.role.domain'};
                   8748:     if ($context eq 'requestcrs') {
                   8749:         if ($env{'form.coursedom'} ne '') { 
                   8750:             $context_dom = $env{'form.coursedom'};
                   8751:         }
                   8752:     }
1.556     raeburn  8753:     if ($forcenewuser) {
1.576     raeburn  8754:         if (ref($srch) eq 'HASH') {
1.994     raeburn  8755:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  8756:                 if ($cancreate) {
                   8757:                     $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>';
                   8758:                 } else {
1.799     bisitz   8759:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  8760:                     my %usertypetext = (
                   8761:                         official   => 'institutional',
                   8762:                         unofficial => 'non-institutional',
                   8763:                     );
1.799     bisitz   8764:                     $new_user_create = '<p class="LC_warning">'
                   8765:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   8766:                                       .' '
                   8767:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   8768:                                           ,'<a href="'.$helplink.'">','</a>')
                   8769:                                       .'</p><br />';
1.627     raeburn  8770:                 }
1.576     raeburn  8771:             }
                   8772:         }
                   8773: 
1.556     raeburn  8774:         $newuserscript = <<"ENDSCRIPT";
                   8775: 
1.570     raeburn  8776: function setSearch(createnew,callingForm) {
1.556     raeburn  8777:     if (createnew == 1) {
1.570     raeburn  8778:         for (var i=0; i<callingForm.srchby.length; i++) {
                   8779:             if (callingForm.srchby.options[i].value == 'uname') {
                   8780:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  8781:             }
                   8782:         }
1.570     raeburn  8783:         for (var i=0; i<callingForm.srchin.length; i++) {
                   8784:             if ( callingForm.srchin.options[i].value == 'dom') {
                   8785: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  8786:             }
                   8787:         }
1.570     raeburn  8788:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   8789:             if (callingForm.srchtype.options[i].value == 'exact') {
                   8790:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  8791:             }
                   8792:         }
1.570     raeburn  8793:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  8794:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  8795:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  8796:             }
                   8797:         }
                   8798:     }
                   8799: }
                   8800: ENDSCRIPT
1.558     albertel 8801: 
1.556     raeburn  8802:     }
                   8803: 
1.555     raeburn  8804:     my $output = <<"END_BLOCK";
1.556     raeburn  8805: <script type="text/javascript">
1.824     bisitz   8806: // <![CDATA[
1.570     raeburn  8807: function validateEntry(callingForm) {
1.558     albertel 8808: 
1.556     raeburn  8809:     var checkok = 1;
1.558     albertel 8810:     var srchin;
1.570     raeburn  8811:     for (var i=0; i<callingForm.srchin.length; i++) {
                   8812: 	if ( callingForm.srchin[i].checked ) {
                   8813: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 8814: 	}
                   8815:     }
                   8816: 
1.570     raeburn  8817:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   8818:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   8819:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   8820:     var srchterm =  callingForm.srchterm.value;
                   8821:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  8822:     var msg = "";
                   8823: 
                   8824:     if (srchterm == "") {
                   8825:         checkok = 0;
1.571     raeburn  8826:         msg += "$lt{'youm'}\\n";
1.556     raeburn  8827:     }
                   8828: 
1.569     raeburn  8829:     if (srchtype== 'begins') {
                   8830:         if (srchterm.length < 2) {
                   8831:             checkok = 0;
1.571     raeburn  8832:             msg += "$lt{'thte'}\\n";
1.569     raeburn  8833:         }
                   8834:     }
                   8835: 
1.556     raeburn  8836:     if (srchtype== 'contains') {
                   8837:         if (srchterm.length < 3) {
                   8838:             checkok = 0;
1.571     raeburn  8839:             msg += "$lt{'thet'}\\n";
1.556     raeburn  8840:         }
                   8841:     }
                   8842:     if (srchin == 'instd') {
                   8843:         if (srchdomain == '') {
                   8844:             checkok = 0;
1.571     raeburn  8845:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  8846:         }
                   8847:     }
                   8848:     if (srchin == 'dom') {
                   8849:         if (srchdomain == '') {
                   8850:             checkok = 0;
1.571     raeburn  8851:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  8852:         }
                   8853:     }
                   8854:     if (srchby == 'lastfirst') {
                   8855:         if (srchterm.indexOf(",") == -1) {
                   8856:             checkok = 0;
1.571     raeburn  8857:             msg += "$lt{'whus'}\\n";
1.556     raeburn  8858:         }
                   8859:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   8860:             checkok = 0;
1.571     raeburn  8861:             msg += "$lt{'whse'}\\n";
1.556     raeburn  8862:         }
                   8863:     }
                   8864:     if (checkok == 0) {
1.571     raeburn  8865:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  8866:         return;
                   8867:     }
                   8868:     if (checkok == 1) {
1.570     raeburn  8869:         callingForm.submit();
1.556     raeburn  8870:     }
                   8871: }
                   8872: 
                   8873: $newuserscript
                   8874: 
1.824     bisitz   8875: // ]]>
1.556     raeburn  8876: </script>
1.558     albertel 8877: 
                   8878: $new_user_create
                   8879: 
1.555     raeburn  8880: END_BLOCK
1.558     albertel 8881: 
1.876     raeburn  8882:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   8883:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   8884:                $domform.
                   8885:                &Apache::lonhtmlcommon::row_closure().
                   8886:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   8887:                $srchbysel.
                   8888:                $srchtypesel. 
                   8889:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   8890:                $srchinsel.
                   8891:                &Apache::lonhtmlcommon::row_closure(1). 
                   8892:                &Apache::lonhtmlcommon::end_pick_box().
                   8893:                '<br />';
1.555     raeburn  8894:     return $output;
                   8895: }
                   8896: 
1.612     raeburn  8897: sub user_rule_check {
1.615     raeburn  8898:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  8899:     my $response;
                   8900:     if (ref($usershash) eq 'HASH') {
                   8901:         foreach my $user (keys(%{$usershash})) {
                   8902:             my ($uname,$udom) = split(/:/,$user);
                   8903:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  8904:             my ($id,$newuser);
1.612     raeburn  8905:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  8906:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  8907:                 $id = $usershash->{$user}->{'id'};
                   8908:             }
                   8909:             my $inst_response;
                   8910:             if (ref($checks) eq 'HASH') {
                   8911:                 if (defined($checks->{'username'})) {
1.615     raeburn  8912:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  8913:                         &Apache::lonnet::get_instuser($udom,$uname);
                   8914:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  8915:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  8916:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   8917:                 }
1.615     raeburn  8918:             } else {
                   8919:                 ($inst_response,%{$inst_results->{$user}}) =
                   8920:                     &Apache::lonnet::get_instuser($udom,$uname);
                   8921:                 return;
1.612     raeburn  8922:             }
1.615     raeburn  8923:             if (!$got_rules->{$udom}) {
1.612     raeburn  8924:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   8925:                                                   ['usercreation'],$udom);
                   8926:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  8927:                     foreach my $item ('username','id') {
1.612     raeburn  8928:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   8929:                             $$curr_rules{$udom}{$item} = 
                   8930:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  8931:                         }
                   8932:                     }
                   8933:                 }
1.615     raeburn  8934:                 $got_rules->{$udom} = 1;  
1.585     raeburn  8935:             }
1.612     raeburn  8936:             foreach my $item (keys(%{$checks})) {
                   8937:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   8938:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   8939:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   8940:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   8941:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   8942:                                 if ($rule_check{$rule}) {
                   8943:                                     $$rulematch{$user}{$item} = $rule;
                   8944:                                     if ($inst_response eq 'ok') {
1.615     raeburn  8945:                                         if (ref($inst_results) eq 'HASH') {
                   8946:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   8947:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   8948:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   8949:                                                 }
1.612     raeburn  8950:                                             }
                   8951:                                         }
1.615     raeburn  8952:                                     }
                   8953:                                     last;
1.585     raeburn  8954:                                 }
                   8955:                             }
                   8956:                         }
                   8957:                     }
                   8958:                 }
                   8959:             }
                   8960:         }
                   8961:     }
1.612     raeburn  8962:     return;
                   8963: }
                   8964: 
                   8965: sub user_rule_formats {
                   8966:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   8967:     my %text = ( 
                   8968:                  'username' => 'Usernames',
                   8969:                  'id'       => 'IDs',
                   8970:                );
                   8971:     my $output;
                   8972:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   8973:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   8974:         if (@{$ruleorder} > 0) {
                   8975:             $output = '<br />'.&mt("$text{$check} with the following format(s) may <span class=\"LC_cusr_emph\">only</span> be used for verified users at [_1]:",$domdesc).' <ul>';
                   8976:             foreach my $rule (@{$ruleorder}) {
                   8977:                 if (ref($curr_rules) eq 'ARRAY') {
                   8978:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   8979:                         if (ref($rules->{$rule}) eq 'HASH') {
                   8980:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   8981:                                         $rules->{$rule}{'desc'}.'</li>';
                   8982:                         }
                   8983:                     }
                   8984:                 }
                   8985:             }
                   8986:             $output .= '</ul>';
                   8987:         }
                   8988:     }
                   8989:     return $output;
                   8990: }
                   8991: 
                   8992: sub instrule_disallow_msg {
1.615     raeburn  8993:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  8994:     my $response;
                   8995:     my %text = (
                   8996:                   item   => 'username',
                   8997:                   items  => 'usernames',
                   8998:                   match  => 'matches',
                   8999:                   do     => 'does',
                   9000:                   action => 'a username',
                   9001:                   one    => 'one',
                   9002:                );
                   9003:     if ($count > 1) {
                   9004:         $text{'item'} = 'usernames';
                   9005:         $text{'match'} ='match';
                   9006:         $text{'do'} = 'do';
                   9007:         $text{'action'} = 'usernames',
                   9008:         $text{'one'} = 'ones';
                   9009:     }
                   9010:     if ($checkitem eq 'id') {
                   9011:         $text{'items'} = 'IDs';
                   9012:         $text{'item'} = 'ID';
                   9013:         $text{'action'} = 'an ID';
1.615     raeburn  9014:         if ($count > 1) {
                   9015:             $text{'item'} = 'IDs';
                   9016:             $text{'action'} = 'IDs';
                   9017:         }
1.612     raeburn  9018:     }
1.674     bisitz   9019:     $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  9020:     if ($mode eq 'upload') {
                   9021:         if ($checkitem eq 'username') {
                   9022:             $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'}.");
                   9023:         } elsif ($checkitem eq 'id') {
1.674     bisitz   9024:             $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  9025:         }
1.669     raeburn  9026:     } elsif ($mode eq 'selfcreate') {
                   9027:         if ($checkitem eq 'id') {
                   9028:             $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.");
                   9029:         }
1.615     raeburn  9030:     } else {
                   9031:         if ($checkitem eq 'username') {
                   9032:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   9033:         } elsif ($checkitem eq 'id') {
                   9034:             $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.");
                   9035:         }
1.612     raeburn  9036:     }
                   9037:     return $response;
1.585     raeburn  9038: }
                   9039: 
1.624     raeburn  9040: sub personal_data_fieldtitles {
                   9041:     my %fieldtitles = &Apache::lonlocal::texthash (
                   9042:                         id => 'Student/Employee ID',
                   9043:                         permanentemail => 'E-mail address',
                   9044:                         lastname => 'Last Name',
                   9045:                         firstname => 'First Name',
                   9046:                         middlename => 'Middle Name',
                   9047:                         generation => 'Generation',
                   9048:                         gen => 'Generation',
1.765     raeburn  9049:                         inststatus => 'Affiliation',
1.624     raeburn  9050:                    );
                   9051:     return %fieldtitles;
                   9052: }
                   9053: 
1.642     raeburn  9054: sub sorted_inst_types {
                   9055:     my ($dom) = @_;
                   9056:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   9057:     my $othertitle = &mt('All users');
                   9058:     if ($env{'request.course.id'}) {
1.668     raeburn  9059:         $othertitle  = &mt('Any users');
1.642     raeburn  9060:     }
                   9061:     my @types;
                   9062:     if (ref($order) eq 'ARRAY') {
                   9063:         @types = @{$order};
                   9064:     }
                   9065:     if (@types == 0) {
                   9066:         if (ref($usertypes) eq 'HASH') {
                   9067:             @types = sort(keys(%{$usertypes}));
                   9068:         }
                   9069:     }
                   9070:     if (keys(%{$usertypes}) > 0) {
                   9071:         $othertitle = &mt('Other users');
                   9072:     }
                   9073:     return ($othertitle,$usertypes,\@types);
                   9074: }
                   9075: 
1.645     raeburn  9076: sub get_institutional_codes {
                   9077:     my ($settings,$allcourses,$LC_code) = @_;
                   9078: # Get complete list of course sections to update
                   9079:     my @currsections = ();
                   9080:     my @currxlists = ();
                   9081:     my $coursecode = $$settings{'internal.coursecode'};
                   9082: 
                   9083:     if ($$settings{'internal.sectionnums'} ne '') {
                   9084:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   9085:     }
                   9086: 
                   9087:     if ($$settings{'internal.crosslistings'} ne '') {
                   9088:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   9089:     }
                   9090: 
                   9091:     if (@currxlists > 0) {
                   9092:         foreach (@currxlists) {
                   9093:             if (m/^([^:]+):(\w*)$/) {
                   9094:                 unless (grep/^$1$/,@{$allcourses}) {
                   9095:                     push @{$allcourses},$1;
                   9096:                     $$LC_code{$1} = $2;
                   9097:                 }
                   9098:             }
                   9099:         }
                   9100:     }
                   9101:  
                   9102:     if (@currsections > 0) {
                   9103:         foreach (@currsections) {
                   9104:             if (m/^(\w+):(\w*)$/) {
                   9105:                 my $sec = $coursecode.$1;
                   9106:                 my $lc_sec = $2;
                   9107:                 unless (grep/^$sec$/,@{$allcourses}) {
                   9108:                     push @{$allcourses},$sec;
                   9109:                     $$LC_code{$sec} = $lc_sec;
                   9110:                 }
                   9111:             }
                   9112:         }
                   9113:     }
                   9114:     return;
                   9115: }
                   9116: 
1.971     raeburn  9117: sub get_standard_codeitems {
                   9118:     return ('Year','Semester','Department','Number','Section');
                   9119: }
                   9120: 
1.112     bowersj2 9121: =pod
                   9122: 
1.780     raeburn  9123: =head1 Slot Helpers
                   9124: 
                   9125: =over 4
                   9126: 
                   9127: =item * sorted_slots()
                   9128: 
1.1040    raeburn  9129: Sorts an array of slot names in order of an optional sort key,
                   9130: default sort is by slot start time (earliest first). 
1.780     raeburn  9131: 
                   9132: Inputs:
                   9133: 
                   9134: =over 4
                   9135: 
                   9136: slotsarr  - Reference to array of unsorted slot names.
                   9137: 
                   9138: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   9139: 
1.1040    raeburn  9140: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   9141: 
1.549     albertel 9142: =back
                   9143: 
1.780     raeburn  9144: Returns:
                   9145: 
                   9146: =over 4
                   9147: 
1.1040    raeburn  9148: sorted   - An array of slot names sorted by a specified sort key 
                   9149:            (default sort key is start time of the slot).
1.780     raeburn  9150: 
                   9151: =back
                   9152: 
                   9153: =cut
                   9154: 
                   9155: 
                   9156: sub sorted_slots {
1.1040    raeburn  9157:     my ($slotsarr,$slots,$sortkey) = @_;
                   9158:     if ($sortkey eq '') {
                   9159:         $sortkey = 'starttime';
                   9160:     }
1.780     raeburn  9161:     my @sorted;
                   9162:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   9163:         @sorted =
                   9164:             sort {
                   9165:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  9166:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  9167:                      }
                   9168:                      if (ref($slots->{$a})) { return -1;}
                   9169:                      if (ref($slots->{$b})) { return 1;}
                   9170:                      return 0;
                   9171:                  } @{$slotsarr};
                   9172:     }
                   9173:     return @sorted;
                   9174: }
                   9175: 
1.1040    raeburn  9176: =pod
                   9177: 
                   9178: =item * get_future_slots()
                   9179: 
                   9180: Inputs:
                   9181: 
                   9182: =over 4
                   9183: 
                   9184: cnum - course number
                   9185: 
                   9186: cdom - course domain
                   9187: 
                   9188: now - current UNIX time
                   9189: 
                   9190: symb - optional symb
                   9191: 
                   9192: =back
                   9193: 
                   9194: Returns:
                   9195: 
                   9196: =over 4
                   9197: 
                   9198: sorted_reservable - ref to array of student_schedulable slots currently 
                   9199:                     reservable, ordered by end date of reservation period.
                   9200: 
                   9201: reservable_now - ref to hash of student_schedulable slots currently
                   9202:                  reservable.
                   9203: 
                   9204:     Keys in inner hash are:
                   9205:     (a) symb: either blank or symb to which slot use is restricted.
                   9206:     (b) endreserve: end date of reservation period. 
                   9207: 
                   9208: sorted_future - ref to array of student_schedulable slots reservable in
                   9209:                 the future, ordered by start date of reservation period.
                   9210: 
                   9211: future_reservable - ref to hash of student_schedulable slots reservable
                   9212:                     in the future.
                   9213: 
                   9214:     Keys in inner hash are:
                   9215:     (a) symb: either blank or symb to which slot use is restricted.
                   9216:     (b) startreserve:  start date of reservation period.
                   9217: 
                   9218: =back
                   9219: 
                   9220: =cut
                   9221: 
                   9222: sub get_future_slots {
                   9223:     my ($cnum,$cdom,$now,$symb) = @_;
                   9224:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   9225:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   9226:     foreach my $slot (keys(%slots)) {
                   9227:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   9228:         if ($symb) {
                   9229:             next if (($slots{$slot}->{'symb'} ne '') && 
                   9230:                      ($slots{$slot}->{'symb'} ne $symb));
                   9231:         }
                   9232:         if (($slots{$slot}->{'starttime'} > $now) &&
                   9233:             ($slots{$slot}->{'endtime'} > $now)) {
                   9234:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   9235:                 my $userallowed = 0;
                   9236:                 if ($slots{$slot}->{'allowedsections'}) {
                   9237:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   9238:                     if (!defined($env{'request.role.sec'})
                   9239:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   9240:                         $userallowed=1;
                   9241:                     } else {
                   9242:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   9243:                             $userallowed=1;
                   9244:                         }
                   9245:                     }
                   9246:                     unless ($userallowed) {
                   9247:                         if (defined($env{'request.course.groups'})) {
                   9248:                             my @groups = split(/:/,$env{'request.course.groups'});
                   9249:                             foreach my $group (@groups) {
                   9250:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   9251:                                     $userallowed=1;
                   9252:                                     last;
                   9253:                                 }
                   9254:                             }
                   9255:                         }
                   9256:                     }
                   9257:                 }
                   9258:                 if ($slots{$slot}->{'allowedusers'}) {
                   9259:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   9260:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   9261:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   9262:                         $userallowed = 1;
                   9263:                     }
                   9264:                 }
                   9265:                 next unless($userallowed);
                   9266:             }
                   9267:             my $startreserve = $slots{$slot}->{'startreserve'};
                   9268:             my $endreserve = $slots{$slot}->{'endreserve'};
                   9269:             my $symb = $slots{$slot}->{'symb'};
                   9270:             if (($startreserve < $now) &&
                   9271:                 (!$endreserve || $endreserve > $now)) {
                   9272:                 my $lastres = $endreserve;
                   9273:                 if (!$lastres) {
                   9274:                     $lastres = $slots{$slot}->{'starttime'};
                   9275:                 }
                   9276:                 $reservable_now{$slot} = {
                   9277:                                            symb       => $symb,
                   9278:                                            endreserve => $lastres
                   9279:                                          };
                   9280:             } elsif (($startreserve > $now) &&
                   9281:                      (!$endreserve || $endreserve > $startreserve)) {
                   9282:                 $future_reservable{$slot} = {
                   9283:                                               symb         => $symb,
                   9284:                                               startreserve => $startreserve
                   9285:                                             };
                   9286:             }
                   9287:         }
                   9288:     }
                   9289:     my @unsorted_reservable = keys(%reservable_now);
                   9290:     if (@unsorted_reservable > 0) {
                   9291:         @sorted_reservable = 
                   9292:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   9293:     }
                   9294:     my @unsorted_future = keys(%future_reservable);
                   9295:     if (@unsorted_future > 0) {
                   9296:         @sorted_future =
                   9297:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   9298:     }
                   9299:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   9300: }
1.780     raeburn  9301: 
                   9302: =pod
                   9303: 
1.1057    foxr     9304: =back
                   9305: 
1.549     albertel 9306: =head1 HTTP Helpers
                   9307: 
                   9308: =over 4
                   9309: 
1.648     raeburn  9310: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 9311: 
1.258     albertel 9312: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 9313: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 9314: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 9315: 
                   9316: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   9317: $possible_names is an ref to an array of form element names.  As an example:
                   9318: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 9319: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 9320: 
                   9321: =cut
1.1       albertel 9322: 
1.6       albertel 9323: sub get_unprocessed_cgi {
1.25      albertel 9324:   my ($query,$possible_names)= @_;
1.26      matthew  9325:   # $Apache::lonxml::debug=1;
1.356     albertel 9326:   foreach my $pair (split(/&/,$query)) {
                   9327:     my ($name, $value) = split(/=/,$pair);
1.369     www      9328:     $name = &unescape($name);
1.25      albertel 9329:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   9330:       $value =~ tr/+/ /;
                   9331:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 9332:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 9333:     }
1.16      harris41 9334:   }
1.6       albertel 9335: }
                   9336: 
1.112     bowersj2 9337: =pod
                   9338: 
1.648     raeburn  9339: =item * &cacheheader() 
1.112     bowersj2 9340: 
                   9341: returns cache-controlling header code
                   9342: 
                   9343: =cut
                   9344: 
1.7       albertel 9345: sub cacheheader {
1.258     albertel 9346:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 9347:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   9348:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 9349:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   9350:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 9351:     return $output;
1.7       albertel 9352: }
                   9353: 
1.112     bowersj2 9354: =pod
                   9355: 
1.648     raeburn  9356: =item * &no_cache($r) 
1.112     bowersj2 9357: 
                   9358: specifies header code to not have cache
                   9359: 
                   9360: =cut
                   9361: 
1.9       albertel 9362: sub no_cache {
1.216     albertel 9363:     my ($r) = @_;
                   9364:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 9365: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 9366:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   9367:     $r->no_cache(1);
                   9368:     $r->header_out("Expires" => $date);
                   9369:     $r->header_out("Pragma" => "no-cache");
1.123     www      9370: }
                   9371: 
                   9372: sub content_type {
1.181     albertel 9373:     my ($r,$type,$charset) = @_;
1.299     foxr     9374:     if ($r) {
                   9375: 	#  Note that printout.pl calls this with undef for $r.
                   9376: 	&no_cache($r);
                   9377:     }
1.258     albertel 9378:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 9379:     unless ($charset) {
                   9380: 	$charset=&Apache::lonlocal::current_encoding;
                   9381:     }
                   9382:     if ($charset) { $type.='; charset='.$charset; }
                   9383:     if ($r) {
                   9384: 	$r->content_type($type);
                   9385:     } else {
                   9386: 	print("Content-type: $type\n\n");
                   9387:     }
1.9       albertel 9388: }
1.25      albertel 9389: 
1.112     bowersj2 9390: =pod
                   9391: 
1.648     raeburn  9392: =item * &add_to_env($name,$value) 
1.112     bowersj2 9393: 
1.258     albertel 9394: adds $name to the %env hash with value
1.112     bowersj2 9395: $value, if $name already exists, the entry is converted to an array
                   9396: reference and $value is added to the array.
                   9397: 
                   9398: =cut
                   9399: 
1.25      albertel 9400: sub add_to_env {
                   9401:   my ($name,$value)=@_;
1.258     albertel 9402:   if (defined($env{$name})) {
                   9403:     if (ref($env{$name})) {
1.25      albertel 9404:       #already have multiple values
1.258     albertel 9405:       push(@{ $env{$name} },$value);
1.25      albertel 9406:     } else {
                   9407:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 9408:       my $first=$env{$name};
                   9409:       undef($env{$name});
                   9410:       push(@{ $env{$name} },$first,$value);
1.25      albertel 9411:     }
                   9412:   } else {
1.258     albertel 9413:     $env{$name}=$value;
1.25      albertel 9414:   }
1.31      albertel 9415: }
1.149     albertel 9416: 
                   9417: =pod
                   9418: 
1.648     raeburn  9419: =item * &get_env_multiple($name) 
1.149     albertel 9420: 
1.258     albertel 9421: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 9422: values may be defined and end up as an array ref.
                   9423: 
                   9424: returns an array of values
                   9425: 
                   9426: =cut
                   9427: 
                   9428: sub get_env_multiple {
                   9429:     my ($name) = @_;
                   9430:     my @values;
1.258     albertel 9431:     if (defined($env{$name})) {
1.149     albertel 9432:         # exists is it an array
1.258     albertel 9433:         if (ref($env{$name})) {
                   9434:             @values=@{ $env{$name} };
1.149     albertel 9435:         } else {
1.258     albertel 9436:             $values[0]=$env{$name};
1.149     albertel 9437:         }
                   9438:     }
                   9439:     return(@values);
                   9440: }
                   9441: 
1.660     raeburn  9442: sub ask_for_embedded_content {
                   9443:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  9444:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11  raeburn  9445:         %currsubfile,%unused,$rem);
1.1071    raeburn  9446:     my $counter = 0;
                   9447:     my $numnew = 0;
1.987     raeburn  9448:     my $numremref = 0;
                   9449:     my $numinvalid = 0;
                   9450:     my $numpathchg = 0;
                   9451:     my $numexisting = 0;
1.1071    raeburn  9452:     my $numunused = 0;
                   9453:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
                   9454:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path);
                   9455:     my $heading = &mt('Upload embedded files');
                   9456:     my $buttontext = &mt('Upload');
                   9457: 
1.1075.2.11  raeburn  9458:     my $navmap;
                   9459:     if ($env{'request.course.id'}) {
                   9460:         $navmap = Apache::lonnavmaps::navmap->new();
                   9461:     }
1.984     raeburn  9462:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9463:         my $current_path='/';
                   9464:         if ($env{'form.currentpath'}) {
                   9465:             $current_path = $env{'form.currentpath'};
                   9466:         }
                   9467:         if ($actionurl eq '/adm/coursegrp_portfolio') {
                   9468:             $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9469:             $uname = $env{'course.'.$env{'request.course.id'}.'.num'};
                   9470:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   9471:         } else {
                   9472:             $udom = $env{'user.domain'};
                   9473:             $uname = $env{'user.name'};
                   9474:             $url = '/userfiles/portfolio';
                   9475:         }
1.987     raeburn  9476:         $toplevel = $url.'/';
1.984     raeburn  9477:         $url .= $current_path;
                   9478:         $getpropath = 1;
1.987     raeburn  9479:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   9480:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      9481:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  9482:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  9483:         $toplevel = $url;
1.984     raeburn  9484:         if ($rest ne '') {
1.987     raeburn  9485:             $url .= $rest;
                   9486:         }
                   9487:     } elsif ($actionurl eq '/adm/coursedocs') {
                   9488:         if (ref($args) eq 'HASH') {
1.1071    raeburn  9489:             $url = $args->{'docs_url'};
                   9490:             $toplevel = $url;
1.1075.2.11  raeburn  9491:             if ($args->{'context'} eq 'paste') {
                   9492:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   9493:                 ($path) =
                   9494:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9495:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9496:                 $fileloc =~ s{^/}{};
                   9497:             }
1.1071    raeburn  9498:         }
                   9499:     } elsif ($actionurl eq '/adm/dependencies') {
                   9500:         if ($env{'request.course.id'} ne '') {
                   9501:             $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9502:             $cnum =  $env{'course.'.$env{'request.course.id'}.'.num'};
                   9503:             if (ref($args) eq 'HASH') {
                   9504:                 $url = $args->{'docs_url'};
                   9505:                 $title = $args->{'docs_title'};
                   9506:                 $toplevel = "/$url";
1.1075.2.11  raeburn  9507:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1071    raeburn  9508:                 ($path) =  
                   9509:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9510:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9511:                 $fileloc =~ s{^/}{};
                   9512:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   9513:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   9514:             }
1.987     raeburn  9515:         }
                   9516:     }
                   9517:     my $now = time();
                   9518:     foreach my $embed_file (keys(%{$allfiles})) {
                   9519:         my $absolutepath;
                   9520:         if ($embed_file =~ m{^\w+://}) {
                   9521:             $newfiles{$embed_file} = 1;
                   9522:             $mapping{$embed_file} = $embed_file;
                   9523:         } else {
                   9524:             if ($embed_file =~ m{^/}) {
                   9525:                 $absolutepath = $embed_file;
                   9526:                 $embed_file =~ s{^(/+)}{};
                   9527:             }
                   9528:             if ($embed_file =~ m{/}) {
                   9529:                 my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
                   9530:                 $path = &check_for_traversal($path,$url,$toplevel);
                   9531:                 my $item = $fname;
                   9532:                 if ($path ne '') {
                   9533:                     $item = $path.'/'.$fname;
                   9534:                     $subdependencies{$path}{$fname} = 1;
                   9535:                 } else {
                   9536:                     $dependencies{$item} = 1;
                   9537:                 }
                   9538:                 if ($absolutepath) {
                   9539:                     $mapping{$item} = $absolutepath;
                   9540:                 } else {
                   9541:                     $mapping{$item} = $embed_file;
                   9542:                 }
                   9543:             } else {
                   9544:                 $dependencies{$embed_file} = 1;
                   9545:                 if ($absolutepath) {
                   9546:                     $mapping{$embed_file} = $absolutepath;
                   9547:                 } else {
                   9548:                     $mapping{$embed_file} = $embed_file;
                   9549:                 }
                   9550:             }
1.984     raeburn  9551:         }
                   9552:     }
1.1071    raeburn  9553:     my $dirptr = 16384;
1.984     raeburn  9554:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  9555:         $currsubfile{$path} = {};
1.984     raeburn  9556:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  9557:             my ($sublistref,$listerror) =
                   9558:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   9559:             if (ref($sublistref) eq 'ARRAY') {
                   9560:                 foreach my $line (@{$sublistref}) {
                   9561:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  9562:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  9563:                 }
1.984     raeburn  9564:             }
1.987     raeburn  9565:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9566:             if (opendir(my $dir,$url.'/'.$path)) {
                   9567:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  9568:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   9569:             }
1.1075.2.11  raeburn  9570:         } elsif (($actionurl eq '/adm/dependencies') ||
                   9571:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   9572:                   ($args->{'context'} eq 'paste'))) {
1.1071    raeburn  9573:             if ($env{'request.course.id'} ne '') {
                   9574:                 my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9575:                 if ($dir ne '') {
                   9576:                     my ($sublistref,$listerror) =
                   9577:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   9578:                     if (ref($sublistref) eq 'ARRAY') {
                   9579:                         foreach my $line (@{$sublistref}) {
                   9580:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   9581:                                 undef,$mtime)=split(/\&/,$line,12);
                   9582:                             unless (($testdir&$dirptr) ||
                   9583:                                     ($file_name =~ /^\.\.?$/)) {
                   9584:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   9585:                             }
                   9586:                         }
                   9587:                     }
                   9588:                 }
1.984     raeburn  9589:             }
                   9590:         }
                   9591:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  9592:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  9593:                 my $item = $path.'/'.$file;
                   9594:                 unless ($mapping{$item} eq $item) {
                   9595:                     $pathchanges{$item} = 1;
                   9596:                 }
                   9597:                 $existing{$item} = 1;
                   9598:                 $numexisting ++;
                   9599:             } else {
                   9600:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  9601:             }
                   9602:         }
1.1071    raeburn  9603:         if ($actionurl eq '/adm/dependencies') {
                   9604:             foreach my $path (keys(%currsubfile)) {
                   9605:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   9606:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   9607:                          unless ($subdependencies{$path}{$file}) {
1.1075.2.11  raeburn  9608:                              next if (($rem ne '') &&
                   9609:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   9610:                                        (ref($navmap) &&
                   9611:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   9612:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   9613:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  9614:                              $unused{$path.'/'.$file} = 1; 
                   9615:                          }
                   9616:                     }
                   9617:                 }
                   9618:             }
                   9619:         }
1.984     raeburn  9620:     }
1.987     raeburn  9621:     my %currfile;
1.984     raeburn  9622:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  9623:         my ($dirlistref,$listerror) =
                   9624:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   9625:         if (ref($dirlistref) eq 'ARRAY') {
                   9626:             foreach my $line (@{$dirlistref}) {
                   9627:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   9628:                 $currfile{$file_name} = 1;
                   9629:             }
1.984     raeburn  9630:         }
1.987     raeburn  9631:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9632:         if (opendir(my $dir,$url)) {
1.987     raeburn  9633:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  9634:             map {$currfile{$_} = 1;} @dir_list;
                   9635:         }
1.1075.2.11  raeburn  9636:     } elsif (($actionurl eq '/adm/dependencies') ||
                   9637:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   9638:               ($args->{'context'} eq 'paste'))) {
1.1071    raeburn  9639:         if ($env{'request.course.id'} ne '') {
                   9640:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9641:             if ($dir ne '') {
                   9642:                 my ($dirlistref,$listerror) =
                   9643:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   9644:                 if (ref($dirlistref) eq 'ARRAY') {
                   9645:                     foreach my $line (@{$dirlistref}) {
                   9646:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   9647:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   9648:                         unless (($testdir&$dirptr) ||
                   9649:                                 ($file_name =~ /^\.\.?$/)) {
                   9650:                             $currfile{$file_name} = [$size,$mtime];
                   9651:                         }
                   9652:                     }
                   9653:                 }
                   9654:             }
                   9655:         }
1.984     raeburn  9656:     }
                   9657:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  9658:         if (exists($currfile{$file})) {
1.987     raeburn  9659:             unless ($mapping{$file} eq $file) {
                   9660:                 $pathchanges{$file} = 1;
                   9661:             }
                   9662:             $existing{$file} = 1;
                   9663:             $numexisting ++;
                   9664:         } else {
1.984     raeburn  9665:             $newfiles{$file} = 1;
                   9666:         }
                   9667:     }
1.1071    raeburn  9668:     foreach my $file (keys(%currfile)) {
                   9669:         unless (($file eq $filename) ||
                   9670:                 ($file eq $filename.'.bak') ||
                   9671:                 ($dependencies{$file})) {
1.1075.2.11  raeburn  9672:             if ($actionurl eq '/adm/dependencies') {
                   9673:                 next if (($rem ne '') &&
                   9674:                          (($env{"httpref.$rem".$file} ne '') ||
                   9675:                           (ref($navmap) &&
                   9676:                           (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   9677:                            (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   9678:                             ($navmap->getResourceByUrl($rem.$1)))))));
                   9679:             }
1.1071    raeburn  9680:             $unused{$file} = 1;
                   9681:         }
                   9682:     }
1.1075.2.11  raeburn  9683:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   9684:         ($args->{'context'} eq 'paste')) {
                   9685:         $counter = scalar(keys(%existing));
                   9686:         $numpathchg = scalar(keys(%pathchanges));
                   9687:         return ($output,$counter,$numpathchg,\%existing);
                   9688:     }
1.984     raeburn  9689:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  9690:         if ($actionurl eq '/adm/dependencies') {
                   9691:             next if ($embed_file =~ m{^\w+://});
                   9692:         }
1.660     raeburn  9693:         $upload_output .= &start_data_table_row().
1.1071    raeburn  9694:                           '<td><img src="'.&icon($embed_file).'" />&nbsp;'.
                   9695:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  9696:         unless ($mapping{$embed_file} eq $embed_file) {
                   9697:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.&mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
                   9698:         }
                   9699:         $upload_output .= '</td><td>';
1.1071    raeburn  9700:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.660     raeburn  9701:             $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
1.987     raeburn  9702:             $numremref++;
1.660     raeburn  9703:         } elsif ($args->{'error_on_invalid_names'}
                   9704:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.987     raeburn  9705:             $upload_output.='<span class="LC_warning">'.&mt('Invalid characters').'</span>';
                   9706:             $numinvalid++;
1.660     raeburn  9707:         } else {
1.1071    raeburn  9708:             $upload_output .= &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  9709:                                                      $embed_file,\%mapping,
1.1071    raeburn  9710:                                                      $allfiles,$codebase,'upload');
                   9711:             $counter ++;
                   9712:             $numnew ++;
1.987     raeburn  9713:         }
                   9714:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   9715:     }
                   9716:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  9717:         if ($actionurl eq '/adm/dependencies') {
                   9718:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   9719:             $modify_output .= &start_data_table_row().
                   9720:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   9721:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   9722:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   9723:                               '<td>'.$size.'</td>'.
                   9724:                               '<td>'.$mtime.'</td>'.
                   9725:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   9726:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   9727:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   9728:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   9729:                               &embedded_file_element('upload_embedded',$counter,
                   9730:                                                      $embed_file,\%mapping,
                   9731:                                                      $allfiles,$codebase,'modify').
                   9732:                               '</div></td>'.
                   9733:                               &end_data_table_row()."\n";
                   9734:             $counter ++;
                   9735:         } else {
                   9736:             $upload_output .= &start_data_table_row().
                   9737:                               '<td><span class="LC_filename">'.$embed_file.'</span></td>';
                   9738:                               '<td><span class="LC_warning">'.&mt('Already exists').'</span></td>'.
                   9739:                               &Apache::loncommon::end_data_table_row()."\n";
                   9740:         }
                   9741:     }
                   9742:     my $delidx = $counter;
                   9743:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   9744:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   9745:         $delete_output .= &start_data_table_row().
                   9746:                           '<td><img src="'.&icon($oldfile).'" />'.
                   9747:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   9748:                           '<td>'.$size.'</td>'.
                   9749:                           '<td>'.$mtime.'</td>'.
                   9750:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   9751:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   9752:                           &embedded_file_element('upload_embedded',$delidx,
                   9753:                                                  $oldfile,\%mapping,$allfiles,
                   9754:                                                  $codebase,'delete').'</td>'.
                   9755:                           &end_data_table_row()."\n"; 
                   9756:         $numunused ++;
                   9757:         $delidx ++;
1.987     raeburn  9758:     }
                   9759:     if ($upload_output) {
                   9760:         $upload_output = &start_data_table().
                   9761:                          $upload_output.
                   9762:                          &end_data_table()."\n";
                   9763:     }
1.1071    raeburn  9764:     if ($modify_output) {
                   9765:         $modify_output = &start_data_table().
                   9766:                          &start_data_table_header_row().
                   9767:                          '<th>'.&mt('File').'</th>'.
                   9768:                          '<th>'.&mt('Size (KB)').'</th>'.
                   9769:                          '<th>'.&mt('Modified').'</th>'.
                   9770:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   9771:                          &end_data_table_header_row().
                   9772:                          $modify_output.
                   9773:                          &end_data_table()."\n";
                   9774:     }
                   9775:     if ($delete_output) {
                   9776:         $delete_output = &start_data_table().
                   9777:                          &start_data_table_header_row().
                   9778:                          '<th>'.&mt('File').'</th>'.
                   9779:                          '<th>'.&mt('Size (KB)').'</th>'.
                   9780:                          '<th>'.&mt('Modified').'</th>'.
                   9781:                          '<th>'.&mt('Delete?').'</th>'.
                   9782:                          &end_data_table_header_row().
                   9783:                          $delete_output.
                   9784:                          &end_data_table()."\n";
                   9785:     }
1.987     raeburn  9786:     my $applies = 0;
                   9787:     if ($numremref) {
                   9788:         $applies ++;
                   9789:     }
                   9790:     if ($numinvalid) {
                   9791:         $applies ++;
                   9792:     }
                   9793:     if ($numexisting) {
                   9794:         $applies ++;
                   9795:     }
1.1071    raeburn  9796:     if ($counter || $numunused) {
1.987     raeburn  9797:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   9798:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  9799:                   $state.'<h3>'.$heading.'</h3>'; 
                   9800:         if ($actionurl eq '/adm/dependencies') {
                   9801:             if ($numnew) {
                   9802:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   9803:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   9804:                            $upload_output.'<br />'."\n";
                   9805:             }
                   9806:             if ($numexisting) {
                   9807:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   9808:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   9809:                            $modify_output.'<br />'."\n";
                   9810:                            $buttontext = &mt('Save changes');
                   9811:             }
                   9812:             if ($numunused) {
                   9813:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   9814:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   9815:                            $delete_output.'<br />'."\n";
                   9816:                            $buttontext = &mt('Save changes');
                   9817:             }
                   9818:         } else {
                   9819:             $output .= $upload_output.'<br />'."\n";
                   9820:         }
                   9821:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   9822:                    $counter.'" />'."\n";
                   9823:         if ($actionurl eq '/adm/dependencies') { 
                   9824:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   9825:                        $numnew.'" />'."\n";
                   9826:         } elsif ($actionurl eq '') {
1.987     raeburn  9827:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   9828:         }
                   9829:     } elsif ($applies) {
                   9830:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   9831:         if ($applies > 1) {
                   9832:             $output .=  
                   9833:                 &mt('No files need to be uploaded, as one of the following applies to each reference:').'<ul>';
                   9834:             if ($numremref) {
                   9835:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   9836:             }
                   9837:             if ($numinvalid) {
                   9838:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   9839:             }
                   9840:             if ($numexisting) {
                   9841:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   9842:             }
                   9843:             $output .= '</ul><br />';
                   9844:         } elsif ($numremref) {
                   9845:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   9846:         } elsif ($numinvalid) {
                   9847:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   9848:         } elsif ($numexisting) {
                   9849:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   9850:         }
                   9851:         $output .= $upload_output.'<br />';
                   9852:     }
                   9853:     my ($pathchange_output,$chgcount);
1.1071    raeburn  9854:     $chgcount = $counter;
1.987     raeburn  9855:     if (keys(%pathchanges) > 0) {
                   9856:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  9857:             if ($counter) {
1.987     raeburn  9858:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   9859:                                                   $embed_file,\%mapping,
1.1071    raeburn  9860:                                                   $allfiles,$codebase,'change');
1.987     raeburn  9861:             } else {
                   9862:                 $pathchange_output .= 
                   9863:                     &start_data_table_row().
                   9864:                     '<td><input type ="checkbox" name="namechange" value="'.
                   9865:                     $chgcount.'" checked="checked" /></td>'.
                   9866:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   9867:                     '<td>'.$embed_file.
                   9868:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  9869:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  9870:                     '</td>'.&end_data_table_row();
1.660     raeburn  9871:             }
1.987     raeburn  9872:             $numpathchg ++;
                   9873:             $chgcount ++;
1.660     raeburn  9874:         }
                   9875:     }
1.1071    raeburn  9876:     if ($counter) {
1.987     raeburn  9877:         if ($numpathchg) {
                   9878:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   9879:                        $numpathchg.'" />'."\n";
                   9880:         }
                   9881:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   9882:             ($actionurl eq '/adm/imsimport')) {
                   9883:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   9884:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   9885:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  9886:         } elsif ($actionurl eq '/adm/dependencies') {
                   9887:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  9888:         }
1.1071    raeburn  9889:         $output .=  '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  9890:     } elsif ($numpathchg) {
                   9891:         my %pathchange = ();
                   9892:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   9893:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9894:             $output .= '<p>'.&mt('or').'</p>'; 
                   9895:         } 
                   9896:     }
1.1071    raeburn  9897:     return ($output,$counter,$numpathchg);
1.987     raeburn  9898: }
                   9899: 
                   9900: sub embedded_file_element {
1.1071    raeburn  9901:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  9902:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   9903:                    (ref($codebase) eq 'HASH'));
                   9904:     my $output;
1.1071    raeburn  9905:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  9906:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   9907:     }
                   9908:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   9909:                &escape($embed_file).'" />';
                   9910:     unless (($context eq 'upload_embedded') && 
                   9911:             ($mapping->{$embed_file} eq $embed_file)) {
                   9912:         $output .='
                   9913:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   9914:     }
                   9915:     my $attrib;
                   9916:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   9917:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   9918:     }
                   9919:     $output .=
                   9920:         "\n\t\t".
                   9921:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   9922:         $attrib.'" />';
                   9923:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   9924:         $output .=
                   9925:             "\n\t\t".
                   9926:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   9927:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  9928:     }
1.987     raeburn  9929:     return $output;
1.660     raeburn  9930: }
                   9931: 
1.1071    raeburn  9932: sub get_dependency_details {
                   9933:     my ($currfile,$currsubfile,$embed_file) = @_;
                   9934:     my ($size,$mtime,$showsize,$showmtime);
                   9935:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   9936:         if ($embed_file =~ m{/}) {
                   9937:             my ($path,$fname) = split(/\//,$embed_file);
                   9938:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   9939:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   9940:             }
                   9941:         } else {
                   9942:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   9943:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   9944:             }
                   9945:         }
                   9946:         $showsize = $size/1024.0;
                   9947:         $showsize = sprintf("%.1f",$showsize);
                   9948:         if ($mtime > 0) {
                   9949:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   9950:         }
                   9951:     }
                   9952:     return ($showsize,$showmtime);
                   9953: }
                   9954: 
                   9955: sub ask_embedded_js {
                   9956:     return <<"END";
                   9957: <script type="text/javascript"">
                   9958: // <![CDATA[
                   9959: function toggleBrowse(counter) {
                   9960:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   9961:     var fileid = document.getElementById('embedded_item_'+counter);
                   9962:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   9963:     if (chkboxid.checked == true) {
                   9964:         uploaddivid.style.display='block';
                   9965:     } else {
                   9966:         uploaddivid.style.display='none';
                   9967:         fileid.value = '';
                   9968:     }
                   9969: }
                   9970: // ]]>
                   9971: </script>
                   9972: 
                   9973: END
                   9974: }
                   9975: 
1.661     raeburn  9976: sub upload_embedded {
                   9977:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  9978:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   9979:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  9980:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   9981:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   9982:         my $orig_uploaded_filename =
                   9983:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  9984:         foreach my $type ('orig','ref','attrib','codebase') {
                   9985:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   9986:                 $env{'form.embedded_'.$type.'_'.$i} =
                   9987:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   9988:             }
                   9989:         }
1.661     raeburn  9990:         my ($path,$fname) =
                   9991:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   9992:         # no path, whole string is fname
                   9993:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   9994:         $fname = &Apache::lonnet::clean_filename($fname);
                   9995:         # See if there is anything left
                   9996:         next if ($fname eq '');
                   9997: 
                   9998:         # Check if file already exists as a file or directory.
                   9999:         my ($state,$msg);
                   10000:         if ($context eq 'portfolio') {
                   10001:             my $port_path = $dirpath;
                   10002:             if ($group ne '') {
                   10003:                 $port_path = "groups/$group/$port_path";
                   10004:             }
1.987     raeburn  10005:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   10006:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  10007:                                               $dir_root,$port_path,$disk_quota,
                   10008:                                               $current_disk_usage,$uname,$udom);
                   10009:             if ($state eq 'will_exceed_quota'
1.984     raeburn  10010:                 || $state eq 'file_locked') {
1.661     raeburn  10011:                 $output .= $msg;
                   10012:                 next;
                   10013:             }
                   10014:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   10015:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   10016:             if ($state eq 'exists') {
                   10017:                 $output .= $msg;
                   10018:                 next;
                   10019:             }
                   10020:         }
                   10021:         # Check if extension is valid
                   10022:         if (($fname =~ /\.(\w+)$/) &&
                   10023:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.987     raeburn  10024:             $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  10025:             next;
                   10026:         } elsif (($fname =~ /\.(\w+)$/) &&
                   10027:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  10028:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  10029:             next;
                   10030:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.987     raeburn  10031:             $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  10032:             next;
                   10033:         }
                   10034:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
                   10035:         if ($context eq 'portfolio') {
1.984     raeburn  10036:             my $result;
                   10037:             if ($state eq 'existingfile') {
                   10038:                 $result=
                   10039:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.987     raeburn  10040:                                                     $dirpath.$env{'form.currentpath'}.$path);
1.661     raeburn  10041:             } else {
1.984     raeburn  10042:                 $result=
                   10043:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  10044:                                                     $dirpath.
                   10045:                                                     $env{'form.currentpath'}.$path);
1.984     raeburn  10046:                 if ($result !~ m|^/uploaded/|) {
                   10047:                     $output .= '<span class="LC_error">'
                   10048:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10049:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10050:                                .'</span><br />';
                   10051:                     next;
                   10052:                 } else {
1.987     raeburn  10053:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10054:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  10055:                 }
1.661     raeburn  10056:             }
1.987     raeburn  10057:         } elsif ($context eq 'coursedoc') {
                   10058:             my $result =
                   10059:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',
                   10060:                                                 $dirpath.'/'.$path);
                   10061:             if ($result !~ m|^/uploaded/|) {
                   10062:                 $output .= '<span class="LC_error">'
                   10063:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10064:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10065:                            .'</span><br />';
                   10066:                     next;
                   10067:             } else {
                   10068:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10069:                            $path.$fname.'</span>').'<br />';
                   10070:             }
1.661     raeburn  10071:         } else {
                   10072: # Save the file
                   10073:             my $target = $env{'form.embedded_item_'.$i};
                   10074:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   10075:             my $dest = $fullpath.$fname;
                   10076:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  10077:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  10078:             my $count;
                   10079:             my $filepath = $dir_root;
1.1027    raeburn  10080:             foreach my $subdir (@parts) {
                   10081:                 $filepath .= "/$subdir";
                   10082:                 if (!-e $filepath) {
1.661     raeburn  10083:                     mkdir($filepath,0770);
                   10084:                 }
                   10085:             }
                   10086:             my $fh;
                   10087:             if (!open($fh,'>'.$dest)) {
                   10088:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   10089:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  10090:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   10091:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10092:                            '</span><br />';
                   10093:             } else {
                   10094:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   10095:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   10096:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  10097:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   10098:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10099:                               '</span><br />';
                   10100:                 } else {
1.987     raeburn  10101:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10102:                                $url.'</span>').'<br />';
                   10103:                     unless ($context eq 'testbank') {
                   10104:                         $footer .= &mt('View embedded file: [_1]',
                   10105:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   10106:                     }
                   10107:                 }
                   10108:                 close($fh);
                   10109:             }
                   10110:         }
                   10111:         if ($env{'form.embedded_ref_'.$i}) {
                   10112:             $pathchange{$i} = 1;
                   10113:         }
                   10114:     }
                   10115:     if ($output) {
                   10116:         $output = '<p>'.$output.'</p>';
                   10117:     }
                   10118:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   10119:     $returnflag = 'ok';
1.1071    raeburn  10120:     my $numpathchgs = scalar(keys(%pathchange));
                   10121:     if ($numpathchgs > 0) {
1.987     raeburn  10122:         if ($context eq 'portfolio') {
                   10123:             $output .= '<p>'.&mt('or').'</p>';
                   10124:         } elsif ($context eq 'testbank') {
1.1071    raeburn  10125:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   10126:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  10127:             $returnflag = 'modify_orightml';
                   10128:         }
                   10129:     }
1.1071    raeburn  10130:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  10131: }
                   10132: 
                   10133: sub modify_html_form {
                   10134:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   10135:     my $end = 0;
                   10136:     my $modifyform;
                   10137:     if ($context eq 'upload_embedded') {
                   10138:         return unless (ref($pathchange) eq 'HASH');
                   10139:         if ($env{'form.number_embedded_items'}) {
                   10140:             $end += $env{'form.number_embedded_items'};
                   10141:         }
                   10142:         if ($env{'form.number_pathchange_items'}) {
                   10143:             $end += $env{'form.number_pathchange_items'};
                   10144:         }
                   10145:         if ($end) {
                   10146:             for (my $i=0; $i<$end; $i++) {
                   10147:                 if ($i < $env{'form.number_embedded_items'}) {
                   10148:                     next unless($pathchange->{$i});
                   10149:                 }
                   10150:                 $modifyform .=
                   10151:                     &start_data_table_row().
                   10152:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   10153:                     'checked="checked" /></td>'.
                   10154:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   10155:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   10156:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   10157:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   10158:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   10159:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   10160:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   10161:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   10162:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   10163:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   10164:                     &end_data_table_row();
1.1071    raeburn  10165:             }
1.987     raeburn  10166:         }
                   10167:     } else {
                   10168:         $modifyform = $pathchgtable;
                   10169:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   10170:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   10171:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10172:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   10173:         }
                   10174:     }
                   10175:     if ($modifyform) {
1.1071    raeburn  10176:         if ($actionurl eq '/adm/dependencies') {
                   10177:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   10178:         }
1.987     raeburn  10179:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   10180:                '<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".
                   10181:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   10182:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   10183:                '</ol></p>'."\n".'<p>'.
                   10184:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   10185:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   10186:                &start_data_table()."\n".
                   10187:                &start_data_table_header_row().
                   10188:                '<th>'.&mt('Change?').'</th>'.
                   10189:                '<th>'.&mt('Current reference').'</th>'.
                   10190:                '<th>'.&mt('Required reference').'</th>'.
                   10191:                &end_data_table_header_row()."\n".
                   10192:                $modifyform.
                   10193:                &end_data_table().'<br />'."\n".$hiddenstate.
                   10194:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   10195:                '</form>'."\n";
                   10196:     }
                   10197:     return;
                   10198: }
                   10199: 
                   10200: sub modify_html_refs {
                   10201:     my ($context,$dirpath,$uname,$udom,$dir_root) = @_;
                   10202:     my $container;
                   10203:     if ($context eq 'portfolio') {
                   10204:         $container = $env{'form.container'};
                   10205:     } elsif ($context eq 'coursedoc') {
                   10206:         $container = $env{'form.primaryurl'};
1.1071    raeburn  10207:     } elsif ($context eq 'manage_dependencies') {
                   10208:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   10209:         $container = "/$container";
1.987     raeburn  10210:     } else {
1.1027    raeburn  10211:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  10212:     }
                   10213:     my (%allfiles,%codebase,$output,$content);
                   10214:     my @changes = &get_env_multiple('form.namechange');
1.1071    raeburn  10215:     unless (@changes > 0) {
                   10216:         if (wantarray) {
                   10217:             return ('',0,0); 
                   10218:         } else {
                   10219:             return;
                   10220:         }
                   10221:     }
                   10222:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
                   10223:         ($context eq 'manage_dependencies')) {
                   10224:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   10225:             if (wantarray) {
                   10226:                 return ('',0,0);
                   10227:             } else {
                   10228:                 return;
                   10229:             }
                   10230:         } 
1.987     raeburn  10231:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  10232:         if ($content eq '-1') {
                   10233:             if (wantarray) {
                   10234:                 return ('',0,0);
                   10235:             } else {
                   10236:                 return;
                   10237:             }
                   10238:         }
1.987     raeburn  10239:     } else {
1.1071    raeburn  10240:         unless ($container =~ /^\Q$dir_root\E/) {
                   10241:             if (wantarray) {
                   10242:                 return ('',0,0);
                   10243:             } else {
                   10244:                 return;
                   10245:             }
                   10246:         } 
1.987     raeburn  10247:         if (open(my $fh,"<$container")) {
                   10248:             $content = join('', <$fh>);
                   10249:             close($fh);
                   10250:         } else {
1.1071    raeburn  10251:             if (wantarray) {
                   10252:                 return ('',0,0);
                   10253:             } else {
                   10254:                 return;
                   10255:             }
1.987     raeburn  10256:         }
                   10257:     }
                   10258:     my ($count,$codebasecount) = (0,0);
                   10259:     my $mm = new File::MMagic;
                   10260:     my $mime_type = $mm->checktype_contents($content);
                   10261:     if ($mime_type eq 'text/html') {
                   10262:         my $parse_result = 
                   10263:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   10264:                                                     \%codebase,\$content);
                   10265:         if ($parse_result eq 'ok') {
                   10266:             foreach my $i (@changes) {
                   10267:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   10268:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   10269:                 if ($allfiles{$ref}) {
                   10270:                     my $newname =  $orig;
                   10271:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  10272:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  10273:                     if ($attrib_regexp =~ /:/) {
                   10274:                         $attrib_regexp =~ s/\:/|/g;
                   10275:                     }
                   10276:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10277:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10278:                         $count += $numchg;
                   10279:                     }
                   10280:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  10281:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  10282:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   10283:                         $codebasecount ++;
                   10284:                     }
                   10285:                 }
                   10286:             }
                   10287:             if ($count || $codebasecount) {
                   10288:                 my $saveresult;
1.1071    raeburn  10289:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
                   10290:                     ($context eq 'manage_dependencies')) {
1.987     raeburn  10291:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10292:                     if ($url eq $container) {
                   10293:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   10294:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10295:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  10296:                                             $fname.'</span>').'</p>';
1.987     raeburn  10297:                     } else {
                   10298:                          $output = '<p class="LC_error">'.
                   10299:                                    &mt('Error: update failed for: [_1].',
                   10300:                                    '<span class="LC_filename">'.
                   10301:                                    $container.'</span>').'</p>';
                   10302:                     }
                   10303:                 } else {
                   10304:                     if (open(my $fh,">$container")) {
                   10305:                         print $fh $content;
                   10306:                         close($fh);
                   10307:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10308:                                   $count,'<span class="LC_filename">'.
                   10309:                                   $container.'</span>').'</p>';
1.661     raeburn  10310:                     } else {
1.987     raeburn  10311:                          $output = '<p class="LC_error">'.
                   10312:                                    &mt('Error: could not update [_1].',
                   10313:                                    '<span class="LC_filename">'.
                   10314:                                    $container.'</span>').'</p>';
1.661     raeburn  10315:                     }
                   10316:                 }
                   10317:             }
1.987     raeburn  10318:         } else {
                   10319:             &logthis('Failed to parse '.$container.
                   10320:                      ' to modify references: '.$parse_result);
1.661     raeburn  10321:         }
                   10322:     }
1.1071    raeburn  10323:     if (wantarray) {
                   10324:         return ($output,$count,$codebasecount);
                   10325:     } else {
                   10326:         return $output;
                   10327:     }
1.661     raeburn  10328: }
                   10329: 
                   10330: sub check_for_existing {
                   10331:     my ($path,$fname,$element) = @_;
                   10332:     my ($state,$msg);
                   10333:     if (-d $path.'/'.$fname) {
                   10334:         $state = 'exists';
                   10335:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10336:     } elsif (-e $path.'/'.$fname) {
                   10337:         $state = 'exists';
                   10338:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10339:     }
                   10340:     if ($state eq 'exists') {
                   10341:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   10342:     }
                   10343:     return ($state,$msg);
                   10344: }
                   10345: 
                   10346: sub check_for_upload {
                   10347:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   10348:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  10349:     my $filesize = length($env{'form.'.$element});
                   10350:     if (!$filesize) {
                   10351:         my $msg = '<span class="LC_error">'.
                   10352:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   10353:                       '<span class="LC_filename">'.$fname.'</span>',
                   10354:                       $filesize).'<br />'.
1.1007    raeburn  10355:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  10356:                   '</span>';
                   10357:         return ('zero_bytes',$msg);
                   10358:     }
                   10359:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  10360:     my $getpropath = 1;
1.1021    raeburn  10361:     my ($dirlistref,$listerror) =
                   10362:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  10363:     my $found_file = 0;
                   10364:     my $locked_file = 0;
1.991     raeburn  10365:     my @lockers;
                   10366:     my $navmap;
                   10367:     if ($env{'request.course.id'}) {
                   10368:         $navmap = Apache::lonnavmaps::navmap->new();
                   10369:     }
1.1021    raeburn  10370:     if (ref($dirlistref) eq 'ARRAY') {
                   10371:         foreach my $line (@{$dirlistref}) {
                   10372:             my ($file_name,$rest)=split(/\&/,$line,2);
                   10373:             if ($file_name eq $fname){
                   10374:                 $file_name = $path.$file_name;
                   10375:                 if ($group ne '') {
                   10376:                     $file_name = $group.$file_name;
                   10377:                 }
                   10378:                 $found_file = 1;
                   10379:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   10380:                     foreach my $lock (@lockers) {
                   10381:                         if (ref($lock) eq 'ARRAY') {
                   10382:                             my ($symb,$crsid) = @{$lock};
                   10383:                             if ($crsid eq $env{'request.course.id'}) {
                   10384:                                 if (ref($navmap)) {
                   10385:                                     my $res = $navmap->getBySymb($symb);
                   10386:                                     foreach my $part (@{$res->parts()}) { 
                   10387:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   10388:                                         unless (($slot_status == $res->RESERVED) ||
                   10389:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   10390:                                             $locked_file = 1;
                   10391:                                         }
1.991     raeburn  10392:                                     }
1.1021    raeburn  10393:                                 } else {
                   10394:                                     $locked_file = 1;
1.991     raeburn  10395:                                 }
                   10396:                             } else {
                   10397:                                 $locked_file = 1;
                   10398:                             }
                   10399:                         }
1.1021    raeburn  10400:                    }
                   10401:                 } else {
                   10402:                     my @info = split(/\&/,$rest);
                   10403:                     my $currsize = $info[6]/1000;
                   10404:                     if ($currsize < $filesize) {
                   10405:                         my $extra = $filesize - $currsize;
                   10406:                         if (($current_disk_usage + $extra) > $disk_quota) {
                   10407:                             my $msg = '<span class="LC_error">'.
                   10408:                                       &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.',
                   10409:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
                   10410:                                       '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   10411:                                                    $disk_quota,$current_disk_usage);
                   10412:                             return ('will_exceed_quota',$msg);
                   10413:                         }
1.984     raeburn  10414:                     }
                   10415:                 }
1.661     raeburn  10416:             }
                   10417:         }
                   10418:     }
                   10419:     if (($current_disk_usage + $filesize) > $disk_quota){
                   10420:         my $msg = '<span class="LC_error">'.
                   10421:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   10422:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   10423:         return ('will_exceed_quota',$msg);
                   10424:     } elsif ($found_file) {
                   10425:         if ($locked_file) {
                   10426:             my $msg = '<span class="LC_error">';
                   10427:             $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>');
                   10428:             $msg .= '</span><br />';
                   10429:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   10430:             return ('file_locked',$msg);
                   10431:         } else {
                   10432:             my $msg = '<span class="LC_error">';
1.984     raeburn  10433:             $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  10434:             $msg .= '</span>';
1.984     raeburn  10435:             return ('existingfile',$msg);
1.661     raeburn  10436:         }
                   10437:     }
                   10438: }
                   10439: 
1.987     raeburn  10440: sub check_for_traversal {
                   10441:     my ($path,$url,$toplevel) = @_;
                   10442:     my @parts=split(/\//,$path);
                   10443:     my $cleanpath;
                   10444:     my $fullpath = $url;
                   10445:     for (my $i=0;$i<@parts;$i++) {
                   10446:         next if ($parts[$i] eq '.');
                   10447:         if ($parts[$i] eq '..') {
                   10448:             $fullpath =~ s{([^/]+/)$}{};
                   10449:         } else {
                   10450:             $fullpath .= $parts[$i].'/';
                   10451:         }
                   10452:     }
                   10453:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   10454:         $cleanpath = $1;
                   10455:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   10456:         my $curr_toprel = $1;
                   10457:         my @parts = split(/\//,$curr_toprel);
                   10458:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   10459:         my @urlparts = split(/\//,$url_toprel);
                   10460:         my $doubledots;
                   10461:         my $startdiff = -1;
                   10462:         for (my $i=0; $i<@urlparts; $i++) {
                   10463:             if ($startdiff == -1) {
                   10464:                 unless ($urlparts[$i] eq $parts[$i]) {
                   10465:                     $startdiff = $i;
                   10466:                     $doubledots .= '../';
                   10467:                 }
                   10468:             } else {
                   10469:                 $doubledots .= '../';
                   10470:             }
                   10471:         }
                   10472:         if ($startdiff > -1) {
                   10473:             $cleanpath = $doubledots;
                   10474:             for (my $i=$startdiff; $i<@parts; $i++) {
                   10475:                 $cleanpath .= $parts[$i].'/';
                   10476:             }
                   10477:         }
                   10478:     }
                   10479:     $cleanpath =~ s{(/)$}{};
                   10480:     return $cleanpath;
                   10481: }
1.31      albertel 10482: 
1.1053    raeburn  10483: sub is_archive_file {
                   10484:     my ($mimetype) = @_;
                   10485:     if (($mimetype eq 'application/octet-stream') ||
                   10486:         ($mimetype eq 'application/x-stuffit') ||
                   10487:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   10488:         return 1;
                   10489:     }
                   10490:     return;
                   10491: }
                   10492: 
                   10493: sub decompress_form {
1.1065    raeburn  10494:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  10495:     my %lt = &Apache::lonlocal::texthash (
                   10496:         this => 'This file is an archive file.',
1.1067    raeburn  10497:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  10498:         itsc => 'Its contents are as follows:',
1.1053    raeburn  10499:         youm => 'You may wish to extract its contents.',
                   10500:         extr => 'Extract contents',
1.1067    raeburn  10501:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   10502:         proa => 'Process automatically?',
1.1053    raeburn  10503:         yes  => 'Yes',
                   10504:         no   => 'No',
1.1067    raeburn  10505:         fold => 'Title for folder containing movie',
                   10506:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  10507:     );
1.1065    raeburn  10508:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  10509:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  10510:     my $info = &list_archive_contents($fileloc,\@paths);
                   10511:     if (@paths) {
                   10512:         foreach my $path (@paths) {
                   10513:             $path =~ s{^/}{};
1.1067    raeburn  10514:             if ($path =~ m{^([^/]+)/$}) {
                   10515:                 $topdir = $1;
                   10516:             }
1.1065    raeburn  10517:             if ($path =~ m{^([^/]+)/}) {
                   10518:                 $toplevel{$1} = $path;
                   10519:             } else {
                   10520:                 $toplevel{$path} = $path;
                   10521:             }
                   10522:         }
                   10523:     }
1.1067    raeburn  10524:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
                   10525:         my @camtasia = ("$topdir/","$topdir/index.html",
                   10526:                         "$topdir/media/",
                   10527:                         "$topdir/media/$topdir.mp4",
                   10528:                         "$topdir/media/FirstFrame.png",
                   10529:                         "$topdir/media/player.swf",
                   10530:                         "$topdir/media/swfobject.js",
                   10531:                         "$topdir/media/expressInstall.swf");
                   10532:         my @diffs = &compare_arrays(\@paths,\@camtasia);
                   10533:         if (@diffs == 0) {
                   10534:             $is_camtasia = 1;
                   10535:         }
                   10536:     }
                   10537:     my $output;
                   10538:     if ($is_camtasia) {
                   10539:         $output = <<"ENDCAM";
                   10540: <script type="text/javascript" language="Javascript">
                   10541: // <![CDATA[
                   10542: 
                   10543: function camtasiaToggle() {
                   10544:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   10545:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
                   10546:             if (document.uploaded_decompress.autoextract_camtasia[i].value == 1) {
                   10547: 
                   10548:                 document.getElementById('camtasia_titles').style.display='block';
                   10549:             } else {
                   10550:                 document.getElementById('camtasia_titles').style.display='none';
                   10551:             }
                   10552:         }
                   10553:     }
                   10554:     return;
                   10555: }
                   10556: 
                   10557: // ]]>
                   10558: </script>
                   10559: <p>$lt{'camt'}</p>
                   10560: ENDCAM
1.1065    raeburn  10561:     } else {
1.1067    raeburn  10562:         $output = '<p>'.$lt{'this'};
                   10563:         if ($info eq '') {
                   10564:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   10565:         } else {
                   10566:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   10567:                        '<div><pre>'.$info.'</pre></div>';
                   10568:         }
1.1065    raeburn  10569:     }
1.1067    raeburn  10570:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  10571:     my $duplicates;
                   10572:     my $num = 0;
                   10573:     if (ref($dirlist) eq 'ARRAY') {
                   10574:         foreach my $item (@{$dirlist}) {
                   10575:             if (ref($item) eq 'ARRAY') {
                   10576:                 if (exists($toplevel{$item->[0]})) {
                   10577:                     $duplicates .= 
                   10578:                         &start_data_table_row().
                   10579:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   10580:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   10581:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   10582:                         'value="1" />'.&mt('Yes').'</label>'.
                   10583:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   10584:                         '<td>'.$item->[0].'</td>';
                   10585:                     if ($item->[2]) {
                   10586:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   10587:                     } else {
                   10588:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   10589:                     }
                   10590:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   10591:                                    '<td>'.
                   10592:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   10593:                                    '</td>'.
                   10594:                                    &end_data_table_row();
                   10595:                     $num ++;
                   10596:                 }
                   10597:             }
                   10598:         }
                   10599:     }
                   10600:     my $itemcount;
                   10601:     if (@paths > 0) {
                   10602:         $itemcount = scalar(@paths);
                   10603:     } else {
                   10604:         $itemcount = 1;
                   10605:     }
1.1067    raeburn  10606:     if ($is_camtasia) {
                   10607:         $output .= $lt{'auto'}.'<br />'.
                   10608:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
                   10609:                    '<input type="radio" name="autoextract_camtasia" value="1" onclick="javascript:camtasiaToggle();" checked="checked" />'.
                   10610:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   10611:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   10612:                    $lt{'no'}.'</label></span><br />'.
                   10613:                    '<div id="camtasia_titles" style="display:block">'.
                   10614:                    &Apache::lonhtmlcommon::start_pick_box().
                   10615:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   10616:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   10617:                    &Apache::lonhtmlcommon::row_closure().
                   10618:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   10619:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   10620:                    &Apache::lonhtmlcommon::row_closure(1).
                   10621:                    &Apache::lonhtmlcommon::end_pick_box().
                   10622:                    '</div>';
                   10623:     }
1.1065    raeburn  10624:     $output .= 
                   10625:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  10626:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   10627:         "\n";
1.1065    raeburn  10628:     if ($duplicates ne '') {
                   10629:         $output .= '<p><span class="LC_warning">'.
                   10630:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   10631:                    &start_data_table().
                   10632:                    &start_data_table_header_row().
                   10633:                    '<th>'.&mt('Overwrite?').'</th>'.
                   10634:                    '<th>'.&mt('Name').'</th>'.
                   10635:                    '<th>'.&mt('Type').'</th>'.
                   10636:                    '<th>'.&mt('Size').'</th>'.
                   10637:                    '<th>'.&mt('Last modified').'</th>'.
                   10638:                    &end_data_table_header_row().
                   10639:                    $duplicates.
                   10640:                    &end_data_table().
                   10641:                    '</p>';
                   10642:     }
1.1067    raeburn  10643:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  10644:     if (ref($hiddenelements) eq 'HASH') {
                   10645:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   10646:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   10647:         }
                   10648:     }
                   10649:     $output .= <<"END";
1.1067    raeburn  10650: <br />
1.1053    raeburn  10651: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   10652: </form>
                   10653: $noextract
                   10654: END
                   10655:     return $output;
                   10656: }
                   10657: 
1.1065    raeburn  10658: sub decompression_utility {
                   10659:     my ($program) = @_;
                   10660:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   10661:     my $location;
                   10662:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   10663:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   10664:                          '/usr/sbin/') {
                   10665:             if (-x $dir.$program) {
                   10666:                 $location = $dir.$program;
                   10667:                 last;
                   10668:             }
                   10669:         }
                   10670:     }
                   10671:     return $location;
                   10672: }
                   10673: 
                   10674: sub list_archive_contents {
                   10675:     my ($file,$pathsref) = @_;
                   10676:     my (@cmd,$output);
                   10677:     my $needsregexp;
                   10678:     if ($file =~ /\.zip$/) {
                   10679:         @cmd = (&decompression_utility('unzip'),"-l");
                   10680:         $needsregexp = 1;
                   10681:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   10682:              ($file =~ /\.tgz$/)) {
                   10683:         @cmd = (&decompression_utility('tar'),"-ztf");
                   10684:     } elsif ($file =~ /\.tar\.bz2$/) {
                   10685:         @cmd = (&decompression_utility('tar'),"-jtf");
                   10686:     } elsif ($file =~ m|\.tar$|) {
                   10687:         @cmd = (&decompression_utility('tar'),"-tf");
                   10688:     }
                   10689:     if (@cmd) {
                   10690:         undef($!);
                   10691:         undef($@);
                   10692:         if (open(my $fh,"-|", @cmd, $file)) {
                   10693:             while (my $line = <$fh>) {
                   10694:                 $output .= $line;
                   10695:                 chomp($line);
                   10696:                 my $item;
                   10697:                 if ($needsregexp) {
                   10698:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   10699:                 } else {
                   10700:                     $item = $line;
                   10701:                 }
                   10702:                 if ($item ne '') {
                   10703:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   10704:                         push(@{$pathsref},$item);
                   10705:                     } 
                   10706:                 }
                   10707:             }
                   10708:             close($fh);
                   10709:         }
                   10710:     }
                   10711:     return $output;
                   10712: }
                   10713: 
1.1053    raeburn  10714: sub decompress_uploaded_file {
                   10715:     my ($file,$dir) = @_;
                   10716:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   10717:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   10718:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   10719:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   10720:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   10721:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   10722:     my $decompressed = $env{'cgi.decompressed'};
                   10723:     &Apache::lonnet::delenv('cgi.file');
                   10724:     &Apache::lonnet::delenv('cgi.dir');
                   10725:     &Apache::lonnet::delenv('cgi.decompressed');
                   10726:     return ($decompressed,$result);
                   10727: }
                   10728: 
1.1055    raeburn  10729: sub process_decompression {
                   10730:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   10731:     my ($dir,$error,$warning,$output);
                   10732:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {
                   10733:         $error = &mt('File name not a supported archive file type.').
                   10734:                  '<br />'.&mt('File name should end with one of: [_1].',
                   10735:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   10736:     } else {
                   10737:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   10738:         if ($docuhome eq 'no_host') {
                   10739:             $error = &mt('Could not determine home server for course.');
                   10740:         } else {
                   10741:             my @ids=&Apache::lonnet::current_machine_ids();
                   10742:             my $currdir = "$dir_root/$destination";
                   10743:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   10744:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   10745:                        "$dir_root/$destination";
                   10746:             } else {
                   10747:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   10748:                        "$dir_root/$docudom/$docuname/$destination";
                   10749:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   10750:                     $error = &mt('Archive file not found.');
                   10751:                 }
                   10752:             }
1.1065    raeburn  10753:             my (@to_overwrite,@to_skip);
                   10754:             if ($env{'form.archive_overwrite_total'} > 0) {
                   10755:                 my $total = $env{'form.archive_overwrite_total'};
                   10756:                 for (my $i=0; $i<$total; $i++) {
                   10757:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   10758:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   10759:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   10760:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   10761:                     }
                   10762:                 }
                   10763:             }
                   10764:             my $numskip = scalar(@to_skip);
                   10765:             if (($numskip > 0) && 
                   10766:                 ($numskip == $env{'form.archive_itemcount'})) {
                   10767:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   10768:             } elsif ($dir eq '') {
1.1055    raeburn  10769:                 $error = &mt('Directory containing archive file unavailable.');
                   10770:             } elsif (!$error) {
1.1065    raeburn  10771:                 my ($decompressed,$display);
                   10772:                 if ($numskip > 0) {
                   10773:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   10774:                     mkdir("$dir/$tempdir",0755);
                   10775:                     system("mv $dir/$file $dir/$tempdir/$file");
                   10776:                     ($decompressed,$display) = 
                   10777:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   10778:                     foreach my $item (@to_skip) {
                   10779:                         if (($item ne '') && ($item !~ /\.\./)) {
                   10780:                             if (-f "$dir/$tempdir/$item") { 
                   10781:                                 unlink("$dir/$tempdir/$item");
                   10782:                             } elsif (-d "$dir/$tempdir/$item") {
                   10783:                                 system("rm -rf $dir/$tempdir/$item");
                   10784:                             }
                   10785:                         }
                   10786:                     }
                   10787:                     system("mv $dir/$tempdir/* $dir");
                   10788:                     rmdir("$dir/$tempdir");   
                   10789:                 } else {
                   10790:                     ($decompressed,$display) = 
                   10791:                         &decompress_uploaded_file($file,$dir);
                   10792:                 }
1.1055    raeburn  10793:                 if ($decompressed eq 'ok') {
1.1065    raeburn  10794:                     $output = '<p class="LC_info">'.
                   10795:                               &mt('Files extracted successfully from archive.').
                   10796:                               '</p>'."\n";
1.1055    raeburn  10797:                     my ($warning,$result,@contents);
                   10798:                     my ($newdirlistref,$newlisterror) =
                   10799:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   10800:                                                  $docuname,1);
                   10801:                     my (%is_dir,%changes,@newitems);
                   10802:                     my $dirptr = 16384;
1.1065    raeburn  10803:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  10804:                         foreach my $dir_line (@{$newdirlistref}) {
                   10805:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  10806:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   10807:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  10808:                                 push(@newitems,$item);
                   10809:                                 if ($dirptr&$testdir) {
                   10810:                                     $is_dir{$item} = 1;
                   10811:                                 }
                   10812:                                 $changes{$item} = 1;
                   10813:                             }
                   10814:                         }
                   10815:                     }
                   10816:                     if (keys(%changes) > 0) {
                   10817:                         foreach my $item (sort(@newitems)) {
                   10818:                             if ($changes{$item}) {
                   10819:                                 push(@contents,$item);
                   10820:                             }
                   10821:                         }
                   10822:                     }
                   10823:                     if (@contents > 0) {
1.1067    raeburn  10824:                         my $wantform;
                   10825:                         unless ($env{'form.autoextract_camtasia'}) {
                   10826:                             $wantform = 1;
                   10827:                         }
1.1056    raeburn  10828:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  10829:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   10830:                                                                 $currdir,\%is_dir,
                   10831:                                                                 \%children,\%parent,
1.1056    raeburn  10832:                                                                 \@contents,\%dirorder,
                   10833:                                                                 \%titles,$wantform);
1.1055    raeburn  10834:                         if ($datatable ne '') {
                   10835:                             $output .= &archive_options_form('decompressed',$datatable,
                   10836:                                                              $count,$hiddenelem);
1.1065    raeburn  10837:                             my $startcount = 6;
1.1055    raeburn  10838:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  10839:                                                            \%titles,\%children);
1.1055    raeburn  10840:                         }
1.1067    raeburn  10841:                         if ($env{'form.autoextract_camtasia'}) {
                   10842:                             my %displayed;
                   10843:                             my $total = 1;
                   10844:                             $env{'form.archive_directory'} = [];
                   10845:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   10846:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   10847:                                 $path =~ s{/$}{};
                   10848:                                 my $item;
                   10849:                                 if ($path ne '') {
                   10850:                                     $item = "$path/$titles{$i}";
                   10851:                                 } else {
                   10852:                                     $item = $titles{$i};
                   10853:                                 }
                   10854:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   10855:                                 if ($item eq $contents[0]) {
                   10856:                                     push(@{$env{'form.archive_directory'}},$i);
                   10857:                                     $env{'form.archive_'.$i} = 'display';
                   10858:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   10859:                                     $displayed{'folder'} = $i;
                   10860:                                 } elsif ($item eq "$contents[0]/index.html") {
                   10861:                                     $env{'form.archive_'.$i} = 'display';
                   10862:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   10863:                                     $displayed{'web'} = $i;
                   10864:                                 } else {
                   10865:                                     if ($item eq "$contents[0]/media") {
                   10866:                                         push(@{$env{'form.archive_directory'}},$i);
                   10867:                                     }
                   10868:                                     $env{'form.archive_'.$i} = 'dependency';
                   10869:                                 }
                   10870:                                 $total ++;
                   10871:                             }
                   10872:                             for (my $i=1; $i<$total; $i++) {
                   10873:                                 next if ($i == $displayed{'web'});
                   10874:                                 next if ($i == $displayed{'folder'});
                   10875:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   10876:                             }
                   10877:                             $env{'form.phase'} = 'decompress_cleanup';
                   10878:                             $env{'form.archivedelete'} = 1;
                   10879:                             $env{'form.archive_count'} = $total-1;
                   10880:                             $output .=
                   10881:                                 &process_extracted_files('coursedocs',$docudom,
                   10882:                                                          $docuname,$destination,
                   10883:                                                          $dir_root,$hiddenelem);
                   10884:                         }
1.1055    raeburn  10885:                     } else {
                   10886:                         $warning = &mt('No new items extracted from archive file.');
                   10887:                     }
                   10888:                 } else {
                   10889:                     $output = $display;
                   10890:                     $error = &mt('An error occurred during extraction from the archive file.');
                   10891:                 }
                   10892:             }
                   10893:         }
                   10894:     }
                   10895:     if ($error) {
                   10896:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   10897:                    $error.'</p>'."\n";
                   10898:     }
                   10899:     if ($warning) {
                   10900:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   10901:     }
                   10902:     return $output;
                   10903: }
                   10904: 
                   10905: sub get_extracted {
1.1056    raeburn  10906:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   10907:         $titles,$wantform) = @_;
1.1055    raeburn  10908:     my $count = 0;
                   10909:     my $depth = 0;
                   10910:     my $datatable;
1.1056    raeburn  10911:     my @hierarchy;
1.1055    raeburn  10912:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  10913:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   10914:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  10915:     foreach my $item (@{$contents}) {
                   10916:         $count ++;
1.1056    raeburn  10917:         @{$dirorder->{$count}} = @hierarchy;
                   10918:         $titles->{$count} = $item;
1.1055    raeburn  10919:         &archive_hierarchy($depth,$count,$parent,$children);
                   10920:         if ($wantform) {
                   10921:             $datatable .= &archive_row($is_dir->{$item},$item,
                   10922:                                        $currdir,$depth,$count);
                   10923:         }
                   10924:         if ($is_dir->{$item}) {
                   10925:             $depth ++;
1.1056    raeburn  10926:             push(@hierarchy,$count);
                   10927:             $parent->{$depth} = $count;
1.1055    raeburn  10928:             $datatable .=
                   10929:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  10930:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   10931:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  10932:             $depth --;
1.1056    raeburn  10933:             pop(@hierarchy);
1.1055    raeburn  10934:         }
                   10935:     }
                   10936:     return ($count,$datatable);
                   10937: }
                   10938: 
                   10939: sub recurse_extracted_archive {
1.1056    raeburn  10940:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   10941:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  10942:     my $result='';
1.1056    raeburn  10943:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   10944:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   10945:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  10946:         return $result;
                   10947:     }
                   10948:     my $dirptr = 16384;
                   10949:     my ($newdirlistref,$newlisterror) =
                   10950:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   10951:     if (ref($newdirlistref) eq 'ARRAY') {
                   10952:         foreach my $dir_line (@{$newdirlistref}) {
                   10953:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   10954:             unless ($item =~ /^\.+$/) {
                   10955:                 $$count ++;
1.1056    raeburn  10956:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   10957:                 $titles->{$$count} = $item;
1.1055    raeburn  10958:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  10959: 
1.1055    raeburn  10960:                 my $is_dir;
                   10961:                 if ($dirptr&$testdir) {
                   10962:                     $is_dir = 1;
                   10963:                 }
                   10964:                 if ($wantform) {
                   10965:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   10966:                 }
                   10967:                 if ($is_dir) {
                   10968:                     $$depth ++;
1.1056    raeburn  10969:                     push(@{$hierarchy},$$count);
                   10970:                     $parent->{$$depth} = $$count;
1.1055    raeburn  10971:                     $result .=
                   10972:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   10973:                                                    $docuname,$depth,$count,
1.1056    raeburn  10974:                                                    $hierarchy,$dirorder,$children,
                   10975:                                                    $parent,$titles,$wantform);
1.1055    raeburn  10976:                     $$depth --;
1.1056    raeburn  10977:                     pop(@{$hierarchy});
1.1055    raeburn  10978:                 }
                   10979:             }
                   10980:         }
                   10981:     }
                   10982:     return $result;
                   10983: }
                   10984: 
                   10985: sub archive_hierarchy {
                   10986:     my ($depth,$count,$parent,$children) =@_;
                   10987:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   10988:         if (exists($parent->{$depth})) {
                   10989:              $children->{$parent->{$depth}} .= $count.':';
                   10990:         }
                   10991:     }
                   10992:     return;
                   10993: }
                   10994: 
                   10995: sub archive_row {
                   10996:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   10997:     my ($name) = ($item =~ m{([^/]+)$});
                   10998:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  10999:                                        'display'    => 'Add as file',
1.1055    raeburn  11000:                                        'dependency' => 'Include as dependency',
                   11001:                                        'discard'    => 'Discard',
                   11002:                                       );
                   11003:     if ($is_dir) {
1.1059    raeburn  11004:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  11005:     }
1.1056    raeburn  11006:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   11007:     my $offset = 0;
1.1055    raeburn  11008:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  11009:         $offset ++;
1.1065    raeburn  11010:         if ($action ne 'display') {
                   11011:             $offset ++;
                   11012:         }  
1.1055    raeburn  11013:         $output .= '<td><span class="LC_nobreak">'.
                   11014:                    '<label><input type="radio" name="archive_'.$count.
                   11015:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   11016:         my $text = $choices{$action};
                   11017:         if ($is_dir) {
                   11018:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   11019:             if ($action eq 'display') {
1.1059    raeburn  11020:                 $text = &mt('Add as folder');
1.1055    raeburn  11021:             }
1.1056    raeburn  11022:         } else {
                   11023:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   11024: 
                   11025:         }
                   11026:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   11027:         if ($action eq 'dependency') {
                   11028:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   11029:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   11030:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   11031:                        '<option value=""></option>'."\n".
                   11032:                        '</select>'."\n".
                   11033:                        '</div>';
1.1059    raeburn  11034:         } elsif ($action eq 'display') {
                   11035:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   11036:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   11037:                        '</div>';
1.1055    raeburn  11038:         }
1.1056    raeburn  11039:         $output .= '</td>';
1.1055    raeburn  11040:     }
                   11041:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   11042:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   11043:     for (my $i=0; $i<$depth; $i++) {
                   11044:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   11045:     }
                   11046:     if ($is_dir) {
                   11047:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   11048:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   11049:     } else {
                   11050:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   11051:     }
                   11052:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   11053:                &end_data_table_row();
                   11054:     return $output;
                   11055: }
                   11056: 
                   11057: sub archive_options_form {
1.1065    raeburn  11058:     my ($form,$display,$count,$hiddenelem) = @_;
                   11059:     my %lt = &Apache::lonlocal::texthash(
                   11060:                perm => 'Permanently remove archive file?',
                   11061:                hows => 'How should each extracted item be incorporated in the course?',
                   11062:                cont => 'Content actions for all',
                   11063:                addf => 'Add as folder/file',
                   11064:                incd => 'Include as dependency for a displayed file',
                   11065:                disc => 'Discard',
                   11066:                no   => 'No',
                   11067:                yes  => 'Yes',
                   11068:                save => 'Save',
                   11069:     );
                   11070:     my $output = <<"END";
                   11071: <form name="$form" method="post" action="">
                   11072: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   11073: <label>
                   11074:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   11075: </label>
                   11076: &nbsp;
                   11077: <label>
                   11078:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   11079: </span>
                   11080: </p>
                   11081: <input type="hidden" name="phase" value="decompress_cleanup" />
                   11082: <br />$lt{'hows'}
                   11083: <div class="LC_columnSection">
                   11084:   <fieldset>
                   11085:     <legend>$lt{'cont'}</legend>
                   11086:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   11087:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   11088:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   11089:   </fieldset>
                   11090: </div>
                   11091: END
                   11092:     return $output.
1.1055    raeburn  11093:            &start_data_table()."\n".
1.1065    raeburn  11094:            $display."\n".
1.1055    raeburn  11095:            &end_data_table()."\n".
                   11096:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   11097:            $hiddenelem.
1.1065    raeburn  11098:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  11099:            '</form>';
                   11100: }
                   11101: 
                   11102: sub archive_javascript {
1.1056    raeburn  11103:     my ($startcount,$numitems,$titles,$children) = @_;
                   11104:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  11105:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  11106:     my $scripttag = <<START;
                   11107: <script type="text/javascript">
                   11108: // <![CDATA[
                   11109: 
                   11110: function checkAll(form,prefix) {
                   11111:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   11112:     for (var i=0; i < form.elements.length; i++) {
                   11113:         var id = form.elements[i].id;
                   11114:         if ((id != '') && (id != undefined)) {
                   11115:             if (idstr.test(id)) {
                   11116:                 if (form.elements[i].type == 'radio') {
                   11117:                     form.elements[i].checked = true;
1.1056    raeburn  11118:                     var nostart = i-$startcount;
1.1059    raeburn  11119:                     var offset = nostart%7;
                   11120:                     var count = (nostart-offset)/7;    
1.1056    raeburn  11121:                     dependencyCheck(form,count,offset);
1.1055    raeburn  11122:                 }
                   11123:             }
                   11124:         }
                   11125:     }
                   11126: }
                   11127: 
                   11128: function propagateCheck(form,count) {
                   11129:     if (count > 0) {
1.1059    raeburn  11130:         var startelement = $startcount + ((count-1) * 7);
                   11131:         for (var j=1; j<6; j++) {
                   11132:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  11133:                 var item = startelement + j; 
                   11134:                 if (form.elements[item].type == 'radio') {
                   11135:                     if (form.elements[item].checked) {
                   11136:                         containerCheck(form,count,j);
                   11137:                         break;
                   11138:                     }
1.1055    raeburn  11139:                 }
                   11140:             }
                   11141:         }
                   11142:     }
                   11143: }
                   11144: 
                   11145: numitems = $numitems
1.1056    raeburn  11146: var titles = new Array(numitems);
                   11147: var parents = new Array(numitems);
1.1055    raeburn  11148: for (var i=0; i<numitems; i++) {
1.1056    raeburn  11149:     parents[i] = new Array;
1.1055    raeburn  11150: }
1.1059    raeburn  11151: var maintitle = '$maintitle';
1.1055    raeburn  11152: 
                   11153: START
                   11154: 
1.1056    raeburn  11155:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   11156:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  11157:         for (my $i=0; $i<@contents; $i ++) {
                   11158:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   11159:         }
                   11160:     }
                   11161: 
1.1056    raeburn  11162:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   11163:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   11164:     }
                   11165: 
1.1055    raeburn  11166:     $scripttag .= <<END;
                   11167: 
                   11168: function containerCheck(form,count,offset) {
                   11169:     if (count > 0) {
1.1056    raeburn  11170:         dependencyCheck(form,count,offset);
1.1059    raeburn  11171:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  11172:         form.elements[item].checked = true;
                   11173:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11174:             if (parents[count].length > 0) {
                   11175:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  11176:                     containerCheck(form,parents[count][j],offset);
                   11177:                 }
                   11178:             }
                   11179:         }
                   11180:     }
                   11181: }
                   11182: 
                   11183: function dependencyCheck(form,count,offset) {
                   11184:     if (count > 0) {
1.1059    raeburn  11185:         var chosen = (offset+$startcount)+7*(count-1);
                   11186:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  11187:         var currtype = form.elements[depitem].type;
                   11188:         if (form.elements[chosen].value == 'dependency') {
                   11189:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   11190:             form.elements[depitem].options.length = 0;
                   11191:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11  raeburn  11192:             for (var i=1; i<=numitems; i++) {
                   11193:                 if (i == count) {
                   11194:                     continue;
                   11195:                 }
1.1059    raeburn  11196:                 var startelement = $startcount + (i-1) * 7;
                   11197:                 for (var j=1; j<6; j++) {
                   11198:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  11199:                         var item = startelement + j;
                   11200:                         if (form.elements[item].type == 'radio') {
                   11201:                             if (form.elements[item].checked) {
                   11202:                                 if (form.elements[item].value == 'display') {
                   11203:                                     var n = form.elements[depitem].options.length;
                   11204:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   11205:                                 }
                   11206:                             }
                   11207:                         }
                   11208:                     }
                   11209:                 }
                   11210:             }
                   11211:         } else {
                   11212:             document.getElementById('arc_depon_'+count).style.display='none';
                   11213:             form.elements[depitem].options.length = 0;
                   11214:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   11215:         }
1.1059    raeburn  11216:         titleCheck(form,count,offset);
1.1056    raeburn  11217:     }
                   11218: }
                   11219: 
                   11220: function propagateSelect(form,count,offset) {
                   11221:     if (count > 0) {
1.1065    raeburn  11222:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  11223:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   11224:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11225:             if (parents[count].length > 0) {
                   11226:                 for (var j=0; j<parents[count].length; j++) {
                   11227:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  11228:                 }
                   11229:             }
                   11230:         }
                   11231:     }
                   11232: }
1.1056    raeburn  11233: 
                   11234: function containerSelect(form,count,offset,picked) {
                   11235:     if (count > 0) {
1.1065    raeburn  11236:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  11237:         if (form.elements[item].type == 'radio') {
                   11238:             if (form.elements[item].value == 'dependency') {
                   11239:                 if (form.elements[item+1].type == 'select-one') {
                   11240:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   11241:                         if (form.elements[item+1].options[i].value == picked) {
                   11242:                             form.elements[item+1].selectedIndex = i;
                   11243:                             break;
                   11244:                         }
                   11245:                     }
                   11246:                 }
                   11247:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11248:                     if (parents[count].length > 0) {
                   11249:                         for (var j=0; j<parents[count].length; j++) {
                   11250:                             containerSelect(form,parents[count][j],offset,picked);
                   11251:                         }
                   11252:                     }
                   11253:                 }
                   11254:             }
                   11255:         }
                   11256:     }
                   11257: }
                   11258: 
1.1059    raeburn  11259: function titleCheck(form,count,offset) {
                   11260:     if (count > 0) {
                   11261:         var chosen = (offset+$startcount)+7*(count-1);
                   11262:         var depitem = $startcount + ((count-1) * 7) + 2;
                   11263:         var currtype = form.elements[depitem].type;
                   11264:         if (form.elements[chosen].value == 'display') {
                   11265:             document.getElementById('arc_title_'+count).style.display='block';
                   11266:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   11267:                 document.getElementById('archive_title_'+count).value=maintitle;
                   11268:             }
                   11269:         } else {
                   11270:             document.getElementById('arc_title_'+count).style.display='none';
                   11271:             if (currtype == 'text') { 
                   11272:                 document.getElementById('archive_title_'+count).value='';
                   11273:             }
                   11274:         }
                   11275:     }
                   11276:     return;
                   11277: }
                   11278: 
1.1055    raeburn  11279: // ]]>
                   11280: </script>
                   11281: END
                   11282:     return $scripttag;
                   11283: }
                   11284: 
                   11285: sub process_extracted_files {
1.1067    raeburn  11286:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  11287:     my $numitems = $env{'form.archive_count'};
                   11288:     return unless ($numitems);
                   11289:     my @ids=&Apache::lonnet::current_machine_ids();
                   11290:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  11291:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  11292:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11293:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11294:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   11295:         $pathtocheck = "$dir_root/$destination";
                   11296:         $dir = $dir_root;
                   11297:         $ishome = 1;
                   11298:     } else {
                   11299:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   11300:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   11301:         $dir = "$dir_root/$docudom/$docuname";    
                   11302:     }
                   11303:     my $currdir = "$dir_root/$destination";
                   11304:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   11305:     if ($env{'form.folderpath'}) {
                   11306:         my @items = split('&',$env{'form.folderpath'});
                   11307:         $folders{'0'} = $items[-2];
                   11308:         $containers{'0'}='sequence';
                   11309:     } elsif ($env{'form.pagepath'}) {
                   11310:         my @items = split('&',$env{'form.pagepath'});
                   11311:         $folders{'0'} = $items[-2];
                   11312:         $containers{'0'}='page';
                   11313:     }
                   11314:     my @archdirs = &get_env_multiple('form.archive_directory');
                   11315:     if ($numitems) {
                   11316:         for (my $i=1; $i<=$numitems; $i++) {
                   11317:             my $path = $env{'form.archive_content_'.$i};
                   11318:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   11319:                 my $item = $1;
                   11320:                 $toplevelitems{$item} = $i;
                   11321:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   11322:                     $is_dir{$item} = 1;
                   11323:                 }
                   11324:             }
                   11325:         }
                   11326:     }
1.1067    raeburn  11327:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  11328:     if (keys(%toplevelitems) > 0) {
                   11329:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  11330:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   11331:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  11332:     }
1.1066    raeburn  11333:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  11334:     if ($numitems) {
                   11335:         for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11  raeburn  11336:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  11337:             my $path = $env{'form.archive_content_'.$i};
                   11338:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11339:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   11340:                     if ($prefix ne '' && $path ne '') {
                   11341:                         if (-e $prefix.$path) {
1.1066    raeburn  11342:                             if ((@archdirs > 0) && 
                   11343:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   11344:                                 $todeletedir{$prefix.$path} = 1;
                   11345:                             } else {
                   11346:                                 $todelete{$prefix.$path} = 1;
                   11347:                             }
1.1055    raeburn  11348:                         }
                   11349:                     }
                   11350:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  11351:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  11352:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  11353:                     $docstitle = $env{'form.archive_title_'.$i};
                   11354:                     if ($docstitle eq '') {
                   11355:                         $docstitle = $title;
                   11356:                     }
1.1055    raeburn  11357:                     $outer = 0;
1.1056    raeburn  11358:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11359:                         if (@{$dirorder{$i}} > 0) {
                   11360:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  11361:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   11362:                                     $outer = $item;
                   11363:                                     last;
                   11364:                                 }
                   11365:                             }
                   11366:                         }
                   11367:                     }
                   11368:                     my ($errtext,$fatal) = 
                   11369:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   11370:                                                '/'.$folders{$outer}.'.'.
                   11371:                                                $containers{$outer});
                   11372:                     next if ($fatal);
                   11373:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   11374:                         if ($context eq 'coursedocs') {
1.1056    raeburn  11375:                             $mapinner{$i} = time;
1.1055    raeburn  11376:                             $folders{$i} = 'default_'.$mapinner{$i};
                   11377:                             $containers{$i} = 'sequence';
                   11378:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11379:                                       $folders{$i}.'.'.$containers{$i};
                   11380:                             my $newidx = &LONCAPA::map::getresidx();
                   11381:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11382:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11383:                             push(@LONCAPA::map::order,$newidx);
                   11384:                             my ($outtext,$errtext) =
                   11385:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11386:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  11387:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  11388:                             $newseqid{$i} = $newidx;
1.1067    raeburn  11389:                             unless ($errtext) {
                   11390:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   11391:                             }
1.1055    raeburn  11392:                         }
                   11393:                     } else {
                   11394:                         if ($context eq 'coursedocs') {
                   11395:                             my $newidx=&LONCAPA::map::getresidx();
                   11396:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11397:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   11398:                                       $title;
                   11399:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   11400:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   11401:                             }
                   11402:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11403:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   11404:                             }
                   11405:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11406:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  11407:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  11408:                                 unless ($ishome) {
                   11409:                                     my $fetch = "$newdest{$i}/$title";
                   11410:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   11411:                                     $prompttofetch{$fetch} = 1;
                   11412:                                 }
1.1055    raeburn  11413:                             }
                   11414:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11415:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11416:                             push(@LONCAPA::map::order, $newidx);
                   11417:                             my ($outtext,$errtext)=
                   11418:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11419:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  11420:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  11421:                             unless ($errtext) {
                   11422:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   11423:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   11424:                                 }
                   11425:                             }
1.1055    raeburn  11426:                         }
                   11427:                     }
1.1075.2.11  raeburn  11428:                 }
                   11429:             } else {
                   11430:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
                   11431:             }
                   11432:         }
                   11433:         for (my $i=1; $i<=$numitems; $i++) {
                   11434:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   11435:             my $path = $env{'form.archive_content_'.$i};
                   11436:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11437:                 my ($title) = ($path =~ m{/([^/]+)$});
                   11438:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   11439:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   11440:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11441:                         my ($itemidx,$fullpath,$relpath);
                   11442:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   11443:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  11444:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11  raeburn  11445:                                 if ($dirorder{$i}->[$j] eq $container) {
                   11446:                                     $itemidx = $j;
1.1056    raeburn  11447:                                 }
                   11448:                             }
1.1075.2.11  raeburn  11449:                         }
                   11450:                         if ($itemidx eq '') {
                   11451:                             $itemidx =  0;
                   11452:                         }
                   11453:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   11454:                             if ($mapinner{$referrer{$i}}) {
                   11455:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   11456:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11457:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11458:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11459:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11460:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11461:                                             if (!-e $fullpath) {
                   11462:                                                 mkdir($fullpath,0755);
1.1056    raeburn  11463:                                             }
                   11464:                                         }
1.1075.2.11  raeburn  11465:                                     } else {
                   11466:                                         last;
1.1056    raeburn  11467:                                     }
1.1075.2.11  raeburn  11468:                                 }
                   11469:                             }
                   11470:                         } elsif ($newdest{$referrer{$i}}) {
                   11471:                             $fullpath = $newdest{$referrer{$i}};
                   11472:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11473:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   11474:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   11475:                                     last;
                   11476:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11477:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11478:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11479:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11480:                                         if (!-e $fullpath) {
                   11481:                                             mkdir($fullpath,0755);
1.1056    raeburn  11482:                                         }
                   11483:                                     }
1.1075.2.11  raeburn  11484:                                 } else {
                   11485:                                     last;
1.1056    raeburn  11486:                                 }
1.1075.2.11  raeburn  11487:                             }
                   11488:                         }
                   11489:                         if ($fullpath ne '') {
                   11490:                             if (-e "$prefix$path") {
                   11491:                                 system("mv $prefix$path $fullpath/$title");
                   11492:                             }
                   11493:                             if (-e "$fullpath/$title") {
                   11494:                                 my $showpath;
                   11495:                                 if ($relpath ne '') {
                   11496:                                     $showpath = "$relpath/$title";
                   11497:                                 } else {
                   11498:                                     $showpath = "/$title";
1.1056    raeburn  11499:                                 }
1.1075.2.11  raeburn  11500:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   11501:                             }
                   11502:                             unless ($ishome) {
                   11503:                                 my $fetch = "$fullpath/$title";
                   11504:                                 $fetch =~ s/^\Q$prefix$dir\E//;
                   11505:                                 $prompttofetch{$fetch} = 1;
1.1055    raeburn  11506:                             }
                   11507:                         }
                   11508:                     }
1.1075.2.11  raeburn  11509:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   11510:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   11511:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  11512:                 }
                   11513:             } else {
1.1075.2.11  raeburn  11514:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055    raeburn  11515:             }
                   11516:         }
                   11517:         if (keys(%todelete)) {
                   11518:             foreach my $key (keys(%todelete)) {
                   11519:                 unlink($key);
1.1066    raeburn  11520:             }
                   11521:         }
                   11522:         if (keys(%todeletedir)) {
                   11523:             foreach my $key (keys(%todeletedir)) {
                   11524:                 rmdir($key);
                   11525:             }
                   11526:         }
                   11527:         foreach my $dir (sort(keys(%is_dir))) {
                   11528:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   11529:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  11530:             }
                   11531:         }
1.1067    raeburn  11532:         if ($result ne '') {
                   11533:             $output .= '<ul>'."\n".
                   11534:                        $result."\n".
                   11535:                        '</ul>';
                   11536:         }
                   11537:         unless ($ishome) {
                   11538:             my $replicationfail;
                   11539:             foreach my $item (keys(%prompttofetch)) {
                   11540:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   11541:                 unless ($fetchresult eq 'ok') {
                   11542:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   11543:                 }
                   11544:             }
                   11545:             if ($replicationfail) {
                   11546:                 $output .= '<p class="LC_error">'.
                   11547:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   11548:                            $replicationfail.
                   11549:                            '</ul></p>';
                   11550:             }
                   11551:         }
1.1055    raeburn  11552:     } else {
                   11553:         $warning = &mt('No items found in archive.');
                   11554:     }
                   11555:     if ($error) {
                   11556:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11557:                    $error.'</p>'."\n";
                   11558:     }
                   11559:     if ($warning) {
                   11560:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11561:     }
                   11562:     return $output;
                   11563: }
                   11564: 
1.1066    raeburn  11565: sub cleanup_empty_dirs {
                   11566:     my ($path) = @_;
                   11567:     if (($path ne '') && (-d $path)) {
                   11568:         if (opendir(my $dirh,$path)) {
                   11569:             my @dircontents = grep(!/^\./,readdir($dirh));
                   11570:             my $numitems = 0;
                   11571:             foreach my $item (@dircontents) {
                   11572:                 if (-d "$path/$item") {
                   11573:                     &recurse_dirs("$path/$item");
                   11574:                     if (-e "$path/$item") {
                   11575:                         $numitems ++;
                   11576:                     }
                   11577:                 } else {
                   11578:                     $numitems ++;
                   11579:                 }
                   11580:             }
                   11581:             if ($numitems == 0) {
                   11582:                 rmdir($path);
                   11583:             }
                   11584:             closedir($dirh);
                   11585:         }
                   11586:     }
                   11587:     return;
                   11588: }
                   11589: 
1.41      ng       11590: =pod
1.45      matthew  11591: 
1.1068    raeburn  11592: =item &get_folder_hierarchy()
                   11593: 
                   11594: Provides hierarchy of names of folders/sub-folders containing the current
                   11595: item,
                   11596: 
                   11597: Inputs: 3
                   11598:      - $navmap - navmaps object
                   11599: 
                   11600:      - $map - url for map (either the trigger itself, or map containing
                   11601:                            the resource, which is the trigger).
                   11602: 
                   11603:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   11604: 
                   11605: Outputs: 1 @pathitems - array of folder/subfolder names.
                   11606: 
                   11607: =cut
                   11608: 
                   11609: sub get_folder_hierarchy {
                   11610:     my ($navmap,$map,$showitem) = @_;
                   11611:     my @pathitems;
                   11612:     if (ref($navmap)) {
                   11613:         my $mapres = $navmap->getResourceByUrl($map);
                   11614:         if (ref($mapres)) {
                   11615:             my $pcslist = $mapres->map_hierarchy();
                   11616:             if ($pcslist ne '') {
                   11617:                 my @pcs = split(/,/,$pcslist);
                   11618:                 foreach my $pc (@pcs) {
                   11619:                     if ($pc == 1) {
                   11620:                         push(@pathitems,&mt('Main Course Documents'));
                   11621:                     } else {
                   11622:                         my $res = $navmap->getByMapPc($pc);
                   11623:                         if (ref($res)) {
                   11624:                             my $title = $res->compTitle();
                   11625:                             $title =~ s/\W+/_/g;
                   11626:                             if ($title ne '') {
                   11627:                                 push(@pathitems,$title);
                   11628:                             }
                   11629:                         }
                   11630:                     }
                   11631:                 }
                   11632:             }
1.1071    raeburn  11633:             if ($showitem) {
                   11634:                 if ($mapres->{ID} eq '0.0') {
                   11635:                     push(@pathitems,&mt('Main Course Documents'));
                   11636:                 } else {
                   11637:                     my $maptitle = $mapres->compTitle();
                   11638:                     $maptitle =~ s/\W+/_/g;
                   11639:                     if ($maptitle ne '') {
                   11640:                         push(@pathitems,$maptitle);
                   11641:                     }
1.1068    raeburn  11642:                 }
                   11643:             }
                   11644:         }
                   11645:     }
                   11646:     return @pathitems;
                   11647: }
                   11648: 
                   11649: =pod
                   11650: 
1.1015    raeburn  11651: =item * &get_turnedin_filepath()
                   11652: 
                   11653: Determines path in a user's portfolio file for storage of files uploaded
                   11654: to a specific essayresponse or dropbox item.
                   11655: 
                   11656: Inputs: 3 required + 1 optional.
                   11657: $symb is symb for resource, $uname and $udom are for current user (required).
                   11658: $caller is optional (can be "submission", if routine is called when storing
                   11659: an upoaded file when "Submit Answer" button was pressed).
                   11660: 
                   11661: Returns array containing $path and $multiresp. 
                   11662: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   11663: than one file upload item.  Callers of routine should append partid as a 
                   11664: subdirectory to $path in cases where $multiresp is 1.
                   11665: 
                   11666: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   11667: 
                   11668: =cut
                   11669: 
                   11670: sub get_turnedin_filepath {
                   11671:     my ($symb,$uname,$udom,$caller) = @_;
                   11672:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   11673:     my $turnindir;
                   11674:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   11675:     $turnindir = $userhash{'turnindir'};
                   11676:     my ($path,$multiresp);
                   11677:     if ($turnindir eq '') {
                   11678:         if ($caller eq 'submission') {
                   11679:             $turnindir = &mt('turned in');
                   11680:             $turnindir =~ s/\W+/_/g;
                   11681:             my %newhash = (
                   11682:                             'turnindir' => $turnindir,
                   11683:                           );
                   11684:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   11685:         }
                   11686:     }
                   11687:     if ($turnindir ne '') {
                   11688:         $path = '/'.$turnindir.'/';
                   11689:         my ($multipart,$turnin,@pathitems);
                   11690:         my $navmap = Apache::lonnavmaps::navmap->new();
                   11691:         if (defined($navmap)) {
                   11692:             my $mapres = $navmap->getResourceByUrl($map);
                   11693:             if (ref($mapres)) {
                   11694:                 my $pcslist = $mapres->map_hierarchy();
                   11695:                 if ($pcslist ne '') {
                   11696:                     foreach my $pc (split(/,/,$pcslist)) {
                   11697:                         my $res = $navmap->getByMapPc($pc);
                   11698:                         if (ref($res)) {
                   11699:                             my $title = $res->compTitle();
                   11700:                             $title =~ s/\W+/_/g;
                   11701:                             if ($title ne '') {
                   11702:                                 push(@pathitems,$title);
                   11703:                             }
                   11704:                         }
                   11705:                     }
                   11706:                 }
                   11707:                 my $maptitle = $mapres->compTitle();
                   11708:                 $maptitle =~ s/\W+/_/g;
                   11709:                 if ($maptitle ne '') {
                   11710:                     push(@pathitems,$maptitle);
                   11711:                 }
                   11712:                 unless ($env{'request.state'} eq 'construct') {
                   11713:                     my $res = $navmap->getBySymb($symb);
                   11714:                     if (ref($res)) {
                   11715:                         my $partlist = $res->parts();
                   11716:                         my $totaluploads = 0;
                   11717:                         if (ref($partlist) eq 'ARRAY') {
                   11718:                             foreach my $part (@{$partlist}) {
                   11719:                                 my @types = $res->responseType($part);
                   11720:                                 my @ids = $res->responseIds($part);
                   11721:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   11722:                                     if ($types[$i] eq 'essay') {
                   11723:                                         my $partid = $part.'_'.$ids[$i];
                   11724:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   11725:                                             $totaluploads ++;
                   11726:                                         }
                   11727:                                     }
                   11728:                                 }
                   11729:                             }
                   11730:                             if ($totaluploads > 1) {
                   11731:                                 $multiresp = 1;
                   11732:                             }
                   11733:                         }
                   11734:                     }
                   11735:                 }
                   11736:             } else {
                   11737:                 return;
                   11738:             }
                   11739:         } else {
                   11740:             return;
                   11741:         }
                   11742:         my $restitle=&Apache::lonnet::gettitle($symb);
                   11743:         $restitle =~ s/\W+/_/g;
                   11744:         if ($restitle eq '') {
                   11745:             $restitle = ($resurl =~ m{/[^/]+$});
                   11746:             if ($restitle eq '') {
                   11747:                 $restitle = time;
                   11748:             }
                   11749:         }
                   11750:         push(@pathitems,$restitle);
                   11751:         $path .= join('/',@pathitems);
                   11752:     }
                   11753:     return ($path,$multiresp);
                   11754: }
                   11755: 
                   11756: =pod
                   11757: 
1.464     albertel 11758: =back
1.41      ng       11759: 
1.112     bowersj2 11760: =head1 CSV Upload/Handling functions
1.38      albertel 11761: 
1.41      ng       11762: =over 4
                   11763: 
1.648     raeburn  11764: =item * &upfile_store($r)
1.41      ng       11765: 
                   11766: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 11767: needs $env{'form.upfile'}
1.41      ng       11768: returns $datatoken to be put into hidden field
                   11769: 
                   11770: =cut
1.31      albertel 11771: 
                   11772: sub upfile_store {
                   11773:     my $r=shift;
1.258     albertel 11774:     $env{'form.upfile'}=~s/\r/\n/gs;
                   11775:     $env{'form.upfile'}=~s/\f/\n/gs;
                   11776:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   11777:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 11778: 
1.258     albertel 11779:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   11780: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 11781:     {
1.158     raeburn  11782:         my $datafile = $r->dir_config('lonDaemons').
                   11783:                            '/tmp/'.$datatoken.'.tmp';
                   11784:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 11785:             print $fh $env{'form.upfile'};
1.158     raeburn  11786:             close($fh);
                   11787:         }
1.31      albertel 11788:     }
                   11789:     return $datatoken;
                   11790: }
                   11791: 
1.56      matthew  11792: =pod
                   11793: 
1.648     raeburn  11794: =item * &load_tmp_file($r)
1.41      ng       11795: 
                   11796: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 11797: needs $env{'form.datatoken'},
                   11798: sets $env{'form.upfile'} to the contents of the file
1.41      ng       11799: 
                   11800: =cut
1.31      albertel 11801: 
                   11802: sub load_tmp_file {
                   11803:     my $r=shift;
                   11804:     my @studentdata=();
                   11805:     {
1.158     raeburn  11806:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 11807:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  11808:         if ( open(my $fh,"<$studentfile") ) {
                   11809:             @studentdata=<$fh>;
                   11810:             close($fh);
                   11811:         }
1.31      albertel 11812:     }
1.258     albertel 11813:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 11814: }
                   11815: 
1.56      matthew  11816: =pod
                   11817: 
1.648     raeburn  11818: =item * &upfile_record_sep()
1.41      ng       11819: 
                   11820: Separate uploaded file into records
                   11821: returns array of records,
1.258     albertel 11822: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       11823: 
                   11824: =cut
1.31      albertel 11825: 
                   11826: sub upfile_record_sep {
1.258     albertel 11827:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 11828:     } else {
1.248     albertel 11829: 	my @records;
1.258     albertel 11830: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 11831: 	    if ($line=~/^\s*$/) { next; }
                   11832: 	    push(@records,$line);
                   11833: 	}
                   11834: 	return @records;
1.31      albertel 11835:     }
                   11836: }
                   11837: 
1.56      matthew  11838: =pod
                   11839: 
1.648     raeburn  11840: =item * &record_sep($record)
1.41      ng       11841: 
1.258     albertel 11842: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       11843: 
                   11844: =cut
                   11845: 
1.263     www      11846: sub takeleft {
                   11847:     my $index=shift;
                   11848:     return substr('0000'.$index,-4,4);
                   11849: }
                   11850: 
1.31      albertel 11851: sub record_sep {
                   11852:     my $record=shift;
                   11853:     my %components=();
1.258     albertel 11854:     if ($env{'form.upfiletype'} eq 'xml') {
                   11855:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 11856:         my $i=0;
1.356     albertel 11857:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 11858:             $field=~s/^(\"|\')//;
                   11859:             $field=~s/(\"|\')$//;
1.263     www      11860:             $components{&takeleft($i)}=$field;
1.31      albertel 11861:             $i++;
                   11862:         }
1.258     albertel 11863:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 11864:         my $i=0;
1.356     albertel 11865:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 11866:             $field=~s/^(\"|\')//;
                   11867:             $field=~s/(\"|\')$//;
1.263     www      11868:             $components{&takeleft($i)}=$field;
1.31      albertel 11869:             $i++;
                   11870:         }
                   11871:     } else {
1.561     www      11872:         my $separator=',';
1.480     banghart 11873:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      11874:             $separator=';';
1.480     banghart 11875:         }
1.31      albertel 11876:         my $i=0;
1.561     www      11877: # the character we are looking for to indicate the end of a quote or a record 
                   11878:         my $looking_for=$separator;
                   11879: # do not add the characters to the fields
                   11880:         my $ignore=0;
                   11881: # we just encountered a separator (or the beginning of the record)
                   11882:         my $just_found_separator=1;
                   11883: # store the field we are working on here
                   11884:         my $field='';
                   11885: # work our way through all characters in record
                   11886:         foreach my $character ($record=~/(.)/g) {
                   11887:             if ($character eq $looking_for) {
                   11888:                if ($character ne $separator) {
                   11889: # Found the end of a quote, again looking for separator
                   11890:                   $looking_for=$separator;
                   11891:                   $ignore=1;
                   11892:                } else {
                   11893: # Found a separator, store away what we got
                   11894:                   $components{&takeleft($i)}=$field;
                   11895: 	          $i++;
                   11896:                   $just_found_separator=1;
                   11897:                   $ignore=0;
                   11898:                   $field='';
                   11899:                }
                   11900:                next;
                   11901:             }
                   11902: # single or double quotation marks after a separator indicate beginning of a quote
                   11903: # we are now looking for the end of the quote and need to ignore separators
                   11904:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   11905:                $looking_for=$character;
                   11906:                next;
                   11907:             }
                   11908: # ignore would be true after we reached the end of a quote
                   11909:             if ($ignore) { next; }
                   11910:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   11911:             $field.=$character;
                   11912:             $just_found_separator=0; 
1.31      albertel 11913:         }
1.561     www      11914: # catch the very last entry, since we never encountered the separator
                   11915:         $components{&takeleft($i)}=$field;
1.31      albertel 11916:     }
                   11917:     return %components;
                   11918: }
                   11919: 
1.144     matthew  11920: ######################################################
                   11921: ######################################################
                   11922: 
1.56      matthew  11923: =pod
                   11924: 
1.648     raeburn  11925: =item * &upfile_select_html()
1.41      ng       11926: 
1.144     matthew  11927: Return HTML code to select a file from the users machine and specify 
                   11928: the file type.
1.41      ng       11929: 
                   11930: =cut
                   11931: 
1.144     matthew  11932: ######################################################
                   11933: ######################################################
1.31      albertel 11934: sub upfile_select_html {
1.144     matthew  11935:     my %Types = (
                   11936:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 11937:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  11938:                  space => &mt('Space separated'),
                   11939:                  tab   => &mt('Tabulator separated'),
                   11940: #                 xml   => &mt('HTML/XML'),
                   11941:                  );
                   11942:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  11943:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  11944:     foreach my $type (sort(keys(%Types))) {
                   11945:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   11946:     }
                   11947:     $Str .= "</select>\n";
                   11948:     return $Str;
1.31      albertel 11949: }
                   11950: 
1.301     albertel 11951: sub get_samples {
                   11952:     my ($records,$toget) = @_;
                   11953:     my @samples=({});
                   11954:     my $got=0;
                   11955:     foreach my $rec (@$records) {
                   11956: 	my %temp = &record_sep($rec);
                   11957: 	if (! grep(/\S/, values(%temp))) { next; }
                   11958: 	if (%temp) {
                   11959: 	    $samples[$got]=\%temp;
                   11960: 	    $got++;
                   11961: 	    if ($got == $toget) { last; }
                   11962: 	}
                   11963:     }
                   11964:     return \@samples;
                   11965: }
                   11966: 
1.144     matthew  11967: ######################################################
                   11968: ######################################################
                   11969: 
1.56      matthew  11970: =pod
                   11971: 
1.648     raeburn  11972: =item * &csv_print_samples($r,$records)
1.41      ng       11973: 
                   11974: Prints a table of sample values from each column uploaded $r is an
                   11975: Apache Request ref, $records is an arrayref from
                   11976: &Apache::loncommon::upfile_record_sep
                   11977: 
                   11978: =cut
                   11979: 
1.144     matthew  11980: ######################################################
                   11981: ######################################################
1.31      albertel 11982: sub csv_print_samples {
                   11983:     my ($r,$records) = @_;
1.662     bisitz   11984:     my $samples = &get_samples($records,5);
1.301     albertel 11985: 
1.594     raeburn  11986:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   11987:               &start_data_table_header_row());
1.356     albertel 11988:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   11989:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  11990:     $r->print(&end_data_table_header_row());
1.301     albertel 11991:     foreach my $hash (@$samples) {
1.594     raeburn  11992: 	$r->print(&start_data_table_row());
1.356     albertel 11993: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 11994: 	    $r->print('<td>');
1.356     albertel 11995: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 11996: 	    $r->print('</td>');
                   11997: 	}
1.594     raeburn  11998: 	$r->print(&end_data_table_row());
1.31      albertel 11999:     }
1.594     raeburn  12000:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 12001: }
                   12002: 
1.144     matthew  12003: ######################################################
                   12004: ######################################################
                   12005: 
1.56      matthew  12006: =pod
                   12007: 
1.648     raeburn  12008: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       12009: 
                   12010: Prints a table to create associations between values and table columns.
1.144     matthew  12011: 
1.41      ng       12012: $r is an Apache Request ref,
                   12013: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  12014: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       12015: 
                   12016: =cut
                   12017: 
1.144     matthew  12018: ######################################################
                   12019: ######################################################
1.31      albertel 12020: sub csv_print_select_table {
                   12021:     my ($r,$records,$d) = @_;
1.301     albertel 12022:     my $i=0;
                   12023:     my $samples = &get_samples($records,1);
1.144     matthew  12024:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  12025: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  12026:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  12027:               '<th>'.&mt('Column').'</th>'.
                   12028:               &end_data_table_header_row()."\n");
1.356     albertel 12029:     foreach my $array_ref (@$d) {
                   12030: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  12031: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 12032: 
1.875     bisitz   12033: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  12034: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 12035: 	$r->print('<option value="none"></option>');
1.356     albertel 12036: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   12037: 	    $r->print('<option value="'.$sample.'"'.
                   12038:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   12039:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 12040: 	}
1.594     raeburn  12041: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 12042: 	$i++;
                   12043:     }
1.594     raeburn  12044:     $r->print(&end_data_table());
1.31      albertel 12045:     $i--;
                   12046:     return $i;
                   12047: }
1.56      matthew  12048: 
1.144     matthew  12049: ######################################################
                   12050: ######################################################
                   12051: 
1.56      matthew  12052: =pod
1.31      albertel 12053: 
1.648     raeburn  12054: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       12055: 
                   12056: Prints a table of sample values from the upload and can make associate samples to internal names.
                   12057: 
                   12058: $r is an Apache Request ref,
                   12059: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   12060: $d is an array of 2 element arrays (internal name, displayed name)
                   12061: 
                   12062: =cut
                   12063: 
1.144     matthew  12064: ######################################################
                   12065: ######################################################
1.31      albertel 12066: sub csv_samples_select_table {
                   12067:     my ($r,$records,$d) = @_;
                   12068:     my $i=0;
1.144     matthew  12069:     #
1.662     bisitz   12070:     my $max_samples = 5;
                   12071:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  12072:     $r->print(&start_data_table().
                   12073:               &start_data_table_header_row().'<th>'.
                   12074:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   12075:               &end_data_table_header_row());
1.301     albertel 12076: 
                   12077:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  12078: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  12079: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 12080: 	foreach my $option (@$d) {
                   12081: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  12082: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 12083:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  12084:                       $display.'</option>');
1.31      albertel 12085: 	}
                   12086: 	$r->print('</select></td><td>');
1.662     bisitz   12087: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 12088: 	    if (defined($samples->[$line]{$key})) { 
                   12089: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   12090: 	    }
                   12091: 	}
1.594     raeburn  12092: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 12093: 	$i++;
                   12094:     }
1.594     raeburn  12095:     $r->print(&end_data_table());
1.31      albertel 12096:     $i--;
                   12097:     return($i);
1.115     matthew  12098: }
                   12099: 
1.144     matthew  12100: ######################################################
                   12101: ######################################################
                   12102: 
1.115     matthew  12103: =pod
                   12104: 
1.648     raeburn  12105: =item * &clean_excel_name($name)
1.115     matthew  12106: 
                   12107: Returns a replacement for $name which does not contain any illegal characters.
                   12108: 
                   12109: =cut
                   12110: 
1.144     matthew  12111: ######################################################
                   12112: ######################################################
1.115     matthew  12113: sub clean_excel_name {
                   12114:     my ($name) = @_;
                   12115:     $name =~ s/[:\*\?\/\\]//g;
                   12116:     if (length($name) > 31) {
                   12117:         $name = substr($name,0,31);
                   12118:     }
                   12119:     return $name;
1.25      albertel 12120: }
1.84      albertel 12121: 
1.85      albertel 12122: =pod
                   12123: 
1.648     raeburn  12124: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 12125: 
                   12126: Returns either 1 or undef
                   12127: 
                   12128: 1 if the part is to be hidden, undef if it is to be shown
                   12129: 
                   12130: Arguments are:
                   12131: 
                   12132: $id the id of the part to be checked
                   12133: $symb, optional the symb of the resource to check
                   12134: $udom, optional the domain of the user to check for
                   12135: $uname, optional the username of the user to check for
                   12136: 
                   12137: =cut
1.84      albertel 12138: 
                   12139: sub check_if_partid_hidden {
                   12140:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 12141:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 12142: 					 $symb,$udom,$uname);
1.141     albertel 12143:     my $truth=1;
                   12144:     #if the string starts with !, then the list is the list to show not hide
                   12145:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 12146:     my @hiddenlist=split(/,/,$hiddenparts);
                   12147:     foreach my $checkid (@hiddenlist) {
1.141     albertel 12148: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 12149:     }
1.141     albertel 12150:     return !$truth;
1.84      albertel 12151: }
1.127     matthew  12152: 
1.138     matthew  12153: 
                   12154: ############################################################
                   12155: ############################################################
                   12156: 
                   12157: =pod
                   12158: 
1.157     matthew  12159: =back 
                   12160: 
1.138     matthew  12161: =head1 cgi-bin script and graphing routines
                   12162: 
1.157     matthew  12163: =over 4
                   12164: 
1.648     raeburn  12165: =item * &get_cgi_id()
1.138     matthew  12166: 
                   12167: Inputs: none
                   12168: 
                   12169: Returns an id which can be used to pass environment variables
                   12170: to various cgi-bin scripts.  These environment variables will
                   12171: be removed from the users environment after a given time by
                   12172: the routine &Apache::lonnet::transfer_profile_to_env.
                   12173: 
                   12174: =cut
                   12175: 
                   12176: ############################################################
                   12177: ############################################################
1.152     albertel 12178: my $uniq=0;
1.136     matthew  12179: sub get_cgi_id {
1.154     albertel 12180:     $uniq=($uniq+1)%100000;
1.280     albertel 12181:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  12182: }
                   12183: 
1.127     matthew  12184: ############################################################
                   12185: ############################################################
                   12186: 
                   12187: =pod
                   12188: 
1.648     raeburn  12189: =item * &DrawBarGraph()
1.127     matthew  12190: 
1.138     matthew  12191: Facilitates the plotting of data in a (stacked) bar graph.
                   12192: Puts plot definition data into the users environment in order for 
                   12193: graph.png to plot it.  Returns an <img> tag for the plot.
                   12194: The bars on the plot are labeled '1','2',...,'n'.
                   12195: 
                   12196: Inputs:
                   12197: 
                   12198: =over 4
                   12199: 
                   12200: =item $Title: string, the title of the plot
                   12201: 
                   12202: =item $xlabel: string, text describing the X-axis of the plot
                   12203: 
                   12204: =item $ylabel: string, text describing the Y-axis of the plot
                   12205: 
                   12206: =item $Max: scalar, the maximum Y value to use in the plot
                   12207: If $Max is < any data point, the graph will not be rendered.
                   12208: 
1.140     matthew  12209: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  12210: they are plotted.  If undefined, default values will be used.
                   12211: 
1.178     matthew  12212: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   12213: 
1.138     matthew  12214: =item @Values: An array of array references.  Each array reference holds data
                   12215: to be plotted in a stacked bar chart.
                   12216: 
1.239     matthew  12217: =item If the final element of @Values is a hash reference the key/value
                   12218: pairs will be added to the graph definition.
                   12219: 
1.138     matthew  12220: =back
                   12221: 
                   12222: Returns:
                   12223: 
                   12224: An <img> tag which references graph.png and the appropriate identifying
                   12225: information for the plot.
                   12226: 
1.127     matthew  12227: =cut
                   12228: 
                   12229: ############################################################
                   12230: ############################################################
1.134     matthew  12231: sub DrawBarGraph {
1.178     matthew  12232:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  12233:     #
                   12234:     if (! defined($colors)) {
                   12235:         $colors = ['#33ff00', 
                   12236:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   12237:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   12238:                   ]; 
                   12239:     }
1.228     matthew  12240:     my $extra_settings = {};
                   12241:     if (ref($Values[-1]) eq 'HASH') {
                   12242:         $extra_settings = pop(@Values);
                   12243:     }
1.127     matthew  12244:     #
1.136     matthew  12245:     my $identifier = &get_cgi_id();
                   12246:     my $id = 'cgi.'.$identifier;        
1.129     matthew  12247:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  12248:         return '';
                   12249:     }
1.225     matthew  12250:     #
                   12251:     my @Labels;
                   12252:     if (defined($labels)) {
                   12253:         @Labels = @$labels;
                   12254:     } else {
                   12255:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   12256:             push (@Labels,$i+1);
                   12257:         }
                   12258:     }
                   12259:     #
1.129     matthew  12260:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  12261:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  12262:     my %ValuesHash;
                   12263:     my $NumSets=1;
                   12264:     foreach my $array (@Values) {
                   12265:         next if (! ref($array));
1.136     matthew  12266:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  12267:             join(',',@$array);
1.129     matthew  12268:     }
1.127     matthew  12269:     #
1.136     matthew  12270:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  12271:     if ($NumBars < 3) {
                   12272:         $width = 120+$NumBars*32;
1.220     matthew  12273:         $xskip = 1;
1.225     matthew  12274:         $bar_width = 30;
                   12275:     } elsif ($NumBars < 5) {
                   12276:         $width = 120+$NumBars*20;
                   12277:         $xskip = 1;
                   12278:         $bar_width = 20;
1.220     matthew  12279:     } elsif ($NumBars < 10) {
1.136     matthew  12280:         $width = 120+$NumBars*15;
                   12281:         $xskip = 1;
                   12282:         $bar_width = 15;
                   12283:     } elsif ($NumBars <= 25) {
                   12284:         $width = 120+$NumBars*11;
                   12285:         $xskip = 5;
                   12286:         $bar_width = 8;
                   12287:     } elsif ($NumBars <= 50) {
                   12288:         $width = 120+$NumBars*8;
                   12289:         $xskip = 5;
                   12290:         $bar_width = 4;
                   12291:     } else {
                   12292:         $width = 120+$NumBars*8;
                   12293:         $xskip = 5;
                   12294:         $bar_width = 4;
                   12295:     }
                   12296:     #
1.137     matthew  12297:     $Max = 1 if ($Max < 1);
                   12298:     if ( int($Max) < $Max ) {
                   12299:         $Max++;
                   12300:         $Max = int($Max);
                   12301:     }
1.127     matthew  12302:     $Title  = '' if (! defined($Title));
                   12303:     $xlabel = '' if (! defined($xlabel));
                   12304:     $ylabel = '' if (! defined($ylabel));
1.369     www      12305:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   12306:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   12307:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  12308:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  12309:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   12310:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   12311:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   12312:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12313:     $ValuesHash{$id.'.height'}   = $height;
                   12314:     $ValuesHash{$id.'.width'}    = $width;
                   12315:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   12316:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   12317:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  12318:     #
1.228     matthew  12319:     # Deal with other parameters
                   12320:     while (my ($key,$value) = each(%$extra_settings)) {
                   12321:         $ValuesHash{$id.'.'.$key} = $value;
                   12322:     }
                   12323:     #
1.646     raeburn  12324:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  12325:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12326: }
                   12327: 
                   12328: ############################################################
                   12329: ############################################################
                   12330: 
                   12331: =pod
                   12332: 
1.648     raeburn  12333: =item * &DrawXYGraph()
1.137     matthew  12334: 
1.138     matthew  12335: Facilitates the plotting of data in an XY graph.
                   12336: Puts plot definition data into the users environment in order for 
                   12337: graph.png to plot it.  Returns an <img> tag for the plot.
                   12338: 
                   12339: Inputs:
                   12340: 
                   12341: =over 4
                   12342: 
                   12343: =item $Title: string, the title of the plot
                   12344: 
                   12345: =item $xlabel: string, text describing the X-axis of the plot
                   12346: 
                   12347: =item $ylabel: string, text describing the Y-axis of the plot
                   12348: 
                   12349: =item $Max: scalar, the maximum Y value to use in the plot
                   12350: If $Max is < any data point, the graph will not be rendered.
                   12351: 
                   12352: =item $colors: Array ref containing the hex color codes for the data to be 
                   12353: plotted in.  If undefined, default values will be used.
                   12354: 
                   12355: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12356: 
                   12357: =item $Ydata: Array ref containing Array refs.  
1.185     www      12358: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  12359: 
                   12360: =item %Values: hash indicating or overriding any default values which are 
                   12361: passed to graph.png.  
                   12362: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12363: 
                   12364: =back
                   12365: 
                   12366: Returns:
                   12367: 
                   12368: An <img> tag which references graph.png and the appropriate identifying
                   12369: information for the plot.
                   12370: 
1.137     matthew  12371: =cut
                   12372: 
                   12373: ############################################################
                   12374: ############################################################
                   12375: sub DrawXYGraph {
                   12376:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   12377:     #
                   12378:     # Create the identifier for the graph
                   12379:     my $identifier = &get_cgi_id();
                   12380:     my $id = 'cgi.'.$identifier;
                   12381:     #
                   12382:     $Title  = '' if (! defined($Title));
                   12383:     $xlabel = '' if (! defined($xlabel));
                   12384:     $ylabel = '' if (! defined($ylabel));
                   12385:     my %ValuesHash = 
                   12386:         (
1.369     www      12387:          $id.'.title'  => &escape($Title),
                   12388:          $id.'.xlabel' => &escape($xlabel),
                   12389:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  12390:          $id.'.y_max_value'=> $Max,
                   12391:          $id.'.labels'     => join(',',@$Xlabels),
                   12392:          $id.'.PlotType'   => 'XY',
                   12393:          );
                   12394:     #
                   12395:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12396:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12397:     }
                   12398:     #
                   12399:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   12400:         return '';
                   12401:     }
                   12402:     my $NumSets=1;
1.138     matthew  12403:     foreach my $array (@{$Ydata}){
1.137     matthew  12404:         next if (! ref($array));
                   12405:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   12406:     }
1.138     matthew  12407:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  12408:     #
                   12409:     # Deal with other parameters
                   12410:     while (my ($key,$value) = each(%Values)) {
                   12411:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  12412:     }
                   12413:     #
1.646     raeburn  12414:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  12415:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12416: }
                   12417: 
                   12418: ############################################################
                   12419: ############################################################
                   12420: 
                   12421: =pod
                   12422: 
1.648     raeburn  12423: =item * &DrawXYYGraph()
1.138     matthew  12424: 
                   12425: Facilitates the plotting of data in an XY graph with two Y axes.
                   12426: Puts plot definition data into the users environment in order for 
                   12427: graph.png to plot it.  Returns an <img> tag for the plot.
                   12428: 
                   12429: Inputs:
                   12430: 
                   12431: =over 4
                   12432: 
                   12433: =item $Title: string, the title of the plot
                   12434: 
                   12435: =item $xlabel: string, text describing the X-axis of the plot
                   12436: 
                   12437: =item $ylabel: string, text describing the Y-axis of the plot
                   12438: 
                   12439: =item $colors: Array ref containing the hex color codes for the data to be 
                   12440: plotted in.  If undefined, default values will be used.
                   12441: 
                   12442: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12443: 
                   12444: =item $Ydata1: The first data set
                   12445: 
                   12446: =item $Min1: The minimum value of the left Y-axis
                   12447: 
                   12448: =item $Max1: The maximum value of the left Y-axis
                   12449: 
                   12450: =item $Ydata2: The second data set
                   12451: 
                   12452: =item $Min2: The minimum value of the right Y-axis
                   12453: 
                   12454: =item $Max2: The maximum value of the left Y-axis
                   12455: 
                   12456: =item %Values: hash indicating or overriding any default values which are 
                   12457: passed to graph.png.  
                   12458: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12459: 
                   12460: =back
                   12461: 
                   12462: Returns:
                   12463: 
                   12464: An <img> tag which references graph.png and the appropriate identifying
                   12465: information for the plot.
1.136     matthew  12466: 
                   12467: =cut
                   12468: 
                   12469: ############################################################
                   12470: ############################################################
1.137     matthew  12471: sub DrawXYYGraph {
                   12472:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   12473:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  12474:     #
                   12475:     # Create the identifier for the graph
                   12476:     my $identifier = &get_cgi_id();
                   12477:     my $id = 'cgi.'.$identifier;
                   12478:     #
                   12479:     $Title  = '' if (! defined($Title));
                   12480:     $xlabel = '' if (! defined($xlabel));
                   12481:     $ylabel = '' if (! defined($ylabel));
                   12482:     my %ValuesHash = 
                   12483:         (
1.369     www      12484:          $id.'.title'  => &escape($Title),
                   12485:          $id.'.xlabel' => &escape($xlabel),
                   12486:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  12487:          $id.'.labels' => join(',',@$Xlabels),
                   12488:          $id.'.PlotType' => 'XY',
                   12489:          $id.'.NumSets' => 2,
1.137     matthew  12490:          $id.'.two_axes' => 1,
                   12491:          $id.'.y1_max_value' => $Max1,
                   12492:          $id.'.y1_min_value' => $Min1,
                   12493:          $id.'.y2_max_value' => $Max2,
                   12494:          $id.'.y2_min_value' => $Min2,
1.136     matthew  12495:          );
                   12496:     #
1.137     matthew  12497:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12498:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12499:     }
                   12500:     #
                   12501:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   12502:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  12503:         return '';
                   12504:     }
                   12505:     my $NumSets=1;
1.137     matthew  12506:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  12507:         next if (! ref($array));
                   12508:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  12509:     }
                   12510:     #
                   12511:     # Deal with other parameters
                   12512:     while (my ($key,$value) = each(%Values)) {
                   12513:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  12514:     }
                   12515:     #
1.646     raeburn  12516:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 12517:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  12518: }
                   12519: 
                   12520: ############################################################
                   12521: ############################################################
                   12522: 
                   12523: =pod
                   12524: 
1.157     matthew  12525: =back 
                   12526: 
1.139     matthew  12527: =head1 Statistics helper routines?  
                   12528: 
                   12529: Bad place for them but what the hell.
                   12530: 
1.157     matthew  12531: =over 4
                   12532: 
1.648     raeburn  12533: =item * &chartlink()
1.139     matthew  12534: 
                   12535: Returns a link to the chart for a specific student.  
                   12536: 
                   12537: Inputs:
                   12538: 
                   12539: =over 4
                   12540: 
                   12541: =item $linktext: The text of the link
                   12542: 
                   12543: =item $sname: The students username
                   12544: 
                   12545: =item $sdomain: The students domain
                   12546: 
                   12547: =back
                   12548: 
1.157     matthew  12549: =back
                   12550: 
1.139     matthew  12551: =cut
                   12552: 
                   12553: ############################################################
                   12554: ############################################################
                   12555: sub chartlink {
                   12556:     my ($linktext, $sname, $sdomain) = @_;
                   12557:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      12558:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 12559:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  12560:        '">'.$linktext.'</a>';
1.153     matthew  12561: }
                   12562: 
                   12563: #######################################################
                   12564: #######################################################
                   12565: 
                   12566: =pod
                   12567: 
                   12568: =head1 Course Environment Routines
1.157     matthew  12569: 
                   12570: =over 4
1.153     matthew  12571: 
1.648     raeburn  12572: =item * &restore_course_settings()
1.153     matthew  12573: 
1.648     raeburn  12574: =item * &store_course_settings()
1.153     matthew  12575: 
                   12576: Restores/Store indicated form parameters from the course environment.
                   12577: Will not overwrite existing values of the form parameters.
                   12578: 
                   12579: Inputs: 
                   12580: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   12581: 
                   12582: a hash ref describing the data to be stored.  For example:
                   12583:    
                   12584: %Save_Parameters = ('Status' => 'scalar',
                   12585:     'chartoutputmode' => 'scalar',
                   12586:     'chartoutputdata' => 'scalar',
                   12587:     'Section' => 'array',
1.373     raeburn  12588:     'Group' => 'array',
1.153     matthew  12589:     'StudentData' => 'array',
                   12590:     'Maps' => 'array');
                   12591: 
                   12592: Returns: both routines return nothing
                   12593: 
1.631     raeburn  12594: =back
                   12595: 
1.153     matthew  12596: =cut
                   12597: 
                   12598: #######################################################
                   12599: #######################################################
                   12600: sub store_course_settings {
1.496     albertel 12601:     return &store_settings($env{'request.course.id'},@_);
                   12602: }
                   12603: 
                   12604: sub store_settings {
1.153     matthew  12605:     # save to the environment
                   12606:     # appenv the same items, just to be safe
1.300     albertel 12607:     my $udom  = $env{'user.domain'};
                   12608:     my $uname = $env{'user.name'};
1.496     albertel 12609:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  12610:     my %SaveHash;
                   12611:     my %AppHash;
                   12612:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 12613:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 12614:         my $envname = 'environment.'.$basename;
1.258     albertel 12615:         if (exists($env{'form.'.$setting})) {
1.153     matthew  12616:             # Save this value away
                   12617:             if ($type eq 'scalar' &&
1.258     albertel 12618:                 (! exists($env{$envname}) || 
                   12619:                  $env{$envname} ne $env{'form.'.$setting})) {
                   12620:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   12621:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  12622:             } elsif ($type eq 'array') {
                   12623:                 my $stored_form;
1.258     albertel 12624:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  12625:                     $stored_form = join(',',
                   12626:                                         map {
1.369     www      12627:                                             &escape($_);
1.258     albertel 12628:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  12629:                 } else {
                   12630:                     $stored_form = 
1.369     www      12631:                         &escape($env{'form.'.$setting});
1.153     matthew  12632:                 }
                   12633:                 # Determine if the array contents are the same.
1.258     albertel 12634:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  12635:                     $SaveHash{$basename} = $stored_form;
                   12636:                     $AppHash{$envname}   = $stored_form;
                   12637:                 }
                   12638:             }
                   12639:         }
                   12640:     }
                   12641:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 12642:                                           $udom,$uname);
1.153     matthew  12643:     if ($put_result !~ /^(ok|delayed)/) {
                   12644:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   12645:                                  'got error:'.$put_result);
                   12646:     }
                   12647:     # Make sure these settings stick around in this session, too
1.646     raeburn  12648:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  12649:     return;
                   12650: }
                   12651: 
                   12652: sub restore_course_settings {
1.499     albertel 12653:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 12654: }
                   12655: 
                   12656: sub restore_settings {
                   12657:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  12658:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 12659:         next if (exists($env{'form.'.$setting}));
1.496     albertel 12660:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  12661:             '.'.$setting;
1.258     albertel 12662:         if (exists($env{$envname})) {
1.153     matthew  12663:             if ($type eq 'scalar') {
1.258     albertel 12664:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  12665:             } elsif ($type eq 'array') {
1.258     albertel 12666:                 $env{'form.'.$setting} = [ 
1.153     matthew  12667:                                            map { 
1.369     www      12668:                                                &unescape($_); 
1.258     albertel 12669:                                            } split(',',$env{$envname})
1.153     matthew  12670:                                            ];
                   12671:             }
                   12672:         }
                   12673:     }
1.127     matthew  12674: }
                   12675: 
1.618     raeburn  12676: #######################################################
                   12677: #######################################################
                   12678: 
                   12679: =pod
                   12680: 
                   12681: =head1 Domain E-mail Routines  
                   12682: 
                   12683: =over 4
                   12684: 
1.648     raeburn  12685: =item * &build_recipient_list()
1.618     raeburn  12686: 
1.884     raeburn  12687: Build recipient lists for five types of e-mail:
1.766     raeburn  12688: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884     raeburn  12689: (d) Help requests, (e) Course requests needing approval,  generated by
                   12690: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
                   12691: loncoursequeueadmin.pm respectively.
1.618     raeburn  12692: 
                   12693: Inputs:
1.619     raeburn  12694: defmail (scalar - email address of default recipient), 
1.618     raeburn  12695: mailing type (scalar - errormail, packagesmail, or helpdeskmail), 
1.619     raeburn  12696: defdom (domain for which to retrieve configuration settings),
                   12697: origmail (scalar - email address of recipient from loncapa.conf, 
                   12698: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  12699: 
1.655     raeburn  12700: Returns: comma separated list of addresses to which to send e-mail.
                   12701: 
                   12702: =back
1.618     raeburn  12703: 
                   12704: =cut
                   12705: 
                   12706: ############################################################
                   12707: ############################################################
                   12708: sub build_recipient_list {
1.619     raeburn  12709:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  12710:     my @recipients;
                   12711:     my $otheremails;
                   12712:     my %domconfig =
                   12713:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   12714:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  12715:         if (exists($domconfig{'contacts'}{$mailing})) {
                   12716:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   12717:                 my @contacts = ('adminemail','supportemail');
                   12718:                 foreach my $item (@contacts) {
                   12719:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   12720:                         my $addr = $domconfig{'contacts'}{$item}; 
                   12721:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   12722:                             push(@recipients,$addr);
                   12723:                         }
1.619     raeburn  12724:                     }
1.766     raeburn  12725:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  12726:                 }
                   12727:             }
1.766     raeburn  12728:         } elsif ($origmail ne '') {
                   12729:             push(@recipients,$origmail);
1.618     raeburn  12730:         }
1.619     raeburn  12731:     } elsif ($origmail ne '') {
                   12732:         push(@recipients,$origmail);
1.618     raeburn  12733:     }
1.688     raeburn  12734:     if (defined($defmail)) {
                   12735:         if ($defmail ne '') {
                   12736:             push(@recipients,$defmail);
                   12737:         }
1.618     raeburn  12738:     }
                   12739:     if ($otheremails) {
1.619     raeburn  12740:         my @others;
                   12741:         if ($otheremails =~ /,/) {
                   12742:             @others = split(/,/,$otheremails);
1.618     raeburn  12743:         } else {
1.619     raeburn  12744:             push(@others,$otheremails);
                   12745:         }
                   12746:         foreach my $addr (@others) {
                   12747:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   12748:                 push(@recipients,$addr);
                   12749:             }
1.618     raeburn  12750:         }
                   12751:     }
1.619     raeburn  12752:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  12753:     return $recipientlist;
                   12754: }
                   12755: 
1.127     matthew  12756: ############################################################
                   12757: ############################################################
1.154     albertel 12758: 
1.655     raeburn  12759: =pod
                   12760: 
                   12761: =head1 Course Catalog Routines
                   12762: 
                   12763: =over 4
                   12764: 
                   12765: =item * &gather_categories()
                   12766: 
                   12767: Converts category definitions - keys of categories hash stored in  
                   12768: coursecategories in configuration.db on the primary library server in a 
                   12769: domain - to an array.  Also generates javascript and idx hash used to 
                   12770: generate Domain Coordinator interface for editing Course Categories.
                   12771: 
                   12772: Inputs:
1.663     raeburn  12773: 
1.655     raeburn  12774: categories (reference to hash of category definitions).
1.663     raeburn  12775: 
1.655     raeburn  12776: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12777:       categories and subcategories).
1.663     raeburn  12778: 
1.655     raeburn  12779: idx (reference to hash of counters used in Domain Coordinator interface for 
                   12780:       editing Course Categories).
1.663     raeburn  12781: 
1.655     raeburn  12782: jsarray (reference to array of categories used to create Javascript arrays for
                   12783:          Domain Coordinator interface for editing Course Categories).
                   12784: 
                   12785: Returns: nothing
                   12786: 
                   12787: Side effects: populates cats, idx and jsarray. 
                   12788: 
                   12789: =cut
                   12790: 
                   12791: sub gather_categories {
                   12792:     my ($categories,$cats,$idx,$jsarray) = @_;
                   12793:     my %counters;
                   12794:     my $num = 0;
                   12795:     foreach my $item (keys(%{$categories})) {
                   12796:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   12797:         if ($container eq '' && $depth == 0) {
                   12798:             $cats->[$depth][$categories->{$item}] = $cat;
                   12799:         } else {
                   12800:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   12801:         }
                   12802:         my ($escitem,$tail) = split(/:/,$item,2);
                   12803:         if ($counters{$tail} eq '') {
                   12804:             $counters{$tail} = $num;
                   12805:             $num ++;
                   12806:         }
                   12807:         if (ref($idx) eq 'HASH') {
                   12808:             $idx->{$item} = $counters{$tail};
                   12809:         }
                   12810:         if (ref($jsarray) eq 'ARRAY') {
                   12811:             push(@{$jsarray->[$counters{$tail}]},$item);
                   12812:         }
                   12813:     }
                   12814:     return;
                   12815: }
                   12816: 
                   12817: =pod
                   12818: 
                   12819: =item * &extract_categories()
                   12820: 
                   12821: Used to generate breadcrumb trails for course categories.
                   12822: 
                   12823: Inputs:
1.663     raeburn  12824: 
1.655     raeburn  12825: categories (reference to hash of category definitions).
1.663     raeburn  12826: 
1.655     raeburn  12827: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12828:       categories and subcategories).
1.663     raeburn  12829: 
1.655     raeburn  12830: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  12831: 
1.655     raeburn  12832: allitems (reference to hash - key is category key 
                   12833:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  12834: 
1.655     raeburn  12835: idx (reference to hash of counters used in Domain Coordinator interface for
                   12836:       editing Course Categories).
1.663     raeburn  12837: 
1.655     raeburn  12838: jsarray (reference to array of categories used to create Javascript arrays for
                   12839:          Domain Coordinator interface for editing Course Categories).
                   12840: 
1.665     raeburn  12841: subcats (reference to hash of arrays containing all subcategories within each 
                   12842:          category, -recursive)
                   12843: 
1.655     raeburn  12844: Returns: nothing
                   12845: 
                   12846: Side effects: populates trails and allitems hash references.
                   12847: 
                   12848: =cut
                   12849: 
                   12850: sub extract_categories {
1.665     raeburn  12851:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  12852:     if (ref($categories) eq 'HASH') {
                   12853:         &gather_categories($categories,$cats,$idx,$jsarray);
                   12854:         if (ref($cats->[0]) eq 'ARRAY') {
                   12855:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   12856:                 my $name = $cats->[0][$i];
                   12857:                 my $item = &escape($name).'::0';
                   12858:                 my $trailstr;
                   12859:                 if ($name eq 'instcode') {
                   12860:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  12861:                 } elsif ($name eq 'communities') {
                   12862:                     $trailstr = &mt('Communities');
1.655     raeburn  12863:                 } else {
                   12864:                     $trailstr = $name;
                   12865:                 }
                   12866:                 if ($allitems->{$item} eq '') {
                   12867:                     push(@{$trails},$trailstr);
                   12868:                     $allitems->{$item} = scalar(@{$trails})-1;
                   12869:                 }
                   12870:                 my @parents = ($name);
                   12871:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   12872:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   12873:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  12874:                         if (ref($subcats) eq 'HASH') {
                   12875:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   12876:                         }
                   12877:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   12878:                     }
                   12879:                 } else {
                   12880:                     if (ref($subcats) eq 'HASH') {
                   12881:                         $subcats->{$item} = [];
1.655     raeburn  12882:                     }
                   12883:                 }
                   12884:             }
                   12885:         }
                   12886:     }
                   12887:     return;
                   12888: }
                   12889: 
                   12890: =pod
                   12891: 
                   12892: =item *&recurse_categories()
                   12893: 
                   12894: Recursively used to generate breadcrumb trails for course categories.
                   12895: 
                   12896: Inputs:
1.663     raeburn  12897: 
1.655     raeburn  12898: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12899:       categories and subcategories).
1.663     raeburn  12900: 
1.655     raeburn  12901: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  12902: 
                   12903: category (current course category, for which breadcrumb trail is being generated).
                   12904: 
                   12905: trails (reference to array of breadcrumb trails for each category).
                   12906: 
1.655     raeburn  12907: allitems (reference to hash - key is category key
                   12908:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  12909: 
1.655     raeburn  12910: parents (array containing containers directories for current category, 
                   12911:          back to top level). 
                   12912: 
                   12913: Returns: nothing
                   12914: 
                   12915: Side effects: populates trails and allitems hash references
                   12916: 
                   12917: =cut
                   12918: 
                   12919: sub recurse_categories {
1.665     raeburn  12920:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  12921:     my $shallower = $depth - 1;
                   12922:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   12923:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   12924:             my $name = $cats->[$depth]{$category}[$k];
                   12925:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   12926:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   12927:             if ($allitems->{$item} eq '') {
                   12928:                 push(@{$trails},$trailstr);
                   12929:                 $allitems->{$item} = scalar(@{$trails})-1;
                   12930:             }
                   12931:             my $deeper = $depth+1;
                   12932:             push(@{$parents},$category);
1.665     raeburn  12933:             if (ref($subcats) eq 'HASH') {
                   12934:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   12935:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   12936:                     my $higher;
                   12937:                     if ($j > 0) {
                   12938:                         $higher = &escape($parents->[$j]).':'.
                   12939:                                   &escape($parents->[$j-1]).':'.$j;
                   12940:                     } else {
                   12941:                         $higher = &escape($parents->[$j]).'::'.$j;
                   12942:                     }
                   12943:                     push(@{$subcats->{$higher}},$subcat);
                   12944:                 }
                   12945:             }
                   12946:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   12947:                                 $subcats);
1.655     raeburn  12948:             pop(@{$parents});
                   12949:         }
                   12950:     } else {
                   12951:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   12952:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   12953:         if ($allitems->{$item} eq '') {
                   12954:             push(@{$trails},$trailstr);
                   12955:             $allitems->{$item} = scalar(@{$trails})-1;
                   12956:         }
                   12957:     }
                   12958:     return;
                   12959: }
                   12960: 
1.663     raeburn  12961: =pod
                   12962: 
                   12963: =item *&assign_categories_table()
                   12964: 
                   12965: Create a datatable for display of hierarchical categories in a domain,
                   12966: with checkboxes to allow a course to be categorized. 
                   12967: 
                   12968: Inputs:
                   12969: 
                   12970: cathash - reference to hash of categories defined for the domain (from
                   12971:           configuration.db)
                   12972: 
                   12973: currcat - scalar with an & separated list of categories assigned to a course. 
                   12974: 
1.919     raeburn  12975: type    - scalar contains course type (Course or Community).
                   12976: 
1.663     raeburn  12977: Returns: $output (markup to be displayed) 
                   12978: 
                   12979: =cut
                   12980: 
                   12981: sub assign_categories_table {
1.919     raeburn  12982:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  12983:     my $output;
                   12984:     if (ref($cathash) eq 'HASH') {
                   12985:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   12986:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   12987:         $maxdepth = scalar(@cats);
                   12988:         if (@cats > 0) {
                   12989:             my $itemcount = 0;
                   12990:             if (ref($cats[0]) eq 'ARRAY') {
                   12991:                 my @currcategories;
                   12992:                 if ($currcat ne '') {
                   12993:                     @currcategories = split('&',$currcat);
                   12994:                 }
1.919     raeburn  12995:                 my $table;
1.663     raeburn  12996:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   12997:                     my $parent = $cats[0][$i];
1.919     raeburn  12998:                     next if ($parent eq 'instcode');
                   12999:                     if ($type eq 'Community') {
                   13000:                         next unless ($parent eq 'communities');
                   13001:                     } else {
                   13002:                         next if ($parent eq 'communities');
                   13003:                     }
1.663     raeburn  13004:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13005:                     my $item = &escape($parent).'::0';
                   13006:                     my $checked = '';
                   13007:                     if (@currcategories > 0) {
                   13008:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   13009:                             $checked = ' checked="checked"';
1.663     raeburn  13010:                         }
                   13011:                     }
1.919     raeburn  13012:                     my $parent_title = $parent;
                   13013:                     if ($parent eq 'communities') {
                   13014:                         $parent_title = &mt('Communities');
                   13015:                     }
                   13016:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   13017:                               '<input type="checkbox" name="usecategory" value="'.
                   13018:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   13019:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  13020:                     my $depth = 1;
                   13021:                     push(@path,$parent);
1.919     raeburn  13022:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  13023:                     pop(@path);
1.919     raeburn  13024:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  13025:                     $itemcount ++;
                   13026:                 }
1.919     raeburn  13027:                 if ($itemcount) {
                   13028:                     $output = &Apache::loncommon::start_data_table().
                   13029:                               $table.
                   13030:                               &Apache::loncommon::end_data_table();
                   13031:                 }
1.663     raeburn  13032:             }
                   13033:         }
                   13034:     }
                   13035:     return $output;
                   13036: }
                   13037: 
                   13038: =pod
                   13039: 
                   13040: =item *&assign_category_rows()
                   13041: 
                   13042: Create a datatable row for display of nested categories in a domain,
                   13043: with checkboxes to allow a course to be categorized,called recursively.
                   13044: 
                   13045: Inputs:
                   13046: 
                   13047: itemcount - track row number for alternating colors
                   13048: 
                   13049: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   13050:       categories and subcategories.
                   13051: 
                   13052: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   13053: 
                   13054: parent - parent of current category item
                   13055: 
                   13056: path - Array containing all categories back up through the hierarchy from the
                   13057:        current category to the top level.
                   13058: 
                   13059: currcategories - reference to array of current categories assigned to the course
                   13060: 
                   13061: Returns: $output (markup to be displayed).
                   13062: 
                   13063: =cut
                   13064: 
                   13065: sub assign_category_rows {
                   13066:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   13067:     my ($text,$name,$item,$chgstr);
                   13068:     if (ref($cats) eq 'ARRAY') {
                   13069:         my $maxdepth = scalar(@{$cats});
                   13070:         if (ref($cats->[$depth]) eq 'HASH') {
                   13071:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   13072:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   13073:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13074:                 $text .= '<td><table class="LC_datatable">';
                   13075:                 for (my $j=0; $j<$numchildren; $j++) {
                   13076:                     $name = $cats->[$depth]{$parent}[$j];
                   13077:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   13078:                     my $deeper = $depth+1;
                   13079:                     my $checked = '';
                   13080:                     if (ref($currcategories) eq 'ARRAY') {
                   13081:                         if (@{$currcategories} > 0) {
                   13082:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   13083:                                 $checked = ' checked="checked"';
1.663     raeburn  13084:                             }
                   13085:                         }
                   13086:                     }
1.664     raeburn  13087:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   13088:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  13089:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   13090:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   13091:                              '</td><td>';
1.663     raeburn  13092:                     if (ref($path) eq 'ARRAY') {
                   13093:                         push(@{$path},$name);
                   13094:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   13095:                         pop(@{$path});
                   13096:                     }
                   13097:                     $text .= '</td></tr>';
                   13098:                 }
                   13099:                 $text .= '</table></td>';
                   13100:             }
                   13101:         }
                   13102:     }
                   13103:     return $text;
                   13104: }
                   13105: 
1.655     raeburn  13106: ############################################################
                   13107: ############################################################
                   13108: 
                   13109: 
1.443     albertel 13110: sub commit_customrole {
1.664     raeburn  13111:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  13112:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 13113:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   13114:                          ($end?', ending '.localtime($end):'').': <b>'.
                   13115:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  13116:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 13117:                  '</b><br />';
                   13118:     return $output;
                   13119: }
                   13120: 
                   13121: sub commit_standardrole {
1.541     raeburn  13122:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
                   13123:     my ($output,$logmsg,$linefeed);
                   13124:     if ($context eq 'auto') {
                   13125:         $linefeed = "\n";
                   13126:     } else {
                   13127:         $linefeed = "<br />\n";
                   13128:     }  
1.443     albertel 13129:     if ($three eq 'st') {
1.541     raeburn  13130:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
                   13131:                                          $one,$two,$sec,$context);
                   13132:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  13133:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   13134:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 13135:         } else {
1.541     raeburn  13136:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 13137:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13138:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   13139:             if ($context eq 'auto') {
                   13140:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   13141:             } else {
                   13142:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   13143:                &mt('Add to classlist').': <b>ok</b>';
                   13144:             }
                   13145:             $output .= $linefeed;
1.443     albertel 13146:         }
                   13147:     } else {
                   13148:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   13149:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13150:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  13151:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  13152:         if ($context eq 'auto') {
                   13153:             $output .= $result.$linefeed;
                   13154:         } else {
                   13155:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   13156:         }
1.443     albertel 13157:     }
                   13158:     return $output;
                   13159: }
                   13160: 
                   13161: sub commit_studentrole {
1.541     raeburn  13162:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626     raeburn  13163:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  13164:     if ($context eq 'auto') {
                   13165:         $linefeed = "\n";
                   13166:     } else {
                   13167:         $linefeed = '<br />'."\n";
                   13168:     }
1.443     albertel 13169:     if (defined($one) && defined($two)) {
                   13170:         my $cid=$one.'_'.$two;
                   13171:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   13172:         my $secchange = 0;
                   13173:         my $expire_role_result;
                   13174:         my $modify_section_result;
1.628     raeburn  13175:         if ($oldsec ne '-1') { 
                   13176:             if ($oldsec ne $sec) {
1.443     albertel 13177:                 $secchange = 1;
1.628     raeburn  13178:                 my $now = time;
1.443     albertel 13179:                 my $uurl='/'.$cid;
                   13180:                 $uurl=~s/\_/\//g;
                   13181:                 if ($oldsec) {
                   13182:                     $uurl.='/'.$oldsec;
                   13183:                 }
1.626     raeburn  13184:                 $oldsecurl = $uurl;
1.628     raeburn  13185:                 $expire_role_result = 
1.652     raeburn  13186:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  13187:                 if ($env{'request.course.sec'} ne '') { 
                   13188:                     if ($expire_role_result eq 'refused') {
                   13189:                         my @roles = ('st');
                   13190:                         my @statuses = ('previous');
                   13191:                         my @roledoms = ($one);
                   13192:                         my $withsec = 1;
                   13193:                         my %roleshash = 
                   13194:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   13195:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   13196:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   13197:                             my ($oldstart,$oldend) = 
                   13198:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   13199:                             if ($oldend > 0 && $oldend <= $now) {
                   13200:                                 $expire_role_result = 'ok';
                   13201:                             }
                   13202:                         }
                   13203:                     }
                   13204:                 }
1.443     albertel 13205:                 $result = $expire_role_result;
                   13206:             }
                   13207:         }
                   13208:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652     raeburn  13209:             $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443     albertel 13210:             if ($modify_section_result =~ /^ok/) {
                   13211:                 if ($secchange == 1) {
1.628     raeburn  13212:                     if ($sec eq '') {
                   13213:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   13214:                     } else {
                   13215:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   13216:                     }
1.443     albertel 13217:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  13218:                     if ($sec eq '') {
                   13219:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   13220:                     } else {
                   13221:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13222:                     }
1.443     albertel 13223:                 } else {
1.628     raeburn  13224:                     if ($sec eq '') {
                   13225:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   13226:                     } else {
                   13227:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13228:                     }
1.443     albertel 13229:                 }
                   13230:             } else {
1.628     raeburn  13231:                 if ($secchange) {       
                   13232:                     $$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;
                   13233:                 } else {
                   13234:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   13235:                 }
1.443     albertel 13236:             }
                   13237:             $result = $modify_section_result;
                   13238:         } elsif ($secchange == 1) {
1.628     raeburn  13239:             if ($oldsec eq '') {
                   13240:                 $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
                   13241:             } else {
                   13242:                 $$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;
                   13243:             }
1.626     raeburn  13244:             if ($expire_role_result eq 'refused') {
                   13245:                 my $newsecurl = '/'.$cid;
                   13246:                 $newsecurl =~ s/\_/\//g;
                   13247:                 if ($sec ne '') {
                   13248:                     $newsecurl.='/'.$sec;
                   13249:                 }
                   13250:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   13251:                     if ($sec eq '') {
                   13252:                         $$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;
                   13253:                     } else {
                   13254:                         $$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;
                   13255:                     }
                   13256:                 }
                   13257:             }
1.443     albertel 13258:         }
                   13259:     } else {
1.626     raeburn  13260:         $$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 13261:         $result = "error: incomplete course id\n";
                   13262:     }
                   13263:     return $result;
                   13264: }
                   13265: 
                   13266: ############################################################
                   13267: ############################################################
                   13268: 
1.566     albertel 13269: sub check_clone {
1.578     raeburn  13270:     my ($args,$linefeed) = @_;
1.566     albertel 13271:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   13272:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   13273:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   13274:     my $clonemsg;
                   13275:     my $can_clone = 0;
1.944     raeburn  13276:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  13277:     if ($lctype ne 'community') {
                   13278:         $lctype = 'course';
                   13279:     }
1.566     albertel 13280:     if ($clonehome eq 'no_host') {
1.944     raeburn  13281:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13282:             $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'});
                   13283:         } else {
                   13284:             $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'});
                   13285:         }     
1.566     albertel 13286:     } else {
                   13287: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  13288:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13289:             if ($clonedesc{'type'} ne 'Community') {
                   13290:                  $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'});
                   13291:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13292:             }
                   13293:         }
1.882     raeburn  13294: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   13295:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 13296: 	    $can_clone = 1;
                   13297: 	} else {
                   13298: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   13299: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   13300: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  13301:             if (grep(/^\*$/,@cloners)) {
                   13302:                 $can_clone = 1;
                   13303:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   13304:                 $can_clone = 1;
                   13305:             } else {
1.908     raeburn  13306:                 my $ccrole = 'cc';
1.944     raeburn  13307:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13308:                     $ccrole = 'co';
                   13309:                 }
1.578     raeburn  13310: 	        my %roleshash =
                   13311: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   13312: 					 $args->{'ccdomain'},
1.908     raeburn  13313:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  13314: 					 [$args->{'clonedomain'}]);
1.908     raeburn  13315: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  13316:                     $can_clone = 1;
                   13317:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   13318:                     $can_clone = 1;
                   13319:                 } else {
1.944     raeburn  13320:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13321:                         $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'});
                   13322:                     } else {
                   13323:                         $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'});
                   13324:                     }
1.578     raeburn  13325: 	        }
1.566     albertel 13326: 	    }
1.578     raeburn  13327:         }
1.566     albertel 13328:     }
                   13329:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13330: }
                   13331: 
1.444     albertel 13332: sub construct_course {
1.885     raeburn  13333:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444     albertel 13334:     my $outcome;
1.541     raeburn  13335:     my $linefeed =  '<br />'."\n";
                   13336:     if ($context eq 'auto') {
                   13337:         $linefeed = "\n";
                   13338:     }
1.566     albertel 13339: 
                   13340: #
                   13341: # Are we cloning?
                   13342: #
                   13343:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13344:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  13345: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 13346: 	if ($context ne 'auto') {
1.578     raeburn  13347:             if ($clonemsg ne '') {
                   13348: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   13349:             }
1.566     albertel 13350: 	}
                   13351: 	$outcome .= $clonemsg.$linefeed;
                   13352: 
                   13353:         if (!$can_clone) {
                   13354: 	    return (0,$outcome);
                   13355: 	}
                   13356:     }
                   13357: 
1.444     albertel 13358: #
                   13359: # Open course
                   13360: #
                   13361:     my $crstype = lc($args->{'crstype'});
                   13362:     my %cenv=();
                   13363:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   13364:                                              $args->{'cdescr'},
                   13365:                                              $args->{'curl'},
                   13366:                                              $args->{'course_home'},
                   13367:                                              $args->{'nonstandard'},
                   13368:                                              $args->{'crscode'},
                   13369:                                              $args->{'ccuname'}.':'.
                   13370:                                              $args->{'ccdomain'},
1.882     raeburn  13371:                                              $args->{'crstype'},
1.885     raeburn  13372:                                              $cnum,$context,$category);
1.444     albertel 13373: 
                   13374:     # Note: The testing routines depend on this being output; see 
                   13375:     # Utils::Course. This needs to at least be output as a comment
                   13376:     # if anyone ever decides to not show this, and Utils::Course::new
                   13377:     # will need to be suitably modified.
1.541     raeburn  13378:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  13379:     if ($$courseid =~ /^error:/) {
                   13380:         return (0,$outcome);
                   13381:     }
                   13382: 
1.444     albertel 13383: #
                   13384: # Check if created correctly
                   13385: #
1.479     albertel 13386:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 13387:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  13388:     if ($crsuhome eq 'no_host') {
                   13389:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   13390:         return (0,$outcome);
                   13391:     }
1.541     raeburn  13392:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 13393: 
1.444     albertel 13394: #
1.566     albertel 13395: # Do the cloning
                   13396: #   
                   13397:     if ($can_clone && $cloneid) {
                   13398: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   13399: 	if ($context ne 'auto') {
                   13400: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   13401: 	}
                   13402: 	$outcome .= $clonemsg.$linefeed;
                   13403: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 13404: # Copy all files
1.637     www      13405: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 13406: # Restore URL
1.566     albertel 13407: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 13408: # Restore title
1.566     albertel 13409: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  13410: # Restore creation date, creator and creation context.
                   13411:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   13412:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   13413:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 13414: # Mark as cloned
1.566     albertel 13415: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      13416: # Need to clone grading mode
                   13417:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   13418:         $cenv{'grading'}=$newenv{'grading'};
                   13419: # Do not clone these environment entries
                   13420:         &Apache::lonnet::del('environment',
                   13421:                   ['default_enrollment_start_date',
                   13422:                    'default_enrollment_end_date',
                   13423:                    'question.email',
                   13424:                    'policy.email',
                   13425:                    'comment.email',
                   13426:                    'pch.users.denied',
1.725     raeburn  13427:                    'plc.users.denied',
                   13428:                    'hidefromcat',
                   13429:                    'categories'],
1.638     www      13430:                    $$crsudom,$$crsunum);
1.444     albertel 13431:     }
1.566     albertel 13432: 
1.444     albertel 13433: #
                   13434: # Set environment (will override cloned, if existing)
                   13435: #
                   13436:     my @sections = ();
                   13437:     my @xlists = ();
                   13438:     if ($args->{'crstype'}) {
                   13439:         $cenv{'type'}=$args->{'crstype'};
                   13440:     }
                   13441:     if ($args->{'crsid'}) {
                   13442:         $cenv{'courseid'}=$args->{'crsid'};
                   13443:     }
                   13444:     if ($args->{'crscode'}) {
                   13445:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   13446:     }
                   13447:     if ($args->{'crsquota'} ne '') {
                   13448:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   13449:     } else {
                   13450:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   13451:     }
                   13452:     if ($args->{'ccuname'}) {
                   13453:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   13454:                                         ':'.$args->{'ccdomain'};
                   13455:     } else {
                   13456:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   13457:     }
                   13458:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   13459:     if ($args->{'crssections'}) {
                   13460:         $cenv{'internal.sectionnums'} = '';
                   13461:         if ($args->{'crssections'} =~ m/,/) {
                   13462:             @sections = split/,/,$args->{'crssections'};
                   13463:         } else {
                   13464:             $sections[0] = $args->{'crssections'};
                   13465:         }
                   13466:         if (@sections > 0) {
                   13467:             foreach my $item (@sections) {
                   13468:                 my ($sec,$gp) = split/:/,$item;
                   13469:                 my $class = $args->{'crscode'}.$sec;
                   13470:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   13471:                 $cenv{'internal.sectionnums'} .= $item.',';
                   13472:                 unless ($addcheck eq 'ok') {
                   13473:                     push @badclasses, $class;
                   13474:                 }
                   13475:             }
                   13476:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   13477:         }
                   13478:     }
                   13479: # do not hide course coordinator from staff listing, 
                   13480: # even if privileged
                   13481:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13482: # add crosslistings
                   13483:     if ($args->{'crsxlist'}) {
                   13484:         $cenv{'internal.crosslistings'}='';
                   13485:         if ($args->{'crsxlist'} =~ m/,/) {
                   13486:             @xlists = split/,/,$args->{'crsxlist'};
                   13487:         } else {
                   13488:             $xlists[0] = $args->{'crsxlist'};
                   13489:         }
                   13490:         if (@xlists > 0) {
                   13491:             foreach my $item (@xlists) {
                   13492:                 my ($xl,$gp) = split/:/,$item;
                   13493:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   13494:                 $cenv{'internal.crosslistings'} .= $item.',';
                   13495:                 unless ($addcheck eq 'ok') {
                   13496:                     push @badclasses, $xl;
                   13497:                 }
                   13498:             }
                   13499:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   13500:         }
                   13501:     }
                   13502:     if ($args->{'autoadds'}) {
                   13503:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   13504:     }
                   13505:     if ($args->{'autodrops'}) {
                   13506:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   13507:     }
                   13508: # check for notification of enrollment changes
                   13509:     my @notified = ();
                   13510:     if ($args->{'notify_owner'}) {
                   13511:         if ($args->{'ccuname'} ne '') {
                   13512:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   13513:         }
                   13514:     }
                   13515:     if ($args->{'notify_dc'}) {
                   13516:         if ($uname ne '') { 
1.630     raeburn  13517:             push(@notified,$uname.':'.$udom);
1.444     albertel 13518:         }
                   13519:     }
                   13520:     if (@notified > 0) {
                   13521:         my $notifylist;
                   13522:         if (@notified > 1) {
                   13523:             $notifylist = join(',',@notified);
                   13524:         } else {
                   13525:             $notifylist = $notified[0];
                   13526:         }
                   13527:         $cenv{'internal.notifylist'} = $notifylist;
                   13528:     }
                   13529:     if (@badclasses > 0) {
                   13530:         my %lt=&Apache::lonlocal::texthash(
                   13531:                 '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',
                   13532:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   13533:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   13534:         );
1.541     raeburn  13535:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   13536:                            ' ('.$lt{'adby'}.')';
                   13537:         if ($context eq 'auto') {
                   13538:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 13539:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  13540:             foreach my $item (@badclasses) {
                   13541:                 if ($context eq 'auto') {
                   13542:                     $outcome .= " - $item\n";
                   13543:                 } else {
                   13544:                     $outcome .= "<li>$item</li>\n";
                   13545:                 }
                   13546:             }
                   13547:             if ($context eq 'auto') {
                   13548:                 $outcome .= $linefeed;
                   13549:             } else {
1.566     albertel 13550:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  13551:             }
                   13552:         } 
1.444     albertel 13553:     }
                   13554:     if ($args->{'no_end_date'}) {
                   13555:         $args->{'endaccess'} = 0;
                   13556:     }
                   13557:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   13558:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   13559:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   13560:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   13561:     if ($args->{'showphotos'}) {
                   13562:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   13563:     }
                   13564:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   13565:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   13566:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   13567:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  13568:             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'); 
                   13569:             if ($context eq 'auto') {
                   13570:                 $outcome .= $krb_msg;
                   13571:             } else {
1.566     albertel 13572:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  13573:             }
                   13574:             $outcome .= $linefeed;
1.444     albertel 13575:         }
                   13576:     }
                   13577:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   13578:        if ($args->{'setpolicy'}) {
                   13579:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13580:        }
                   13581:        if ($args->{'setcontent'}) {
                   13582:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13583:        }
                   13584:     }
                   13585:     if ($args->{'reshome'}) {
                   13586: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   13587: 	$cenv{'reshome'}=~s/\/+$/\//;
                   13588:     }
                   13589: #
                   13590: # course has keyed access
                   13591: #
                   13592:     if ($args->{'setkeys'}) {
                   13593:        $cenv{'keyaccess'}='yes';
                   13594:     }
                   13595: # if specified, key authority is not course, but user
                   13596: # only active if keyaccess is yes
                   13597:     if ($args->{'keyauth'}) {
1.487     albertel 13598: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   13599: 	$user = &LONCAPA::clean_username($user);
                   13600: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     13601: 	if ($user ne '' && $domain ne '') {
1.487     albertel 13602: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 13603: 	}
                   13604:     }
                   13605: 
                   13606:     if ($args->{'disresdis'}) {
                   13607:         $cenv{'pch.roles.denied'}='st';
                   13608:     }
                   13609:     if ($args->{'disablechat'}) {
                   13610:         $cenv{'plc.roles.denied'}='st';
                   13611:     }
                   13612: 
                   13613:     # Record we've not yet viewed the Course Initialization Helper for this 
                   13614:     # course
                   13615:     $cenv{'course.helper.not.run'} = 1;
                   13616:     #
                   13617:     # Use new Randomseed
                   13618:     #
                   13619:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   13620:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   13621:     #
                   13622:     # The encryption code and receipt prefix for this course
                   13623:     #
                   13624:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   13625:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   13626:     #
                   13627:     # By default, use standard grading
                   13628:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   13629: 
1.541     raeburn  13630:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   13631:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 13632: #
                   13633: # Open all assignments
                   13634: #
                   13635:     if ($args->{'openall'}) {
                   13636:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   13637:        my %storecontent = ($storeunder         => time,
                   13638:                            $storeunder.'.type' => 'date_start');
                   13639:        
                   13640:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  13641:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 13642:    }
                   13643: #
                   13644: # Set first page
                   13645: #
                   13646:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   13647: 	    || ($cloneid)) {
1.445     albertel 13648: 	use LONCAPA::map;
1.444     albertel 13649: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 13650: 
                   13651: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   13652:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   13653: 
1.444     albertel 13654:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   13655:         my $title; my $url;
                   13656:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   13657: 	    $title=&mt('Syllabus');
1.444     albertel 13658:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   13659:         } else {
1.963     raeburn  13660:             $title=&mt('Table of Contents');
1.444     albertel 13661:             $url='/adm/navmaps';
                   13662:         }
1.445     albertel 13663: 
                   13664:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   13665: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   13666: 
                   13667: 	if ($errtext) { $fatal=2; }
1.541     raeburn  13668:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 13669:     }
1.566     albertel 13670: 
                   13671:     return (1,$outcome);
1.444     albertel 13672: }
                   13673: 
                   13674: ############################################################
                   13675: ############################################################
                   13676: 
1.953     droeschl 13677: #SD
                   13678: # only Community and Course, or anything else?
1.378     raeburn  13679: sub course_type {
                   13680:     my ($cid) = @_;
                   13681:     if (!defined($cid)) {
                   13682:         $cid = $env{'request.course.id'};
                   13683:     }
1.404     albertel 13684:     if (defined($env{'course.'.$cid.'.type'})) {
                   13685:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  13686:     } else {
                   13687:         return 'Course';
1.377     raeburn  13688:     }
                   13689: }
1.156     albertel 13690: 
1.406     raeburn  13691: sub group_term {
                   13692:     my $crstype = &course_type();
                   13693:     my %names = (
                   13694:                   'Course' => 'group',
1.865     raeburn  13695:                   'Community' => 'group',
1.406     raeburn  13696:                 );
                   13697:     return $names{$crstype};
                   13698: }
                   13699: 
1.902     raeburn  13700: sub course_types {
                   13701:     my @types = ('official','unofficial','community');
                   13702:     my %typename = (
                   13703:                          official   => 'Official course',
                   13704:                          unofficial => 'Unofficial course',
                   13705:                          community  => 'Community',
                   13706:                    );
                   13707:     return (\@types,\%typename);
                   13708: }
                   13709: 
1.156     albertel 13710: sub icon {
                   13711:     my ($file)=@_;
1.505     albertel 13712:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 13713:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 13714:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 13715:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   13716: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   13717: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   13718: 	            $curfext.".gif") {
                   13719: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   13720: 		$curfext.".gif";
                   13721: 	}
                   13722:     }
1.249     albertel 13723:     return &lonhttpdurl($iconname);
1.154     albertel 13724: } 
1.84      albertel 13725: 
1.575     albertel 13726: sub lonhttpdurl {
1.692     www      13727: #
                   13728: # Had been used for "small fry" static images on separate port 8080.
                   13729: # Modify here if lightweight http functionality desired again.
                   13730: # Currently eliminated due to increasing firewall issues.
                   13731: #
1.575     albertel 13732:     my ($url)=@_;
1.692     www      13733:     return $url;
1.215     albertel 13734: }
                   13735: 
1.213     albertel 13736: sub connection_aborted {
                   13737:     my ($r)=@_;
                   13738:     $r->print(" ");$r->rflush();
                   13739:     my $c = $r->connection;
                   13740:     return $c->aborted();
                   13741: }
                   13742: 
1.221     foxr     13743: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     13744: #    strings as 'strings'.
                   13745: sub escape_single {
1.221     foxr     13746:     my ($input) = @_;
1.223     albertel 13747:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     13748:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   13749:     return $input;
                   13750: }
1.223     albertel 13751: 
1.222     foxr     13752: #  Same as escape_single, but escape's "'s  This 
                   13753: #  can be used for  "strings"
                   13754: sub escape_double {
                   13755:     my ($input) = @_;
                   13756:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   13757:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   13758:     return $input;
                   13759: }
1.223     albertel 13760:  
1.222     foxr     13761: #   Escapes the last element of a full URL.
                   13762: sub escape_url {
                   13763:     my ($url)   = @_;
1.238     raeburn  13764:     my @urlslices = split(/\//, $url,-1);
1.369     www      13765:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 13766:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     13767: }
1.462     albertel 13768: 
1.820     raeburn  13769: sub compare_arrays {
                   13770:     my ($arrayref1,$arrayref2) = @_;
                   13771:     my (@difference,%count);
                   13772:     @difference = ();
                   13773:     %count = ();
                   13774:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   13775:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   13776:         foreach my $element (keys(%count)) {
                   13777:             if ($count{$element} == 1) {
                   13778:                 push(@difference,$element);
                   13779:             }
                   13780:         }
                   13781:     }
                   13782:     return @difference;
                   13783: }
                   13784: 
1.817     bisitz   13785: # -------------------------------------------------------- Initialize user login
1.462     albertel 13786: sub init_user_environment {
1.463     albertel 13787:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 13788:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   13789: 
                   13790:     my $public=($username eq 'public' && $domain eq 'public');
                   13791: 
                   13792: # See if old ID present, if so, remove
                   13793: 
1.1062    raeburn  13794:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 13795:     my $now=time;
                   13796: 
                   13797:     if ($public) {
                   13798: 	my $max_public=100;
                   13799: 	my $oldest;
                   13800: 	my $oldest_time=0;
                   13801: 	for(my $next=1;$next<=$max_public;$next++) {
                   13802: 	    if (-e $lonids."/publicuser_$next.id") {
                   13803: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   13804: 		if ($mtime<$oldest_time || !$oldest_time) {
                   13805: 		    $oldest_time=$mtime;
                   13806: 		    $oldest=$next;
                   13807: 		}
                   13808: 	    } else {
                   13809: 		$cookie="publicuser_$next";
                   13810: 		last;
                   13811: 	    }
                   13812: 	}
                   13813: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   13814:     } else {
1.463     albertel 13815: 	# if this isn't a robot, kill any existing non-robot sessions
                   13816: 	if (!$args->{'robot'}) {
                   13817: 	    opendir(DIR,$lonids);
                   13818: 	    while ($filename=readdir(DIR)) {
                   13819: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   13820: 		    unlink($lonids.'/'.$filename);
                   13821: 		}
1.462     albertel 13822: 	    }
1.463     albertel 13823: 	    closedir(DIR);
1.462     albertel 13824: 	}
                   13825: # Give them a new cookie
1.463     albertel 13826: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      13827: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 13828: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 13829:     
                   13830: # Initialize roles
                   13831: 
1.1062    raeburn  13832: 	($userroles,$firstaccenv,$timerintenv) = 
                   13833:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 13834:     }
                   13835: # ------------------------------------ Check browser type and MathML capability
                   13836: 
                   13837:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   13838:         $clientunicode,$clientos) = &decode_user_agent($r);
                   13839: 
                   13840: # ------------------------------------------------------------- Get environment
                   13841: 
                   13842:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   13843:     my ($tmp) = keys(%userenv);
                   13844:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   13845:     } else {
                   13846: 	undef(%userenv);
                   13847:     }
                   13848:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   13849: 	$form->{'interface'}=$userenv{'interface'};
                   13850:     }
                   13851:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   13852: 
                   13853: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   13854:     foreach my $option ('interface','localpath','localres') {
                   13855:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 13856:     }
                   13857: # --------------------------------------------------------- Write first profile
                   13858: 
                   13859:     {
                   13860: 	my %initial_env = 
                   13861: 	    ("user.name"          => $username,
                   13862: 	     "user.domain"        => $domain,
                   13863: 	     "user.home"          => $authhost,
                   13864: 	     "browser.type"       => $clientbrowser,
                   13865: 	     "browser.version"    => $clientversion,
                   13866: 	     "browser.mathml"     => $clientmathml,
                   13867: 	     "browser.unicode"    => $clientunicode,
                   13868: 	     "browser.os"         => $clientos,
                   13869: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   13870: 	     "request.course.fn"  => '',
                   13871: 	     "request.course.uri" => '',
                   13872: 	     "request.course.sec" => '',
                   13873: 	     "request.role"       => 'cm',
                   13874: 	     "request.role.adv"   => $env{'user.adv'},
                   13875: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   13876: 
                   13877:         if ($form->{'localpath'}) {
                   13878: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   13879: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   13880:         }
                   13881: 	
                   13882: 	if ($form->{'interface'}) {
                   13883: 	    $form->{'interface'}=~s/\W//gs;
                   13884: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   13885: 	    $env{'browser.interface'}=$form->{'interface'};
                   13886: 	}
                   13887: 
1.981     raeburn  13888:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  13889:         my %domdef;
                   13890:         unless ($domain eq 'public') {
                   13891:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   13892:         }
1.980     raeburn  13893: 
1.1075.2.7  raeburn  13894:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  13895:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  13896:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   13897:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  13898:         }
                   13899: 
1.864     raeburn  13900:         foreach my $crstype ('official','unofficial','community') {
1.765     raeburn  13901:             $userenv{'canrequest.'.$crstype} =
                   13902:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  13903:                                                   'reload','requestcourses',
                   13904:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  13905:         }
                   13906: 
1.1075.2.14  raeburn  13907:         $userenv{'canrequest.author'} =
                   13908:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   13909:                                         'reload','requestauthor',
                   13910:                                         \%userenv,\%domdef,\%is_adv);
                   13911:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   13912:                                              $domain,$username);
                   13913:         my $reqstatus = $reqauthor{'author_status'};
                   13914:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
                   13915:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   13916:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   13917:                                                   $reqauthor{'author'}{'timestamp'};
                   13918:             }
                   13919:         }
                   13920: 
1.462     albertel 13921: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  13922: 
1.462     albertel 13923: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   13924: 		 &GDBM_WRCREAT(),0640)) {
                   13925: 	    &_add_to_env(\%disk_env,\%initial_env);
                   13926: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   13927: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  13928:             if (ref($firstaccenv) eq 'HASH') {
                   13929:                 &_add_to_env(\%disk_env,$firstaccenv);
                   13930:             }
                   13931:             if (ref($timerintenv) eq 'HASH') {
                   13932:                 &_add_to_env(\%disk_env,$timerintenv);
                   13933:             }
1.463     albertel 13934: 	    if (ref($args->{'extra_env'})) {
                   13935: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   13936: 	    }
1.462     albertel 13937: 	    untie(%disk_env);
                   13938: 	} else {
1.705     tempelho 13939: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   13940: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 13941: 	    return 'error: '.$!;
                   13942: 	}
                   13943:     }
                   13944:     $env{'request.role'}='cm';
                   13945:     $env{'request.role.adv'}=$env{'user.adv'};
                   13946:     $env{'browser.type'}=$clientbrowser;
                   13947: 
                   13948:     return $cookie;
                   13949: 
                   13950: }
                   13951: 
                   13952: sub _add_to_env {
                   13953:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  13954:     if (ref($env_data) eq 'HASH') {
                   13955:         while (my ($key,$value) = each(%$env_data)) {
                   13956: 	    $idf->{$prefix.$key} = $value;
                   13957: 	    $env{$prefix.$key}   = $value;
                   13958:         }
1.462     albertel 13959:     }
                   13960: }
                   13961: 
1.685     tempelho 13962: # --- Get the symbolic name of a problem and the url
                   13963: sub get_symb {
                   13964:     my ($request,$silent) = @_;
1.726     raeburn  13965:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 13966:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   13967:     if ($symb eq '') {
                   13968:         if (!$silent) {
1.1071    raeburn  13969:             if (ref($request)) { 
                   13970:                 $request->print("Unable to handle ambiguous references:$url:.");
                   13971:             }
1.685     tempelho 13972:             return ();
                   13973:         }
                   13974:     }
                   13975:     &Apache::lonenc::check_decrypt(\$symb);
                   13976:     return ($symb);
                   13977: }
                   13978: 
                   13979: # --------------------------------------------------------------Get annotation
                   13980: 
                   13981: sub get_annotation {
                   13982:     my ($symb,$enc) = @_;
                   13983: 
                   13984:     my $key = $symb;
                   13985:     if (!$enc) {
                   13986:         $key =
                   13987:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   13988:     }
                   13989:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   13990:     return $annotation{$key};
                   13991: }
                   13992: 
                   13993: sub clean_symb {
1.731     raeburn  13994:     my ($symb,$delete_enc) = @_;
1.685     tempelho 13995: 
                   13996:     &Apache::lonenc::check_decrypt(\$symb);
                   13997:     my $enc = $env{'request.enc'};
1.731     raeburn  13998:     if ($delete_enc) {
1.730     raeburn  13999:         delete($env{'request.enc'});
                   14000:     }
1.685     tempelho 14001: 
                   14002:     return ($symb,$enc);
                   14003: }
1.462     albertel 14004: 
1.990     raeburn  14005: sub build_release_hashes {
                   14006:     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
                   14007:     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
                   14008:                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                   14009:                   (ref($randomizetry) eq 'HASH'));
                   14010:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   14011:         my ($item,$name,$value) = split(/:/,$key);
                   14012:         if ($item eq 'parameter') {
                   14013:             if (ref($checkparms->{$name}) eq 'ARRAY') {
                   14014:                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
                   14015:                     push(@{$checkparms->{$name}},$value);
                   14016:                 }
                   14017:             } else {
                   14018:                 push(@{$checkparms->{$name}},$value);
                   14019:             }
                   14020:         } elsif ($item eq 'resourcetag') {
                   14021:             if ($name eq 'responsetype') {
                   14022:                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
                   14023:             }
                   14024:         } elsif ($item eq 'course') {
                   14025:             if ($name eq 'crstype') {
                   14026:                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
                   14027:             }
                   14028:         }
                   14029:     }
                   14030:     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
                   14031:     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
                   14032:     return;
                   14033: }
                   14034: 
1.1075.2.11  raeburn  14035: sub update_content_constraints {
                   14036:     my ($cdom,$cnum,$chome,$cid) = @_;
                   14037:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   14038:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   14039:     my %checkresponsetypes;
                   14040:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   14041:         my ($item,$name,$value) = split(/:/,$key);
                   14042:         if ($item eq 'resourcetag') {
                   14043:             if ($name eq 'responsetype') {
                   14044:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   14045:             }
                   14046:         }
                   14047:     }
                   14048:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14049:     if (defined($navmap)) {
                   14050:         my %allresponses;
                   14051:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   14052:             my %responses = $res->responseTypes();
                   14053:             foreach my $key (keys(%responses)) {
                   14054:                 next unless(exists($checkresponsetypes{$key}));
                   14055:                 $allresponses{$key} += $responses{$key};
                   14056:             }
                   14057:         }
                   14058:         foreach my $key (keys(%allresponses)) {
                   14059:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   14060:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   14061:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   14062:             }
                   14063:         }
                   14064:         undef($navmap);
                   14065:     }
                   14066:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   14067:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   14068:     }
                   14069:     return;
                   14070: }
                   14071: 
                   14072: sub parse_supplemental_title {
                   14073:     my ($title) = @_;
                   14074: 
                   14075:     my ($foldertitle,$renametitle);
                   14076:     if ($title =~ /&amp;&amp;&amp;/) {
                   14077:         $title = &HTML::Entites::decode($title);
                   14078:     }
                   14079:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   14080:         $renametitle=$4;
                   14081:         my ($time,$uname,$udom) = ($1,$2,$3);
                   14082:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   14083:         my $name =  &plainname($uname,$udom);
                   14084:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   14085:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   14086:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   14087:             $name.': <br />'.$foldertitle;
                   14088:     }
                   14089:     if (wantarray) {
                   14090:         return ($title,$foldertitle,$renametitle);
                   14091:     }
                   14092:     return $title;
                   14093: }
                   14094: 
1.1075.2.14  raeburn  14095: sub captcha_display {
                   14096:     my ($context,$lonhost) = @_;
                   14097:     my ($output,$error);
                   14098:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   14099:     if ($captcha eq 'original') {
                   14100:         $output = &create_captcha();
                   14101:         unless ($output) {
                   14102:             $error = 'captcha';
                   14103:         }
                   14104:     } elsif ($captcha eq 'recaptcha') {
                   14105:         $output = &create_recaptcha($pubkey);
                   14106:         unless ($output) {
                   14107:             $error = 'recaptcha';
                   14108:         }
                   14109:     }
                   14110:     return ($output,$error);
                   14111: }
                   14112: 
                   14113: sub captcha_response {
                   14114:     my ($context,$lonhost) = @_;
                   14115:     my ($captcha_chk,$captcha_error);
                   14116:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   14117:     if ($captcha eq 'original') {
                   14118:         ($captcha_chk,$captcha_error) = &check_captcha();
                   14119:     } elsif ($captcha eq 'recaptcha') {
                   14120:         $captcha_chk = &check_recaptcha($privkey);
                   14121:     } else {
                   14122:         $captcha_chk = 1;
                   14123:     }
                   14124:     return ($captcha_chk,$captcha_error);
                   14125: }
                   14126: 
                   14127: sub get_captcha_config {
                   14128:     my ($context,$lonhost) = @_;
                   14129:     my ($captcha,$pubkey,$privkey,$hashtocheck);
                   14130:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   14131:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   14132:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   14133:     if ($context eq 'usercreation') {
                   14134:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   14135:         if (ref($domconfig{$context}) eq 'HASH') {
                   14136:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   14137:             if (ref($hashtocheck) eq 'HASH') {
                   14138:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   14139:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   14140:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   14141:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   14142:                     }
                   14143:                     if ($privkey && $pubkey) {
                   14144:                         $captcha = 'recaptcha';
                   14145:                     } else {
                   14146:                         $captcha = 'original';
                   14147:                     }
                   14148:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   14149:                     $captcha = 'original';
                   14150:                 }
                   14151:             }
                   14152:         } else {
                   14153:             $captcha = 'captcha';
                   14154:         }
                   14155:     } elsif ($context eq 'login') {
                   14156:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   14157:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   14158:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   14159:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
                   14160:             if ($privkey && $pubkey) {
                   14161:                 $captcha = 'recaptcha';
                   14162:             } else {
                   14163:                 $captcha = 'original';
                   14164:             }
                   14165:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   14166:             $captcha = 'original';
                   14167:         }
                   14168:     }
                   14169:     return ($captcha,$pubkey,$privkey);
                   14170: }
                   14171: 
                   14172: sub create_captcha {
                   14173:     my %captcha_params = &captcha_settings();
                   14174:     my ($output,$maxtries,$tries) = ('',10,0);
                   14175:     while ($tries < $maxtries) {
                   14176:         $tries ++;
                   14177:         my $captcha = Authen::Captcha->new (
                   14178:                                            output_folder => $captcha_params{'output_dir'},
                   14179:                                            data_folder   => $captcha_params{'db_dir'},
                   14180:                                           );
                   14181:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   14182: 
                   14183:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   14184:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   14185:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
                   14186:                      '<input type="text" size="5" name="code" value="" /><br />'.
                   14187:                      '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" />';
                   14188:             last;
                   14189:         }
                   14190:     }
                   14191:     return $output;
                   14192: }
                   14193: 
                   14194: sub captcha_settings {
                   14195:     my %captcha_params = (
                   14196:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   14197:                            www_output_dir => "/captchaspool",
                   14198:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   14199:                            numchars       => '5',
                   14200:                          );
                   14201:     return %captcha_params;
                   14202: }
                   14203: 
                   14204: sub check_captcha {
                   14205:     my ($captcha_chk,$captcha_error);
                   14206:     my $code = $env{'form.code'};
                   14207:     my $md5sum = $env{'form.crypt'};
                   14208:     my %captcha_params = &captcha_settings();
                   14209:     my $captcha = Authen::Captcha->new(
                   14210:                       output_folder => $captcha_params{'output_dir'},
                   14211:                       data_folder   => $captcha_params{'db_dir'},
                   14212:                   );
                   14213:     my $captcha_chk = $captcha->check_code($code,$md5sum);
                   14214:     my %captcha_hash = (
                   14215:                         0       => 'Code not checked (file error)',
                   14216:                        -1      => 'Failed: code expired',
                   14217:                        -2      => 'Failed: invalid code (not in database)',
                   14218:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   14219:     );
                   14220:     if ($captcha_chk != 1) {
                   14221:         $captcha_error = $captcha_hash{$captcha_chk}
                   14222:     }
                   14223:     return ($captcha_chk,$captcha_error);
                   14224: }
                   14225: 
                   14226: sub create_recaptcha {
                   14227:     my ($pubkey) = @_;
                   14228:     my $captcha = Captcha::reCAPTCHA->new;
                   14229:     return $captcha->get_options_setter({theme => 'white'})."\n".
                   14230:            $captcha->get_html($pubkey).
                   14231:            &mt('If either word is hard to read, [_1] will replace them.',
                   14232:                '<image src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
                   14233:            '<br /><br />';
                   14234: }
                   14235: 
                   14236: sub check_recaptcha {
                   14237:     my ($privkey) = @_;
                   14238:     my $captcha_chk;
                   14239:     my $captcha = Captcha::reCAPTCHA->new;
                   14240:     my $captcha_result =
                   14241:         $captcha->check_answer(
                   14242:                                 $privkey,
                   14243:                                 $ENV{'REMOTE_ADDR'},
                   14244:                                 $env{'form.recaptcha_challenge_field'},
                   14245:                                 $env{'form.recaptcha_response_field'},
                   14246:                               );
                   14247:     if ($captcha_result->{is_valid}) {
                   14248:         $captcha_chk = 1;
                   14249:     }
                   14250:     return $captcha_chk;
                   14251: }
                   14252: 
1.41      ng       14253: =pod
                   14254: 
                   14255: =back
                   14256: 
1.112     bowersj2 14257: =cut
1.41      ng       14258: 
1.112     bowersj2 14259: 1;
                   14260: __END__;
1.41      ng       14261: 

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