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

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.22! raeburn     4: # $Id: loncommon.pm,v 1.1075.2.21 2012/12/22 15:53:00 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: 
1.1075.2.20  raeburn  2484: sub authform_authorwarning {
1.32      matthew  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: 
1.1075.2.20  raeburn  2493: sub authform_nochange {
1.32      matthew  2494:     my %in = (
                   2495:               formname => 'document.cu',
                   2496:               kerb_def_dom => 'MSU.EDU',
                   2497:               @_,
                   2498:           );
1.1075.2.20  raeburn  2499:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); 
1.586     raeburn  2500:     my $result;
1.1075.2.20  raeburn  2501:     if (!$authnum) {
                   2502:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  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);
1.1075.2.20  raeburn  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.1075.2.20  raeburn  2572:                     $authtype = '<input type="radio" 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'}) ||
1.1075.2.20  raeburn  2584:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2585:          $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20  raeburn  2586:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  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: 
1.1075.2.20  raeburn  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);
1.1075.2.20  raeburn  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.1075.2.20  raeburn  2658:                     $authtype = '<input type="radio" 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: 
1.1075.2.20  raeburn  2677: sub authform_local {
1.32      matthew  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);
1.1075.2.20  raeburn  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.1075.2.20  raeburn  2713:                     $authtype = '<input type="radio" 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: 
1.1075.2.20  raeburn  2731: sub authform_filesystem {
1.32      matthew  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);
1.1075.2.20  raeburn  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.1075.2.20  raeburn  2764:                     $authtype = '<input type="radio" 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.330     albertel 5029: 
1.438     albertel 5030:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5031: 
1.101     www      5032: # construct main body tag
1.359     albertel 5033:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 5034: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 5035: 
1.530     albertel 5036:     if ($bodyonly) {
1.60      matthew  5037:         return $bodytag;
1.798     tempelho 5038:     } 
1.359     albertel 5039: 
1.410     albertel 5040:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.954     raeburn  5041:     if ($public) {
1.433     albertel 5042: 	undef($role);
1.434     albertel 5043:     } else {
1.1070    raeburn  5044: 	$name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
                   5045:                                 undef,'LC_menubuttons_link');
1.433     albertel 5046:     }
1.359     albertel 5047:     
1.762     bisitz   5048:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5049:     #
                   5050:     # Extra info if you are the DC
                   5051:     my $dc_info = '';
                   5052:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5053:                         $env{'course.'.$env{'request.course.id'}.
                   5054:                                  '.domain'}.'/'})) {
                   5055:         my $cid = $env{'request.course.id'};
1.917     raeburn  5056:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5057:         $dc_info =~ s/\s+$//;
1.359     albertel 5058:     }
                   5059: 
1.898     raeburn  5060:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853     droeschl 5061:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5062: 
1.1075.2.13  raeburn  5063:     if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') { 
                   5064:         return $bodytag; 
                   5065:     }
1.903     droeschl 5066: 
1.1075.2.13  raeburn  5067:     if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5068: 
1.1075.2.21  raeburn  5069:     my $funclist;
                   5070:     if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
                   5071:         $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions(), 'start')."\n".
                   5072:                     Apache::lonmenu::serverform();
                   5073:         my $forbodytag;
                   5074:         &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5075:                                             $forcereg,$args->{'group'},
                   5076:                                             $args->{'bread_crumbs'},
                   5077:                                             $advtoolsref,'',\$forbodytag);
                   5078:         unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5079:             $funclist = $forbodytag;
                   5080:         }
                   5081:     } else {
1.903     droeschl 5082: 
                   5083:         #    if ($env{'request.state'} eq 'construct') {
                   5084:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5085:         #    }
                   5086: 
1.359     albertel 5087: 
1.1075.2.2  raeburn  5088: 
1.916     droeschl 5089:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22! raeburn  5090:             if ($dc_info) {
        !          5091:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1  raeburn  5092:             }
1.1075.2.22! raeburn  5093:             $bodytag .= qq|<div id="LC_nav_bar">$name $role<br />
        !          5094:                            <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5095:             return $bodytag;
                   5096:         }
1.894     droeschl 5097: 
1.927     raeburn  5098:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
                   5099:             $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>|;
                   5100:         }
1.916     droeschl 5101: 
1.903     droeschl 5102:         $bodytag .= Apache::lonhtmlcommon::scripttag(
                   5103:             Apache::lonmenu::utilityfunctions(), 'start');
1.816     bisitz   5104: 
1.903     droeschl 5105:         $bodytag .= Apache::lonmenu::primary_menu();
1.852     droeschl 5106: 
1.917     raeburn  5107:         if ($dc_info) {
                   5108:             $dc_info = &dc_courseid_toggle($dc_info);
                   5109:         }
                   5110:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5111: 
1.903     droeschl 5112:         #don't show menus for public users
1.954     raeburn  5113:         if (!$public){
1.903     droeschl 5114:             $bodytag .= Apache::lonmenu::secondary_menu();
                   5115:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5116:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5117:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5118:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5119:                                 $args->{'bread_crumbs'});
                   5120:             } elsif ($forcereg) { 
1.1075.2.22! raeburn  5121:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
        !          5122:                                                             $args->{'group'});
1.1075.2.15  raeburn  5123:             } else {
1.1075.2.21  raeburn  5124:                 my $forbodytag;
                   5125:                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5126:                                                     $forcereg,$args->{'group'},
                   5127:                                                     $args->{'bread_crumbs'},
                   5128:                                                     $advtoolsref,'',\$forbodytag);
                   5129:                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5130:                     $bodytag .= $forbodytag;
                   5131:                 }
1.920     raeburn  5132:             }
1.903     droeschl 5133:         }else{
                   5134:             # this is to seperate menu from content when there's no secondary
                   5135:             # menu. Especially needed for public accessible ressources.
                   5136:             $bodytag .= '<hr style="clear:both" />';
                   5137:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5138:         }
1.903     droeschl 5139: 
1.235     raeburn  5140:         return $bodytag;
1.1075.2.12  raeburn  5141:     }
                   5142: 
                   5143: #
                   5144: # Top frame rendering, Remote is up
                   5145: #
                   5146: 
                   5147:     my $imgsrc = $img;
                   5148:     if ($img =~ /^\/adm/) {
                   5149:         $imgsrc = &lonhttpdurl($img);
                   5150:     }
                   5151:     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
                   5152: 
                   5153:     # Explicit link to get inline menu
                   5154:     my $menu= ($no_inline_link?''
                   5155:                :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
                   5156: 
                   5157:     if ($dc_info) {
                   5158:         $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
                   5159:     }
                   5160: 
                   5161:     unless ($env{'form.inhibitmenu'}) {
                   5162:         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
                   5163:                        <ol class="LC_primary_menu LC_right">
                   5164:                        <li>$menu</li>
                   5165:                        </ol><div id="LC_realm"> $realm $dc_info</div>|;
                   5166:     }
1.1075.2.13  raeburn  5167:     if ($env{'request.state'} eq 'construct') {
                   5168:         if (!$public){
                   5169:             if ($env{'request.state'} eq 'construct') {
                   5170:                 $funclist = &Apache::lonhtmlcommon::scripttag(
                   5171:                                 &Apache::lonmenu::utilityfunctions(), 'start').
                   5172:                             &Apache::lonhtmlcommon::scripttag('','end').
                   5173:                             &Apache::lonmenu::innerregister($forcereg,
                   5174:                                                             $args->{'bread_crumbs'});
                   5175:             }
                   5176:         }
                   5177:     }
1.1075.2.21  raeburn  5178:     return $bodytag."\n".$funclist;
1.182     matthew  5179: }
                   5180: 
1.917     raeburn  5181: sub dc_courseid_toggle {
                   5182:     my ($dc_info) = @_;
1.980     raeburn  5183:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5184:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5185:            &mt('(More ...)').'</a></span>'.
                   5186:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5187: }
                   5188: 
1.330     albertel 5189: sub make_attr_string {
                   5190:     my ($register,$attr_ref) = @_;
                   5191: 
                   5192:     if ($attr_ref && !ref($attr_ref)) {
                   5193: 	die("addentries Must be a hash ref ".
                   5194: 	    join(':',caller(1))." ".
                   5195: 	    join(':',caller(0))." ");
                   5196:     }
                   5197: 
                   5198:     if ($register) {
1.339     albertel 5199: 	my ($on_load,$on_unload);
                   5200: 	foreach my $key (keys(%{$attr_ref})) {
                   5201: 	    if      (lc($key) eq 'onload') {
                   5202: 		$on_load.=$attr_ref->{$key}.';';
                   5203: 		delete($attr_ref->{$key});
                   5204: 
                   5205: 	    } elsif (lc($key) eq 'onunload') {
                   5206: 		$on_unload.=$attr_ref->{$key}.';';
                   5207: 		delete($attr_ref->{$key});
                   5208: 	    }
                   5209: 	}
1.1075.2.12  raeburn  5210:         if ($env{'environment.remote'} eq 'on') {
                   5211:             $attr_ref->{'onload'}  =
                   5212:                 &Apache::lonmenu::loadevents().  $on_load;
                   5213:             $attr_ref->{'onunload'}=
                   5214:                 &Apache::lonmenu::unloadevents().$on_unload;
                   5215:         } else {  
                   5216: 	    $attr_ref->{'onload'}  = $on_load;
                   5217: 	    $attr_ref->{'onunload'}= $on_unload;
                   5218:         }
1.330     albertel 5219:     }
1.339     albertel 5220: 
1.330     albertel 5221:     my $attr_string;
                   5222:     foreach my $attr (keys(%$attr_ref)) {
                   5223: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5224:     }
                   5225:     return $attr_string;
                   5226: }
                   5227: 
                   5228: 
1.182     matthew  5229: ###############################################
1.251     albertel 5230: ###############################################
                   5231: 
                   5232: =pod
                   5233: 
                   5234: =item * &endbodytag()
                   5235: 
                   5236: Returns a uniform footer for LON-CAPA web pages.
                   5237: 
1.635     raeburn  5238: Inputs: 1 - optional reference to an args hash
                   5239: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5240: a 'Continue' link is not displayed if the page contains an
                   5241: internal redirect in the <head></head> section,
                   5242: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5243: 
                   5244: =cut
                   5245: 
                   5246: sub endbodytag {
1.635     raeburn  5247:     my ($args) = @_;
1.1075.2.6  raeburn  5248:     my $endbodytag;
                   5249:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5250:         $endbodytag='</body>';
                   5251:     }
1.269     albertel 5252:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 5253:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5254:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5255: 	    $endbodytag=
                   5256: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5257: 	        &mt('Continue').'</a>'.
                   5258: 	        $endbodytag;
                   5259:         }
1.315     albertel 5260:     }
1.251     albertel 5261:     return $endbodytag;
                   5262: }
                   5263: 
1.352     albertel 5264: =pod
                   5265: 
                   5266: =item * &standard_css()
                   5267: 
                   5268: Returns a style sheet
                   5269: 
                   5270: Inputs: (all optional)
                   5271:             domain         -> force to color decorate a page for a specific
                   5272:                                domain
                   5273:             function       -> force usage of a specific rolish color scheme
                   5274:             bgcolor        -> override the default page bgcolor
                   5275: 
                   5276: =cut
                   5277: 
1.343     albertel 5278: sub standard_css {
1.345     albertel 5279:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5280:     $function  = &get_users_function() if (!$function);
                   5281:     my $img    = &designparm($function.'.img',   $domain);
                   5282:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5283:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5284:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5285: #second colour for later usage
1.345     albertel 5286:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5287:     my $pgbg_or_bgcolor =
                   5288: 	         $bgcolor ||
1.352     albertel 5289: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5290:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5291:     my $alink  = &designparm($function.'.alink', $domain);
                   5292:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5293:     my $link   = &designparm($function.'.link',  $domain);
                   5294: 
1.602     albertel 5295:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5296:     my $mono                 = 'monospace';
1.850     bisitz   5297:     my $data_table_head      = $sidebg;
                   5298:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5299:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5300:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5301:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5302:     my $mail_new             = '#FFBB77';
                   5303:     my $mail_new_hover       = '#DD9955';
                   5304:     my $mail_read            = '#BBBB77';
                   5305:     my $mail_read_hover      = '#999944';
                   5306:     my $mail_replied         = '#AAAA88';
                   5307:     my $mail_replied_hover   = '#888855';
                   5308:     my $mail_other           = '#99BBBB';
                   5309:     my $mail_other_hover     = '#669999';
1.391     albertel 5310:     my $table_header         = '#DDDDDD';
1.489     raeburn  5311:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5312:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5313:     my $button_hover         = '#BF2317';
1.392     albertel 5314: 
1.608     albertel 5315:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5316:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5317:                                              : '0 3px 0 4px';
1.448     albertel 5318: 
1.523     albertel 5319: 
1.343     albertel 5320:     return <<END;
1.947     droeschl 5321: 
                   5322: /* needed for iframe to allow 100% height in FF */
                   5323: body, html { 
                   5324:     margin: 0;
                   5325:     padding: 0 0.5%;
                   5326:     height: 99%; /* to avoid scrollbars */
                   5327: }
                   5328: 
1.795     www      5329: body {
1.911     bisitz   5330:   font-family: $sans;
                   5331:   line-height:130%;
                   5332:   font-size:0.83em;
                   5333:   color:$font;
1.795     www      5334: }
                   5335: 
1.959     onken    5336: a:focus,
                   5337: a:focus img {
1.795     www      5338:   color: red;
                   5339: }
1.698     harmsja  5340: 
1.911     bisitz   5341: form, .inline {
                   5342:   display: inline;
1.795     www      5343: }
1.721     harmsja  5344: 
1.795     www      5345: .LC_right {
1.911     bisitz   5346:   text-align:right;
1.795     www      5347: }
                   5348: 
                   5349: .LC_middle {
1.911     bisitz   5350:   vertical-align:middle;
1.795     www      5351: }
1.721     harmsja  5352: 
1.911     bisitz   5353: .LC_400Box {
                   5354:   width:400px;
                   5355: }
1.721     harmsja  5356: 
1.947     droeschl 5357: .LC_iframecontainer {
                   5358:     width: 98%;
                   5359:     margin: 0;
                   5360:     position: fixed;
                   5361:     top: 8.5em;
                   5362:     bottom: 0;
                   5363: }
                   5364: 
                   5365: .LC_iframecontainer iframe{
                   5366:     border: none;
                   5367:     width: 100%;
                   5368:     height: 100%;
                   5369: }
                   5370: 
1.778     bisitz   5371: .LC_filename {
                   5372:   font-family: $mono;
                   5373:   white-space:pre;
1.921     bisitz   5374:   font-size: 120%;
1.778     bisitz   5375: }
                   5376: 
                   5377: .LC_fileicon {
                   5378:   border: none;
                   5379:   height: 1.3em;
                   5380:   vertical-align: text-bottom;
                   5381:   margin-right: 0.3em;
                   5382:   text-decoration:none;
                   5383: }
                   5384: 
1.1008    www      5385: .LC_setting {
                   5386:   text-decoration:underline;
                   5387: }
                   5388: 
1.350     albertel 5389: .LC_error {
                   5390:   color: red;
                   5391: }
1.795     www      5392: 
1.1075.2.15  raeburn  5393: .LC_warning {
                   5394:   color: darkorange;
                   5395: }
                   5396: 
1.457     albertel 5397: .LC_diff_removed {
1.733     bisitz   5398:   color: red;
1.394     albertel 5399: }
1.532     albertel 5400: 
                   5401: .LC_info,
1.457     albertel 5402: .LC_success,
                   5403: .LC_diff_added {
1.350     albertel 5404:   color: green;
                   5405: }
1.795     www      5406: 
1.802     bisitz   5407: div.LC_confirm_box {
                   5408:   background-color: #FAFAFA;
                   5409:   border: 1px solid $lg_border_color;
                   5410:   margin-right: 0;
                   5411:   padding: 5px;
                   5412: }
                   5413: 
                   5414: div.LC_confirm_box .LC_error img,
                   5415: div.LC_confirm_box .LC_success img {
                   5416:   vertical-align: middle;
                   5417: }
                   5418: 
1.440     albertel 5419: .LC_icon {
1.771     droeschl 5420:   border: none;
1.790     droeschl 5421:   vertical-align: middle;
1.771     droeschl 5422: }
                   5423: 
1.543     albertel 5424: .LC_docs_spacer {
                   5425:   width: 25px;
                   5426:   height: 1px;
1.771     droeschl 5427:   border: none;
1.543     albertel 5428: }
1.346     albertel 5429: 
1.532     albertel 5430: .LC_internal_info {
1.735     bisitz   5431:   color: #999999;
1.532     albertel 5432: }
                   5433: 
1.794     www      5434: .LC_discussion {
1.1050    www      5435:   background: $data_table_dark;
1.911     bisitz   5436:   border: 1px solid black;
                   5437:   margin: 2px;
1.794     www      5438: }
                   5439: 
                   5440: .LC_disc_action_left {
1.1050    www      5441:   background: $sidebg;
1.911     bisitz   5442:   text-align: left;
1.1050    www      5443:   padding: 4px;
                   5444:   margin: 2px;
1.794     www      5445: }
                   5446: 
                   5447: .LC_disc_action_right {
1.1050    www      5448:   background: $sidebg;
1.911     bisitz   5449:   text-align: right;
1.1050    www      5450:   padding: 4px;
                   5451:   margin: 2px;
1.794     www      5452: }
                   5453: 
                   5454: .LC_disc_new_item {
1.911     bisitz   5455:   background: white;
                   5456:   border: 2px solid red;
1.1050    www      5457:   margin: 4px;
                   5458:   padding: 4px;
1.794     www      5459: }
                   5460: 
                   5461: .LC_disc_old_item {
1.911     bisitz   5462:   background: white;
1.1050    www      5463:   margin: 4px;
                   5464:   padding: 4px;
1.794     www      5465: }
                   5466: 
1.458     albertel 5467: table.LC_pastsubmission {
                   5468:   border: 1px solid black;
                   5469:   margin: 2px;
                   5470: }
                   5471: 
1.924     bisitz   5472: table#LC_menubuttons {
1.345     albertel 5473:   width: 100%;
                   5474:   background: $pgbg;
1.392     albertel 5475:   border: 2px;
1.402     albertel 5476:   border-collapse: separate;
1.803     bisitz   5477:   padding: 0;
1.345     albertel 5478: }
1.392     albertel 5479: 
1.801     tempelho 5480: table#LC_title_bar a {
                   5481:   color: $fontmenu;
                   5482: }
1.836     bisitz   5483: 
1.807     droeschl 5484: table#LC_title_bar {
1.819     tempelho 5485:   clear: both;
1.836     bisitz   5486:   display: none;
1.807     droeschl 5487: }
                   5488: 
1.795     www      5489: table#LC_title_bar,
1.933     droeschl 5490: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5491: table#LC_title_bar.LC_with_remote {
1.359     albertel 5492:   width: 100%;
1.392     albertel 5493:   border-color: $pgbg;
                   5494:   border-style: solid;
                   5495:   border-width: $border;
1.379     albertel 5496:   background: $pgbg;
1.801     tempelho 5497:   color: $fontmenu;
1.392     albertel 5498:   border-collapse: collapse;
1.803     bisitz   5499:   padding: 0;
1.819     tempelho 5500:   margin: 0;
1.359     albertel 5501: }
1.795     www      5502: 
1.933     droeschl 5503: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5504:     margin: 0;
                   5505:     padding: 0;
1.933     droeschl 5506:     position: relative;
                   5507:     list-style: none;
1.913     droeschl 5508: }
1.933     droeschl 5509: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5510:     display: inline;
                   5511: }
1.933     droeschl 5512: 
                   5513: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5514:     padding: 0;
1.933     droeschl 5515:     margin: 0;
                   5516:     float: left;
1.913     droeschl 5517: }
1.933     droeschl 5518: .LC_breadcrumb_tools_tools {
                   5519:     padding: 0;
                   5520:     margin: 0;
1.913     droeschl 5521:     float: right;
                   5522: }
                   5523: 
1.359     albertel 5524: table#LC_title_bar td {
                   5525:   background: $tabbg;
                   5526: }
1.795     www      5527: 
1.911     bisitz   5528: table#LC_menubuttons img {
1.803     bisitz   5529:   border: none;
1.346     albertel 5530: }
1.795     www      5531: 
1.842     droeschl 5532: .LC_breadcrumbs_component {
1.911     bisitz   5533:   float: right;
                   5534:   margin: 0 1em;
1.357     albertel 5535: }
1.842     droeschl 5536: .LC_breadcrumbs_component img {
1.911     bisitz   5537:   vertical-align: middle;
1.777     tempelho 5538: }
1.795     www      5539: 
1.383     albertel 5540: td.LC_table_cell_checkbox {
                   5541:   text-align: center;
                   5542: }
1.795     www      5543: 
                   5544: .LC_fontsize_small {
1.911     bisitz   5545:   font-size: 70%;
1.705     tempelho 5546: }
                   5547: 
1.844     bisitz   5548: #LC_breadcrumbs {
1.911     bisitz   5549:   clear:both;
                   5550:   background: $sidebg;
                   5551:   border-bottom: 1px solid $lg_border_color;
                   5552:   line-height: 2.5em;
1.933     droeschl 5553:   overflow: hidden;
1.911     bisitz   5554:   margin: 0;
                   5555:   padding: 0;
1.995     raeburn  5556:   text-align: left;
1.819     tempelho 5557: }
1.862     bisitz   5558: 
1.1075.2.16  raeburn  5559: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   5560:   clear:both;
                   5561:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5562:   border: 1px solid $sidebg;
1.1075.2.16  raeburn  5563:   margin: 0 0 10px 0;
1.966     bisitz   5564:   padding: 3px;
1.995     raeburn  5565:   text-align: left;
1.822     bisitz   5566: }
                   5567: 
1.795     www      5568: .LC_fontsize_medium {
1.911     bisitz   5569:   font-size: 85%;
1.705     tempelho 5570: }
                   5571: 
1.795     www      5572: .LC_fontsize_large {
1.911     bisitz   5573:   font-size: 120%;
1.705     tempelho 5574: }
                   5575: 
1.346     albertel 5576: .LC_menubuttons_inline_text {
                   5577:   color: $font;
1.698     harmsja  5578:   font-size: 90%;
1.701     harmsja  5579:   padding-left:3px;
1.346     albertel 5580: }
                   5581: 
1.934     droeschl 5582: .LC_menubuttons_inline_text img{
                   5583:   vertical-align: middle;
                   5584: }
                   5585: 
1.1051    www      5586: li.LC_menubuttons_inline_text img {
1.951     onken    5587:   cursor:pointer;
1.1002    droeschl 5588:   text-decoration: none;
1.951     onken    5589: }
                   5590: 
1.526     www      5591: .LC_menubuttons_link {
                   5592:   text-decoration: none;
                   5593: }
1.795     www      5594: 
1.522     albertel 5595: .LC_menubuttons_category {
1.521     www      5596:   color: $font;
1.526     www      5597:   background: $pgbg;
1.521     www      5598:   font-size: larger;
                   5599:   font-weight: bold;
                   5600: }
                   5601: 
1.346     albertel 5602: td.LC_menubuttons_text {
1.911     bisitz   5603:   color: $font;
1.346     albertel 5604: }
1.706     harmsja  5605: 
1.346     albertel 5606: .LC_current_location {
                   5607:   background: $tabbg;
                   5608: }
1.795     www      5609: 
1.938     bisitz   5610: table.LC_data_table {
1.347     albertel 5611:   border: 1px solid #000000;
1.402     albertel 5612:   border-collapse: separate;
1.426     albertel 5613:   border-spacing: 1px;
1.610     albertel 5614:   background: $pgbg;
1.347     albertel 5615: }
1.795     www      5616: 
1.422     albertel 5617: .LC_data_table_dense {
                   5618:   font-size: small;
                   5619: }
1.795     www      5620: 
1.507     raeburn  5621: table.LC_nested_outer {
                   5622:   border: 1px solid #000000;
1.589     raeburn  5623:   border-collapse: collapse;
1.803     bisitz   5624:   border-spacing: 0;
1.507     raeburn  5625:   width: 100%;
                   5626: }
1.795     www      5627: 
1.879     raeburn  5628: table.LC_innerpickbox,
1.507     raeburn  5629: table.LC_nested {
1.803     bisitz   5630:   border: none;
1.589     raeburn  5631:   border-collapse: collapse;
1.803     bisitz   5632:   border-spacing: 0;
1.507     raeburn  5633:   width: 100%;
                   5634: }
1.795     www      5635: 
1.911     bisitz   5636: table.LC_data_table tr th,
                   5637: table.LC_calendar tr th,
1.879     raeburn  5638: table.LC_prior_tries tr th,
                   5639: table.LC_innerpickbox tr th {
1.349     albertel 5640:   font-weight: bold;
                   5641:   background-color: $data_table_head;
1.801     tempelho 5642:   color:$fontmenu;
1.701     harmsja  5643:   font-size:90%;
1.347     albertel 5644: }
1.795     www      5645: 
1.879     raeburn  5646: table.LC_innerpickbox tr th,
                   5647: table.LC_innerpickbox tr td {
                   5648:   vertical-align: top;
                   5649: }
                   5650: 
1.711     raeburn  5651: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5652:   background-color: #CCCCCC;
1.711     raeburn  5653:   font-weight: bold;
                   5654:   text-align: left;
                   5655: }
1.795     www      5656: 
1.912     bisitz   5657: table.LC_data_table tr.LC_odd_row > td {
                   5658:   background-color: $data_table_light;
                   5659:   padding: 2px;
                   5660:   vertical-align: top;
                   5661: }
                   5662: 
1.809     bisitz   5663: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5664:   background-color: $data_table_light;
1.912     bisitz   5665:   vertical-align: top;
                   5666: }
                   5667: 
                   5668: table.LC_data_table tr.LC_even_row > td {
                   5669:   background-color: $data_table_dark;
1.425     albertel 5670:   padding: 2px;
1.900     bisitz   5671:   vertical-align: top;
1.347     albertel 5672: }
1.795     www      5673: 
1.809     bisitz   5674: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5675:   background-color: $data_table_dark;
1.900     bisitz   5676:   vertical-align: top;
1.347     albertel 5677: }
1.795     www      5678: 
1.425     albertel 5679: table.LC_data_table tr.LC_data_table_highlight td {
                   5680:   background-color: $data_table_darker;
                   5681: }
1.795     www      5682: 
1.639     raeburn  5683: table.LC_data_table tr td.LC_leftcol_header {
                   5684:   background-color: $data_table_head;
                   5685:   font-weight: bold;
                   5686: }
1.795     www      5687: 
1.451     albertel 5688: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5689: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5690:   font-weight: bold;
                   5691:   font-style: italic;
                   5692:   text-align: center;
                   5693:   padding: 8px;
1.347     albertel 5694: }
1.795     www      5695: 
1.940     bisitz   5696: table.LC_data_table tr.LC_empty_row td {
                   5697:   background-color: $sidebg;
                   5698: }
                   5699: 
                   5700: table.LC_nested tr.LC_empty_row td {
                   5701:   background-color: #FFFFFF;
                   5702: }
                   5703: 
1.890     droeschl 5704: table.LC_caption {
                   5705: }
                   5706: 
1.507     raeburn  5707: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5708:   padding: 4ex
                   5709: }
1.795     www      5710: 
1.507     raeburn  5711: table.LC_nested_outer tr th {
                   5712:   font-weight: bold;
1.801     tempelho 5713:   color:$fontmenu;
1.507     raeburn  5714:   background-color: $data_table_head;
1.701     harmsja  5715:   font-size: small;
1.507     raeburn  5716:   border-bottom: 1px solid #000000;
                   5717: }
1.795     www      5718: 
1.507     raeburn  5719: table.LC_nested_outer tr td.LC_subheader {
                   5720:   background-color: $data_table_head;
                   5721:   font-weight: bold;
                   5722:   font-size: small;
                   5723:   border-bottom: 1px solid #000000;
                   5724:   text-align: right;
1.451     albertel 5725: }
1.795     www      5726: 
1.507     raeburn  5727: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5728:   background-color: #CCCCCC;
1.451     albertel 5729:   font-weight: bold;
                   5730:   font-size: small;
1.507     raeburn  5731:   text-align: center;
                   5732: }
1.795     www      5733: 
1.589     raeburn  5734: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5735: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5736:   text-align: left;
1.451     albertel 5737: }
1.795     www      5738: 
1.507     raeburn  5739: table.LC_nested td {
1.735     bisitz   5740:   background-color: #FFFFFF;
1.451     albertel 5741:   font-size: small;
1.507     raeburn  5742: }
1.795     www      5743: 
1.507     raeburn  5744: table.LC_nested_outer tr th.LC_right_item,
                   5745: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5746: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5747: table.LC_nested tr td.LC_right_item {
1.451     albertel 5748:   text-align: right;
                   5749: }
                   5750: 
1.507     raeburn  5751: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5752:   background-color: #EEEEEE;
1.451     albertel 5753: }
                   5754: 
1.473     raeburn  5755: table.LC_createuser {
                   5756: }
                   5757: 
                   5758: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5759:   font-size: small;
1.473     raeburn  5760: }
                   5761: 
                   5762: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5763:   background-color: #CCCCCC;
1.473     raeburn  5764:   font-weight: bold;
                   5765:   text-align: center;
                   5766: }
                   5767: 
1.349     albertel 5768: table.LC_calendar {
                   5769:   border: 1px solid #000000;
                   5770:   border-collapse: collapse;
1.917     raeburn  5771:   width: 98%;
1.349     albertel 5772: }
1.795     www      5773: 
1.349     albertel 5774: table.LC_calendar_pickdate {
                   5775:   font-size: xx-small;
                   5776: }
1.795     www      5777: 
1.349     albertel 5778: table.LC_calendar tr td {
                   5779:   border: 1px solid #000000;
                   5780:   vertical-align: top;
1.917     raeburn  5781:   width: 14%;
1.349     albertel 5782: }
1.795     www      5783: 
1.349     albertel 5784: table.LC_calendar tr td.LC_calendar_day_empty {
                   5785:   background-color: $data_table_dark;
                   5786: }
1.795     www      5787: 
1.779     bisitz   5788: table.LC_calendar tr td.LC_calendar_day_current {
                   5789:   background-color: $data_table_highlight;
1.777     tempelho 5790: }
1.795     www      5791: 
1.938     bisitz   5792: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5793:   background-color: $mail_new;
                   5794: }
1.795     www      5795: 
1.938     bisitz   5796: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5797:   background-color: $mail_new_hover;
                   5798: }
1.795     www      5799: 
1.938     bisitz   5800: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5801:   background-color: $mail_read;
                   5802: }
1.795     www      5803: 
1.938     bisitz   5804: /*
                   5805: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5806:   background-color: $mail_read_hover;
                   5807: }
1.938     bisitz   5808: */
1.795     www      5809: 
1.938     bisitz   5810: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5811:   background-color: $mail_replied;
                   5812: }
1.795     www      5813: 
1.938     bisitz   5814: /*
                   5815: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5816:   background-color: $mail_replied_hover;
                   5817: }
1.938     bisitz   5818: */
1.795     www      5819: 
1.938     bisitz   5820: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5821:   background-color: $mail_other;
                   5822: }
1.795     www      5823: 
1.938     bisitz   5824: /*
                   5825: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5826:   background-color: $mail_other_hover;
                   5827: }
1.938     bisitz   5828: */
1.494     raeburn  5829: 
1.777     tempelho 5830: table.LC_data_table tr > td.LC_browser_file,
                   5831: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5832:   background: #AAEE77;
1.389     albertel 5833: }
1.795     www      5834: 
1.777     tempelho 5835: table.LC_data_table tr > td.LC_browser_file_locked,
                   5836: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5837:   background: #FFAA99;
1.387     albertel 5838: }
1.795     www      5839: 
1.777     tempelho 5840: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5841:   background: #888888;
1.779     bisitz   5842: }
1.795     www      5843: 
1.777     tempelho 5844: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5845: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5846:   background: #F8F866;
1.777     tempelho 5847: }
1.795     www      5848: 
1.696     bisitz   5849: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5850:   background: #E0E8FF;
1.387     albertel 5851: }
1.696     bisitz   5852: 
1.707     bisitz   5853: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5854:   /* background: #77FF77; */
1.707     bisitz   5855: }
1.795     www      5856: 
1.707     bisitz   5857: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5858:   border-right: 8px solid #FFFF77;
1.707     bisitz   5859: }
1.795     www      5860: 
1.707     bisitz   5861: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5862:   border-right: 8px solid #FFAA77;
1.707     bisitz   5863: }
1.795     www      5864: 
1.707     bisitz   5865: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5866:   border-right: 8px solid #FF7777;
1.707     bisitz   5867: }
1.795     www      5868: 
1.707     bisitz   5869: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5870:   border-right: 8px solid #AAFF77;
1.707     bisitz   5871: }
1.795     www      5872: 
1.707     bisitz   5873: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5874:   border-right: 8px solid #11CC55;
1.707     bisitz   5875: }
                   5876: 
1.388     albertel 5877: span.LC_current_location {
1.701     harmsja  5878:   font-size:larger;
1.388     albertel 5879:   background: $pgbg;
                   5880: }
1.387     albertel 5881: 
1.1029    www      5882: span.LC_current_nav_location {
                   5883:   font-weight:bold;
                   5884:   background: $sidebg;
                   5885: }
                   5886: 
1.395     albertel 5887: span.LC_parm_menu_item {
                   5888:   font-size: larger;
                   5889: }
1.795     www      5890: 
1.395     albertel 5891: span.LC_parm_scope_all {
                   5892:   color: red;
                   5893: }
1.795     www      5894: 
1.395     albertel 5895: span.LC_parm_scope_folder {
                   5896:   color: green;
                   5897: }
1.795     www      5898: 
1.395     albertel 5899: span.LC_parm_scope_resource {
                   5900:   color: orange;
                   5901: }
1.795     www      5902: 
1.395     albertel 5903: span.LC_parm_part {
                   5904:   color: blue;
                   5905: }
1.795     www      5906: 
1.911     bisitz   5907: span.LC_parm_folder,
                   5908: span.LC_parm_symb {
1.395     albertel 5909:   font-size: x-small;
                   5910:   font-family: $mono;
                   5911:   color: #AAAAAA;
                   5912: }
                   5913: 
1.977     bisitz   5914: ul.LC_parm_parmlist li {
                   5915:   display: inline-block;
                   5916:   padding: 0.3em 0.8em;
                   5917:   vertical-align: top;
                   5918:   width: 150px;
                   5919:   border-top:1px solid $lg_border_color;
                   5920: }
                   5921: 
1.795     www      5922: td.LC_parm_overview_level_menu,
                   5923: td.LC_parm_overview_map_menu,
                   5924: td.LC_parm_overview_parm_selectors,
                   5925: td.LC_parm_overview_restrictions  {
1.396     albertel 5926:   border: 1px solid black;
                   5927:   border-collapse: collapse;
                   5928: }
1.795     www      5929: 
1.396     albertel 5930: table.LC_parm_overview_restrictions td {
                   5931:   border-width: 1px 4px 1px 4px;
                   5932:   border-style: solid;
                   5933:   border-color: $pgbg;
                   5934:   text-align: center;
                   5935: }
1.795     www      5936: 
1.396     albertel 5937: table.LC_parm_overview_restrictions th {
                   5938:   background: $tabbg;
                   5939:   border-width: 1px 4px 1px 4px;
                   5940:   border-style: solid;
                   5941:   border-color: $pgbg;
                   5942: }
1.795     www      5943: 
1.398     albertel 5944: table#LC_helpmenu {
1.803     bisitz   5945:   border: none;
1.398     albertel 5946:   height: 55px;
1.803     bisitz   5947:   border-spacing: 0;
1.398     albertel 5948: }
                   5949: 
                   5950: table#LC_helpmenu fieldset legend {
                   5951:   font-size: larger;
                   5952: }
1.795     www      5953: 
1.397     albertel 5954: table#LC_helpmenu_links {
                   5955:   width: 100%;
                   5956:   border: 1px solid black;
                   5957:   background: $pgbg;
1.803     bisitz   5958:   padding: 0;
1.397     albertel 5959:   border-spacing: 1px;
                   5960: }
1.795     www      5961: 
1.397     albertel 5962: table#LC_helpmenu_links tr td {
                   5963:   padding: 1px;
                   5964:   background: $tabbg;
1.399     albertel 5965:   text-align: center;
                   5966:   font-weight: bold;
1.397     albertel 5967: }
1.396     albertel 5968: 
1.795     www      5969: table#LC_helpmenu_links a:link,
                   5970: table#LC_helpmenu_links a:visited,
1.397     albertel 5971: table#LC_helpmenu_links a:active {
                   5972:   text-decoration: none;
                   5973:   color: $font;
                   5974: }
1.795     www      5975: 
1.397     albertel 5976: table#LC_helpmenu_links a:hover {
                   5977:   text-decoration: underline;
                   5978:   color: $vlink;
                   5979: }
1.396     albertel 5980: 
1.417     albertel 5981: .LC_chrt_popup_exists {
                   5982:   border: 1px solid #339933;
                   5983:   margin: -1px;
                   5984: }
1.795     www      5985: 
1.417     albertel 5986: .LC_chrt_popup_up {
                   5987:   border: 1px solid yellow;
                   5988:   margin: -1px;
                   5989: }
1.795     www      5990: 
1.417     albertel 5991: .LC_chrt_popup {
                   5992:   border: 1px solid #8888FF;
                   5993:   background: #CCCCFF;
                   5994: }
1.795     www      5995: 
1.421     albertel 5996: table.LC_pick_box {
                   5997:   border-collapse: separate;
                   5998:   background: white;
                   5999:   border: 1px solid black;
                   6000:   border-spacing: 1px;
                   6001: }
1.795     www      6002: 
1.421     albertel 6003: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6004:   background: $sidebg;
1.421     albertel 6005:   font-weight: bold;
1.900     bisitz   6006:   text-align: left;
1.740     bisitz   6007:   vertical-align: top;
1.421     albertel 6008:   width: 184px;
                   6009:   padding: 8px;
                   6010: }
1.795     www      6011: 
1.579     raeburn  6012: table.LC_pick_box td.LC_pick_box_value {
                   6013:   text-align: left;
                   6014:   padding: 8px;
                   6015: }
1.795     www      6016: 
1.579     raeburn  6017: table.LC_pick_box td.LC_pick_box_select {
                   6018:   text-align: left;
                   6019:   padding: 8px;
                   6020: }
1.795     www      6021: 
1.424     albertel 6022: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6023:   padding: 0;
1.421     albertel 6024:   height: 1px;
                   6025:   background: black;
                   6026: }
1.795     www      6027: 
1.421     albertel 6028: table.LC_pick_box td.LC_pick_box_submit {
                   6029:   text-align: right;
                   6030: }
1.795     www      6031: 
1.579     raeburn  6032: table.LC_pick_box td.LC_evenrow_value {
                   6033:   text-align: left;
                   6034:   padding: 8px;
                   6035:   background-color: $data_table_light;
                   6036: }
1.795     www      6037: 
1.579     raeburn  6038: table.LC_pick_box td.LC_oddrow_value {
                   6039:   text-align: left;
                   6040:   padding: 8px;
                   6041:   background-color: $data_table_light;
                   6042: }
1.795     www      6043: 
1.579     raeburn  6044: span.LC_helpform_receipt_cat {
                   6045:   font-weight: bold;
                   6046: }
1.795     www      6047: 
1.424     albertel 6048: table.LC_group_priv_box {
                   6049:   background: white;
                   6050:   border: 1px solid black;
                   6051:   border-spacing: 1px;
                   6052: }
1.795     www      6053: 
1.424     albertel 6054: table.LC_group_priv_box td.LC_pick_box_title {
                   6055:   background: $tabbg;
                   6056:   font-weight: bold;
                   6057:   text-align: right;
                   6058:   width: 184px;
                   6059: }
1.795     www      6060: 
1.424     albertel 6061: table.LC_group_priv_box td.LC_groups_fixed {
                   6062:   background: $data_table_light;
                   6063:   text-align: center;
                   6064: }
1.795     www      6065: 
1.424     albertel 6066: table.LC_group_priv_box td.LC_groups_optional {
                   6067:   background: $data_table_dark;
                   6068:   text-align: center;
                   6069: }
1.795     www      6070: 
1.424     albertel 6071: table.LC_group_priv_box td.LC_groups_functionality {
                   6072:   background: $data_table_darker;
                   6073:   text-align: center;
                   6074:   font-weight: bold;
                   6075: }
1.795     www      6076: 
1.424     albertel 6077: table.LC_group_priv td {
                   6078:   text-align: left;
1.803     bisitz   6079:   padding: 0;
1.424     albertel 6080: }
                   6081: 
                   6082: .LC_navbuttons {
                   6083:   margin: 2ex 0ex 2ex 0ex;
                   6084: }
1.795     www      6085: 
1.423     albertel 6086: .LC_topic_bar {
                   6087:   font-weight: bold;
                   6088:   background: $tabbg;
1.918     wenzelju 6089:   margin: 1em 0em 1em 2em;
1.805     bisitz   6090:   padding: 3px;
1.918     wenzelju 6091:   font-size: 1.2em;
1.423     albertel 6092: }
1.795     www      6093: 
1.423     albertel 6094: .LC_topic_bar span {
1.918     wenzelju 6095:   left: 0.5em;
                   6096:   position: absolute;
1.423     albertel 6097:   vertical-align: middle;
1.918     wenzelju 6098:   font-size: 1.2em;
1.423     albertel 6099: }
1.795     www      6100: 
1.423     albertel 6101: table.LC_course_group_status {
                   6102:   margin: 20px;
                   6103: }
1.795     www      6104: 
1.423     albertel 6105: table.LC_status_selector td {
                   6106:   vertical-align: top;
                   6107:   text-align: center;
1.424     albertel 6108:   padding: 4px;
                   6109: }
1.795     www      6110: 
1.599     albertel 6111: div.LC_feedback_link {
1.616     albertel 6112:   clear: both;
1.829     kalberla 6113:   background: $sidebg;
1.779     bisitz   6114:   width: 100%;
1.829     kalberla 6115:   padding-bottom: 10px;
                   6116:   border: 1px $tabbg solid;
1.833     kalberla 6117:   height: 22px;
                   6118:   line-height: 22px;
                   6119:   padding-top: 5px;
                   6120: }
                   6121: 
                   6122: div.LC_feedback_link img {
                   6123:   height: 22px;
1.867     kalberla 6124:   vertical-align:middle;
1.829     kalberla 6125: }
                   6126: 
1.911     bisitz   6127: div.LC_feedback_link a {
1.829     kalberla 6128:   text-decoration: none;
1.489     raeburn  6129: }
1.795     www      6130: 
1.867     kalberla 6131: div.LC_comblock {
1.911     bisitz   6132:   display:inline;
1.867     kalberla 6133:   color:$font;
                   6134:   font-size:90%;
                   6135: }
                   6136: 
                   6137: div.LC_feedback_link div.LC_comblock {
                   6138:   padding-left:5px;
                   6139: }
                   6140: 
                   6141: div.LC_feedback_link div.LC_comblock a {
                   6142:   color:$font;
                   6143: }
                   6144: 
1.489     raeburn  6145: span.LC_feedback_link {
1.858     bisitz   6146:   /* background: $feedback_link_bg; */
1.599     albertel 6147:   font-size: larger;
                   6148: }
1.795     www      6149: 
1.599     albertel 6150: span.LC_message_link {
1.858     bisitz   6151:   /* background: $feedback_link_bg; */
1.599     albertel 6152:   font-size: larger;
                   6153:   position: absolute;
                   6154:   right: 1em;
1.489     raeburn  6155: }
1.421     albertel 6156: 
1.515     albertel 6157: table.LC_prior_tries {
1.524     albertel 6158:   border: 1px solid #000000;
                   6159:   border-collapse: separate;
                   6160:   border-spacing: 1px;
1.515     albertel 6161: }
1.523     albertel 6162: 
1.515     albertel 6163: table.LC_prior_tries td {
1.524     albertel 6164:   padding: 2px;
1.515     albertel 6165: }
1.523     albertel 6166: 
                   6167: .LC_answer_correct {
1.795     www      6168:   background: lightgreen;
                   6169:   color: darkgreen;
                   6170:   padding: 6px;
1.523     albertel 6171: }
1.795     www      6172: 
1.523     albertel 6173: .LC_answer_charged_try {
1.797     www      6174:   background: #FFAAAA;
1.795     www      6175:   color: darkred;
                   6176:   padding: 6px;
1.523     albertel 6177: }
1.795     www      6178: 
1.779     bisitz   6179: .LC_answer_not_charged_try,
1.523     albertel 6180: .LC_answer_no_grade,
                   6181: .LC_answer_late {
1.795     www      6182:   background: lightyellow;
1.523     albertel 6183:   color: black;
1.795     www      6184:   padding: 6px;
1.523     albertel 6185: }
1.795     www      6186: 
1.523     albertel 6187: .LC_answer_previous {
1.795     www      6188:   background: lightblue;
                   6189:   color: darkblue;
                   6190:   padding: 6px;
1.523     albertel 6191: }
1.795     www      6192: 
1.779     bisitz   6193: .LC_answer_no_message {
1.777     tempelho 6194:   background: #FFFFFF;
                   6195:   color: black;
1.795     www      6196:   padding: 6px;
1.779     bisitz   6197: }
1.795     www      6198: 
1.779     bisitz   6199: .LC_answer_unknown {
                   6200:   background: orange;
                   6201:   color: black;
1.795     www      6202:   padding: 6px;
1.777     tempelho 6203: }
1.795     www      6204: 
1.529     albertel 6205: span.LC_prior_numerical,
                   6206: span.LC_prior_string,
                   6207: span.LC_prior_custom,
                   6208: span.LC_prior_reaction,
                   6209: span.LC_prior_math {
1.925     bisitz   6210:   font-family: $mono;
1.523     albertel 6211:   white-space: pre;
                   6212: }
                   6213: 
1.525     albertel 6214: span.LC_prior_string {
1.925     bisitz   6215:   font-family: $mono;
1.525     albertel 6216:   white-space: pre;
                   6217: }
                   6218: 
1.523     albertel 6219: table.LC_prior_option {
                   6220:   width: 100%;
                   6221:   border-collapse: collapse;
                   6222: }
1.795     www      6223: 
1.911     bisitz   6224: table.LC_prior_rank,
1.795     www      6225: table.LC_prior_match {
1.528     albertel 6226:   border-collapse: collapse;
                   6227: }
1.795     www      6228: 
1.528     albertel 6229: table.LC_prior_option tr td,
                   6230: table.LC_prior_rank tr td,
                   6231: table.LC_prior_match tr td {
1.524     albertel 6232:   border: 1px solid #000000;
1.515     albertel 6233: }
                   6234: 
1.855     bisitz   6235: .LC_nobreak {
1.544     albertel 6236:   white-space: nowrap;
1.519     raeburn  6237: }
                   6238: 
1.576     raeburn  6239: span.LC_cusr_emph {
                   6240:   font-style: italic;
                   6241: }
                   6242: 
1.633     raeburn  6243: span.LC_cusr_subheading {
                   6244:   font-weight: normal;
                   6245:   font-size: 85%;
                   6246: }
                   6247: 
1.861     bisitz   6248: div.LC_docs_entry_move {
1.859     bisitz   6249:   border: 1px solid #BBBBBB;
1.545     albertel 6250:   background: #DDDDDD;
1.861     bisitz   6251:   width: 22px;
1.859     bisitz   6252:   padding: 1px;
                   6253:   margin: 0;
1.545     albertel 6254: }
                   6255: 
1.861     bisitz   6256: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6257: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 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.1075.2.17  raeburn  7131: /*
                   7132:   styles used by TTH when "Default set of options to pass to tth/m
                   7133:   when converting TeX" in course settings has been set
                   7134: 
                   7135:   option passed: -t
                   7136: 
                   7137: */
                   7138: 
                   7139: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7140: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7141: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7142: td div.norm {line-height:normal;}
                   7143: 
                   7144: /*
                   7145:   option passed -y3
                   7146: */
                   7147: 
                   7148: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7149: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7150: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7151: 
1.343     albertel 7152: END
                   7153: }
                   7154: 
1.306     albertel 7155: =pod
                   7156: 
                   7157: =item * &headtag()
                   7158: 
                   7159: Returns a uniform footer for LON-CAPA web pages.
                   7160: 
1.307     albertel 7161: Inputs: $title - optional title for the head
                   7162:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7163:         $args - optional arguments
1.319     albertel 7164:             force_register - if is true call registerurl so the remote is 
                   7165:                              informed
1.415     albertel 7166:             redirect       -> array ref of
                   7167:                                    1- seconds before redirect occurs
                   7168:                                    2- url to redirect to
                   7169:                                    3- whether the side effect should occur
1.315     albertel 7170:                            (side effect of setting 
                   7171:                                $env{'internal.head.redirect'} to the url 
                   7172:                                redirected too)
1.352     albertel 7173:             domain         -> force to color decorate a page for a specific
                   7174:                                domain
                   7175:             function       -> force usage of a specific rolish color scheme
                   7176:             bgcolor        -> override the default page bgcolor
1.460     albertel 7177:             no_auto_mt_title
                   7178:                            -> prevent &mt()ing the title arg
1.464     albertel 7179: 
1.306     albertel 7180: =cut
                   7181: 
                   7182: sub headtag {
1.313     albertel 7183:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7184:     
1.363     albertel 7185:     my $function = $args->{'function'} || &get_users_function();
                   7186:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7187:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.418     albertel 7188:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7189: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7190: 		   #time(),
1.418     albertel 7191: 		   $env{'environment.color.timestamp'},
1.363     albertel 7192: 		   $function,$domain,$bgcolor);
                   7193: 
1.369     www      7194:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7195: 
1.308     albertel 7196:     my $result =
                   7197: 	'<head>'.
1.461     albertel 7198: 	&font_settings();
1.319     albertel 7199: 
1.1064    raeburn  7200:     my $inhibitprint = &print_suppression();
                   7201: 
1.461     albertel 7202:     if (!$args->{'frameset'}) {
                   7203: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7204:     }
1.1075.2.12  raeburn  7205:     if ($args->{'force_register'}) {
                   7206:         $result .= &Apache::lonmenu::registerurl(1);
1.319     albertel 7207:     }
1.436     albertel 7208:     if (!$args->{'no_nav_bar'} 
                   7209: 	&& !$args->{'only_body'}
                   7210: 	&& !$args->{'frameset'}) {
                   7211: 	$result .= &help_menu_js();
1.1032    www      7212:         $result.=&modal_window();
1.1038    www      7213:         $result.=&togglebox_script();
1.1034    www      7214:         $result.=&wishlist_window();
1.1041    www      7215:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7216:     } else {
                   7217:         if ($args->{'add_modal'}) {
                   7218:            $result.=&modal_window();
                   7219:         }
                   7220:         if ($args->{'add_wishlist'}) {
                   7221:            $result.=&wishlist_window();
                   7222:         }
1.1038    www      7223:         if ($args->{'add_togglebox'}) {
                   7224:            $result.=&togglebox_script();
                   7225:         }
1.1041    www      7226:         if ($args->{'add_progressbar'}) {
                   7227:            $result.=&LCprogressbarUpdate_script();
                   7228:         }
1.436     albertel 7229:     }
1.314     albertel 7230:     if (ref($args->{'redirect'})) {
1.414     albertel 7231: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7232: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7233: 	if (!$inhibit_continue) {
                   7234: 	    $env{'internal.head.redirect'} = $url;
                   7235: 	}
1.313     albertel 7236: 	$result.=<<ADDMETA
                   7237: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7238: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7239: ADDMETA
                   7240:     }
1.306     albertel 7241:     if (!defined($title)) {
                   7242: 	$title = 'The LearningOnline Network with CAPA';
                   7243:     }
1.460     albertel 7244:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7245:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 7246: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
1.1064    raeburn  7247:         .$inhibitprint
1.414     albertel 7248: 	.$head_extra;
1.962     droeschl 7249:     return $result.'</head>';
1.306     albertel 7250: }
                   7251: 
                   7252: =pod
                   7253: 
1.340     albertel 7254: =item * &font_settings()
                   7255: 
                   7256: Returns neccessary <meta> to set the proper encoding
                   7257: 
                   7258: Inputs: none
                   7259: 
                   7260: =cut
                   7261: 
                   7262: sub font_settings {
                   7263:     my $headerstring='';
1.647     www      7264:     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340     albertel 7265: 	$headerstring.=
                   7266: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   7267:     }
                   7268:     return $headerstring;
                   7269: }
                   7270: 
1.341     albertel 7271: =pod
                   7272: 
1.1064    raeburn  7273: =item * &print_suppression()
                   7274: 
                   7275: In course context returns css which causes the body to be blank when media="print",
                   7276: if printout generation is unavailable for the current resource.
                   7277: 
                   7278: This could be because:
                   7279: 
                   7280: (a) printstartdate is in the future
                   7281: 
                   7282: (b) printenddate is in the past
                   7283: 
                   7284: (c) there is an active exam block with "printout"
                   7285: functionality blocked
                   7286: 
                   7287: Users with pav, pfo or evb privileges are exempt.
                   7288: 
                   7289: Inputs: none
                   7290: 
                   7291: =cut
                   7292: 
                   7293: 
                   7294: sub print_suppression {
                   7295:     my $noprint;
                   7296:     if ($env{'request.course.id'}) {
                   7297:         my $scope = $env{'request.course.id'};
                   7298:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7299:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7300:             return;
                   7301:         }
                   7302:         if ($env{'request.course.sec'} ne '') {
                   7303:             $scope .= "/$env{'request.course.sec'}";
                   7304:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7305:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7306:                 return;
1.1064    raeburn  7307:             }
                   7308:         }
                   7309:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7310:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1065    raeburn  7311:         my $blocked = &blocking_status('printout',$cnum,$cdom);
1.1064    raeburn  7312:         if ($blocked) {
                   7313:             my $checkrole = "cm./$cdom/$cnum";
                   7314:             if ($env{'request.course.sec'} ne '') {
                   7315:                 $checkrole .= "/$env{'request.course.sec'}";
                   7316:             }
                   7317:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7318:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7319:                 $noprint = 1;
                   7320:             }
                   7321:         }
                   7322:         unless ($noprint) {
                   7323:             my $symb = &Apache::lonnet::symbread();
                   7324:             if ($symb ne '') {
                   7325:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7326:                 if (ref($navmap)) {
                   7327:                     my $res = $navmap->getBySymb($symb);
                   7328:                     if (ref($res)) {
                   7329:                         if (!$res->resprintable()) {
                   7330:                             $noprint = 1;
                   7331:                         }
                   7332:                     }
                   7333:                 }
                   7334:             }
                   7335:         }
                   7336:         if ($noprint) {
                   7337:             return <<"ENDSTYLE";
                   7338: <style type="text/css" media="print">
                   7339:     body { display:none }
                   7340: </style>
                   7341: ENDSTYLE
                   7342:         }
                   7343:     }
                   7344:     return;
                   7345: }
                   7346: 
                   7347: =pod
                   7348: 
1.341     albertel 7349: =item * &xml_begin()
                   7350: 
                   7351: Returns the needed doctype and <html>
                   7352: 
                   7353: Inputs: none
                   7354: 
                   7355: =cut
                   7356: 
                   7357: sub xml_begin {
                   7358:     my $output='';
                   7359: 
                   7360:     if ($env{'browser.mathml'}) {
                   7361: 	$output='<?xml version="1.0"?>'
                   7362:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7363: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7364:             
                   7365: #	    .'<!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">] >'
                   7366: 	    .'<!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">'
                   7367:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7368: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   7369:     } else {
1.849     bisitz   7370: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
                   7371:            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341     albertel 7372:     }
                   7373:     return $output;
                   7374: }
1.340     albertel 7375: 
                   7376: =pod
                   7377: 
1.306     albertel 7378: =item * &start_page()
                   7379: 
                   7380: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7381: 
1.648     raeburn  7382: Inputs:
                   7383: 
                   7384: =over 4
                   7385: 
                   7386: $title - optional title for the page
                   7387: 
                   7388: $head_extra - optional extra HTML to incude inside the <head>
                   7389: 
                   7390: $args - additional optional args supported are:
                   7391: 
                   7392: =over 8
                   7393: 
                   7394:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 7395:                                     arg on
1.814     bisitz   7396:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  7397:              add_entries    -> additional attributes to add to the  <body>
                   7398:              domain         -> force to color decorate a page for a 
1.317     albertel 7399:                                     specific domain
1.648     raeburn  7400:              function       -> force usage of a specific rolish color
1.317     albertel 7401:                                     scheme
1.648     raeburn  7402:              redirect       -> see &headtag()
                   7403:              bgcolor        -> override the default page bg color
                   7404:              js_ready       -> return a string ready for being used in 
1.317     albertel 7405:                                     a javascript writeln
1.648     raeburn  7406:              html_encode    -> return a string ready for being used in 
1.320     albertel 7407:                                     a html attribute
1.648     raeburn  7408:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 7409:                                     $forcereg arg
1.648     raeburn  7410:              frameset       -> if true will start with a <frameset>
1.330     albertel 7411:                                     rather than <body>
1.648     raeburn  7412:              skip_phases    -> hash ref of 
1.338     albertel 7413:                                     head -> skip the <html><head> generation
                   7414:                                     body -> skip all <body> generation
1.1075.2.12  raeburn  7415:              no_inline_link -> if true and in remote mode, don't show the
                   7416:                                     'Switch To Inline Menu' link
1.648     raeburn  7417:              no_auto_mt_title -> prevent &mt()ing the title arg
                   7418:              inherit_jsmath -> when creating popup window in a page,
                   7419:                                     should it have jsmath forced on by the
                   7420:                                     current page
1.867     kalberla 7421:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  7422:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1075.2.15  raeburn  7423:              group          -> includes the current group, if page is for a
                   7424:                                specific group
1.361     albertel 7425: 
1.648     raeburn  7426: =back
1.460     albertel 7427: 
1.648     raeburn  7428: =back
1.562     albertel 7429: 
1.306     albertel 7430: =cut
                   7431: 
                   7432: sub start_page {
1.309     albertel 7433:     my ($title,$head_extra,$args) = @_;
1.318     albertel 7434:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 7435: 
1.315     albertel 7436:     $env{'internal.start_page'}++;
1.1075.2.15  raeburn  7437:     my ($result,@advtools);
1.964     droeschl 7438: 
1.338     albertel 7439:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1030    www      7440:         $result .= &xml_begin() . &headtag($title, $head_extra, $args);
1.338     albertel 7441:     }
                   7442:     
                   7443:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   7444: 	if ($args->{'frameset'}) {
                   7445: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   7446: 						$args->{'add_entries'});
                   7447: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   7448:         } else {
                   7449:             $result .=
                   7450:                 &bodytag($title, 
                   7451:                          $args->{'function'},       $args->{'add_entries'},
                   7452:                          $args->{'only_body'},      $args->{'domain'},
                   7453:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12  raeburn  7454:                          $args->{'bgcolor'},        $args->{'no_inline_link'},
1.1075.2.15  raeburn  7455:                          $args,                     \@advtools);
1.831     bisitz   7456:         }
1.330     albertel 7457:     }
1.338     albertel 7458: 
1.315     albertel 7459:     if ($args->{'js_ready'}) {
1.713     kaisler  7460: 		$result = &js_ready($result);
1.315     albertel 7461:     }
1.320     albertel 7462:     if ($args->{'html_encode'}) {
1.713     kaisler  7463: 		$result = &html_encode($result);
                   7464:     }
                   7465: 
1.813     bisitz   7466:     # Preparation for new and consistent functionlist at top of screen
                   7467:     # if ($args->{'functionlist'}) {
                   7468:     #            $result .= &build_functionlist();
                   7469:     #}
                   7470: 
1.964     droeschl 7471:     # Don't add anything more if only_body wanted or in const space
                   7472:     return $result if    $args->{'only_body'} 
                   7473:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   7474: 
                   7475:     #Breadcrumbs
1.758     kaisler  7476:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   7477: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   7478: 		#if any br links exists, add them to the breadcrumbs
                   7479: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   7480: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   7481: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   7482: 			}
                   7483: 		}
1.1075.2.19  raeburn  7484:                 # if @advtools array contains items add then to the breadcrumbs
                   7485:                 if (@advtools > 0) {
                   7486:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   7487:                 }
1.758     kaisler  7488: 
                   7489: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   7490: 		if(exists($args->{'bread_crumbs_component'})){
                   7491: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   7492: 		}else{
                   7493: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   7494: 		}
1.1075.2.21  raeburn  7495:     } elsif ($env{'request.noversionuri'} =~ m{^/res/}) {
                   7496:         $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320     albertel 7497:     }
1.315     albertel 7498:     return $result;
1.306     albertel 7499: }
                   7500: 
                   7501: sub end_page {
1.315     albertel 7502:     my ($args) = @_;
                   7503:     $env{'internal.end_page'}++;
1.330     albertel 7504:     my $result;
1.335     albertel 7505:     if ($args->{'discussion'}) {
                   7506: 	my ($target,$parser);
                   7507: 	if (ref($args->{'discussion'})) {
                   7508: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   7509: 				$args->{'discussion'}{'parser'});
                   7510: 	}
                   7511: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   7512:     }
1.330     albertel 7513:     if ($args->{'frameset'}) {
                   7514: 	$result .= '</frameset>';
                   7515:     } else {
1.635     raeburn  7516: 	$result .= &endbodytag($args);
1.330     albertel 7517:     }
1.1075.2.6  raeburn  7518:     unless ($args->{'notbody'}) {
                   7519:         $result .= "\n</html>";
                   7520:     }
1.330     albertel 7521: 
1.315     albertel 7522:     if ($args->{'js_ready'}) {
1.317     albertel 7523: 	$result = &js_ready($result);
1.315     albertel 7524:     }
1.335     albertel 7525: 
1.320     albertel 7526:     if ($args->{'html_encode'}) {
                   7527: 	$result = &html_encode($result);
                   7528:     }
1.335     albertel 7529: 
1.315     albertel 7530:     return $result;
                   7531: }
                   7532: 
1.1034    www      7533: sub wishlist_window {
                   7534:     return(<<'ENDWISHLIST');
1.1046    raeburn  7535: <script type="text/javascript">
1.1034    www      7536: // <![CDATA[
                   7537: // <!-- BEGIN LON-CAPA Internal
                   7538: function set_wishlistlink(title, path) {
                   7539:     if (!title) {
                   7540:         title = document.title;
                   7541:         title = title.replace(/^LON-CAPA /,'');
                   7542:     }
                   7543:     if (!path) {
                   7544:         path = location.pathname;
                   7545:     }
                   7546:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   7547:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   7548: }
                   7549: // END LON-CAPA Internal -->
                   7550: // ]]>
                   7551: </script>
                   7552: ENDWISHLIST
                   7553: }
                   7554: 
1.1030    www      7555: sub modal_window {
                   7556:     return(<<'ENDMODAL');
1.1046    raeburn  7557: <script type="text/javascript">
1.1030    www      7558: // <![CDATA[
                   7559: // <!-- BEGIN LON-CAPA Internal
                   7560: var modalWindow = {
                   7561: 	parent:"body",
                   7562: 	windowId:null,
                   7563: 	content:null,
                   7564: 	width:null,
                   7565: 	height:null,
                   7566: 	close:function()
                   7567: 	{
                   7568: 	        $(".LCmodal-window").remove();
                   7569: 	        $(".LCmodal-overlay").remove();
                   7570: 	},
                   7571: 	open:function()
                   7572: 	{
                   7573: 		var modal = "";
                   7574: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7575: 		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;\">";
                   7576: 		modal += this.content;
                   7577: 		modal += "</div>";	
                   7578: 
                   7579: 		$(this.parent).append(modal);
                   7580: 
                   7581: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7582: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7583: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7584: 	}
                   7585: };
1.1031    www      7586: 	var openMyModal = function(source,width,height,scrolling)
1.1030    www      7587: 	{
                   7588: 		modalWindow.windowId = "myModal";
                   7589: 		modalWindow.width = width;
                   7590: 		modalWindow.height = height;
1.1031    www      7591: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='true' src='" + source + "'>&lt/iframe>";
1.1030    www      7592: 		modalWindow.open();
                   7593: 	};	
                   7594: // END LON-CAPA Internal -->
                   7595: // ]]>
                   7596: </script>
                   7597: ENDMODAL
                   7598: }
                   7599: 
                   7600: sub modal_link {
1.1052    www      7601:     my ($link,$linktext,$width,$height,$target,$scrolling,$title)=@_;
1.1030    www      7602:     unless ($width) { $width=480; }
                   7603:     unless ($height) { $height=400; }
1.1031    www      7604:     unless ($scrolling) { $scrolling='yes'; }
1.1074    raeburn  7605:     my $target_attr;
                   7606:     if (defined($target)) {
                   7607:         $target_attr = 'target="'.$target.'"';
                   7608:     }
                   7609:     return <<"ENDLINK";
                   7610: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling'); return false;">
                   7611:            $linktext</a>
                   7612: ENDLINK
1.1030    www      7613: }
                   7614: 
1.1032    www      7615: sub modal_adhoc_script {
                   7616:     my ($funcname,$width,$height,$content)=@_;
                   7617:     return (<<ENDADHOC);
1.1046    raeburn  7618: <script type="text/javascript">
1.1032    www      7619: // <![CDATA[
                   7620:         var $funcname = function()
                   7621:         {
                   7622:                 modalWindow.windowId = "myModal";
                   7623:                 modalWindow.width = $width;
                   7624:                 modalWindow.height = $height;
                   7625:                 modalWindow.content = '$content';
                   7626:                 modalWindow.open();
                   7627:         };  
                   7628: // ]]>
                   7629: </script>
                   7630: ENDADHOC
                   7631: }
                   7632: 
1.1041    www      7633: sub modal_adhoc_inner {
                   7634:     my ($funcname,$width,$height,$content)=@_;
                   7635:     my $innerwidth=$width-20;
                   7636:     $content=&js_ready(
1.1042    www      7637:                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1041    www      7638:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px').
                   7639:                     $content.
                   7640:                  &end_scrollbox().
                   7641:                &end_page()
                   7642:              );
                   7643:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   7644: }
                   7645: 
                   7646: sub modal_adhoc_window {
                   7647:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7648:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   7649:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7650: }
                   7651: 
                   7652: sub modal_adhoc_launch {
                   7653:     my ($funcname,$width,$height,$content)=@_;
                   7654:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   7655: <script type="text/javascript">
                   7656: // <![CDATA[
                   7657: $funcname();
                   7658: // ]]>
                   7659: </script>
                   7660: ENDLAUNCH
                   7661: }
                   7662: 
                   7663: sub modal_adhoc_close {
                   7664:     return (<<ENDCLOSE);
                   7665: <script type="text/javascript">
                   7666: // <![CDATA[
                   7667: modalWindow.close();
                   7668: // ]]>
                   7669: </script>
                   7670: ENDCLOSE
                   7671: }
                   7672: 
1.1038    www      7673: sub togglebox_script {
                   7674:    return(<<ENDTOGGLE);
                   7675: <script type="text/javascript"> 
                   7676: // <![CDATA[
                   7677: function LCtoggleDisplay(id,hidetext,showtext) {
                   7678:    link = document.getElementById(id + "link").childNodes[0];
                   7679:    with (document.getElementById(id).style) {
                   7680:       if (display == "none" ) {
                   7681:           display = "inline";
                   7682:           link.nodeValue = hidetext;
                   7683:         } else {
                   7684:           display = "none";
                   7685:           link.nodeValue = showtext;
                   7686:        }
                   7687:    }
                   7688: }
                   7689: // ]]>
                   7690: </script>
                   7691: ENDTOGGLE
                   7692: }
                   7693: 
1.1039    www      7694: sub start_togglebox {
                   7695:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7696:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7697:     unless ($showtext) { $showtext=&mt('show'); }
                   7698:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7699:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7700:     return &start_data_table().
                   7701:            &start_data_table_header_row().
                   7702:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7703:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7704:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7705:            &end_data_table_header_row().
                   7706:            '<tr id="'.$id.'" style="display:none""><td>';
                   7707: }
                   7708: 
                   7709: sub end_togglebox {
                   7710:     return '</td></tr>'.&end_data_table();
                   7711: }
                   7712: 
1.1041    www      7713: sub LCprogressbar_script {
1.1045    www      7714:    my ($id)=@_;
1.1041    www      7715:    return(<<ENDPROGRESS);
                   7716: <script type="text/javascript">
                   7717: // <![CDATA[
1.1045    www      7718: \$('#progressbar$id').progressbar({
1.1041    www      7719:   value: 0,
                   7720:   change: function(event, ui) {
                   7721:     var newVal = \$(this).progressbar('option', 'value');
                   7722:     \$('.pblabel', this).text(LCprogressTxt);
                   7723:   }
                   7724: });
                   7725: // ]]>
                   7726: </script>
                   7727: ENDPROGRESS
                   7728: }
                   7729: 
                   7730: sub LCprogressbarUpdate_script {
                   7731:    return(<<ENDPROGRESSUPDATE);
                   7732: <style type="text/css">
                   7733: .ui-progressbar { position:relative; }
                   7734: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   7735: </style>
                   7736: <script type="text/javascript">
                   7737: // <![CDATA[
1.1045    www      7738: var LCprogressTxt='---';
                   7739: 
                   7740: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      7741:    LCprogressTxt=progresstext;
1.1045    www      7742:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      7743: }
                   7744: // ]]>
                   7745: </script>
                   7746: ENDPROGRESSUPDATE
                   7747: }
                   7748: 
1.1042    www      7749: my $LClastpercent;
1.1045    www      7750: my $LCidcnt;
                   7751: my $LCcurrentid;
1.1042    www      7752: 
1.1041    www      7753: sub LCprogressbar {
1.1042    www      7754:     my ($r)=(@_);
                   7755:     $LClastpercent=0;
1.1045    www      7756:     $LCidcnt++;
                   7757:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      7758:     my $starting=&mt('Starting');
                   7759:     my $content=(<<ENDPROGBAR);
                   7760: <p>
1.1045    www      7761:   <div id="progressbar$LCcurrentid">
1.1041    www      7762:     <span class="pblabel">$starting</span>
                   7763:   </div>
                   7764: </p>
                   7765: ENDPROGBAR
1.1045    www      7766:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      7767: }
                   7768: 
                   7769: sub LCprogressbarUpdate {
1.1042    www      7770:     my ($r,$val,$text)=@_;
                   7771:     unless ($val) { 
                   7772:        if ($LClastpercent) {
                   7773:            $val=$LClastpercent;
                   7774:        } else {
                   7775:            $val=0;
                   7776:        }
                   7777:     }
1.1041    www      7778:     if ($val<0) { $val=0; }
                   7779:     if ($val>100) { $val=0; }
1.1042    www      7780:     $LClastpercent=$val;
1.1041    www      7781:     unless ($text) { $text=$val.'%'; }
                   7782:     $text=&js_ready($text);
1.1044    www      7783:     &r_print($r,<<ENDUPDATE);
1.1041    www      7784: <script type="text/javascript">
                   7785: // <![CDATA[
1.1045    www      7786: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      7787: // ]]>
                   7788: </script>
                   7789: ENDUPDATE
1.1035    www      7790: }
                   7791: 
1.1042    www      7792: sub LCprogressbarClose {
                   7793:     my ($r)=@_;
                   7794:     $LClastpercent=0;
1.1044    www      7795:     &r_print($r,<<ENDCLOSE);
1.1042    www      7796: <script type="text/javascript">
                   7797: // <![CDATA[
1.1045    www      7798: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      7799: // ]]>
                   7800: </script>
                   7801: ENDCLOSE
1.1044    www      7802: }
                   7803: 
                   7804: sub r_print {
                   7805:     my ($r,$to_print)=@_;
                   7806:     if ($r) {
                   7807:       $r->print($to_print);
                   7808:       $r->rflush();
                   7809:     } else {
                   7810:       print($to_print);
                   7811:     }
1.1042    www      7812: }
                   7813: 
1.320     albertel 7814: sub html_encode {
                   7815:     my ($result) = @_;
                   7816: 
1.322     albertel 7817:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7818:     
                   7819:     return $result;
                   7820: }
1.1044    www      7821: 
1.317     albertel 7822: sub js_ready {
                   7823:     my ($result) = @_;
                   7824: 
1.323     albertel 7825:     $result =~ s/[\n\r]/ /xmsg;
                   7826:     $result =~ s/\\/\\\\/xmsg;
                   7827:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7828:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7829:     
                   7830:     return $result;
                   7831: }
                   7832: 
1.315     albertel 7833: sub validate_page {
                   7834:     if (  exists($env{'internal.start_page'})
1.316     albertel 7835: 	  &&     $env{'internal.start_page'} > 1) {
                   7836: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7837: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7838: 				 $ENV{'request.filename'});
1.315     albertel 7839:     }
                   7840:     if (  exists($env{'internal.end_page'})
1.316     albertel 7841: 	  &&     $env{'internal.end_page'} > 1) {
                   7842: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7843: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7844: 				 $env{'request.filename'});
1.315     albertel 7845:     }
                   7846:     if (     exists($env{'internal.start_page'})
                   7847: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7848: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7849: 				 $env{'request.filename'});
1.315     albertel 7850:     }
                   7851:     if (   ! exists($env{'internal.start_page'})
                   7852: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7853: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7854: 				 $env{'request.filename'});
1.315     albertel 7855:     }
1.306     albertel 7856: }
1.315     albertel 7857: 
1.996     www      7858: 
                   7859: sub start_scrollbox {
1.1075    raeburn  7860:     my ($outerwidth,$width,$height,$id,$bgcolor)=@_;
1.998     raeburn  7861:     unless ($outerwidth) { $outerwidth='520px'; }
                   7862:     unless ($width) { $width='500px'; }
                   7863:     unless ($height) { $height='200px'; }
1.1075    raeburn  7864:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  7865:     if ($id ne '') {
1.1020    raeburn  7866:         $table_id = " id='table_$id'";
                   7867:         $div_id = " id='div_$id'";
1.1018    raeburn  7868:     }
1.1075    raeburn  7869:     if ($bgcolor ne '') {
                   7870:         $tdcol = "background-color: $bgcolor;";
                   7871:     }
                   7872:     return <<"END";
                   7873: <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>
                   7874: END
1.996     www      7875: }
                   7876: 
                   7877: sub end_scrollbox {
1.1036    www      7878:     return '</div></td></tr></table>';
1.996     www      7879: }
                   7880: 
1.318     albertel 7881: sub simple_error_page {
                   7882:     my ($r,$title,$msg) = @_;
                   7883:     my $page =
                   7884: 	&Apache::loncommon::start_page($title).
1.1075.2.15  raeburn  7885: 	'<p class="LC_error">'.&mt($msg).'</p>'.
1.318     albertel 7886: 	&Apache::loncommon::end_page();
                   7887:     if (ref($r)) {
                   7888: 	$r->print($page);
1.327     albertel 7889: 	return;
1.318     albertel 7890:     }
                   7891:     return $page;
                   7892: }
1.347     albertel 7893: 
                   7894: {
1.610     albertel 7895:     my @row_count;
1.961     onken    7896: 
                   7897:     sub start_data_table_count {
                   7898:         unshift(@row_count, 0);
                   7899:         return;
                   7900:     }
                   7901: 
                   7902:     sub end_data_table_count {
                   7903:         shift(@row_count);
                   7904:         return;
                   7905:     }
                   7906: 
1.347     albertel 7907:     sub start_data_table {
1.1018    raeburn  7908: 	my ($add_class,$id) = @_;
1.422     albertel 7909: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  7910:         my $table_id;
                   7911:         if (defined($id)) {
                   7912:             $table_id = ' id="'.$id.'"';
                   7913:         }
1.961     onken    7914: 	&start_data_table_count();
1.1018    raeburn  7915: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 7916:     }
                   7917: 
                   7918:     sub end_data_table {
1.961     onken    7919: 	&end_data_table_count();
1.389     albertel 7920: 	return '</table>'."\n";;
1.347     albertel 7921:     }
                   7922: 
                   7923:     sub start_data_table_row {
1.974     wenzelju 7924: 	my ($add_class, $id) = @_;
1.610     albertel 7925: 	$row_count[0]++;
                   7926: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   7927: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 7928:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7929:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 7930:     }
1.471     banghart 7931:     
                   7932:     sub continue_data_table_row {
1.974     wenzelju 7933: 	my ($add_class, $id) = @_;
1.610     albertel 7934: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 7935: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   7936:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7937:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 7938:     }
1.347     albertel 7939: 
                   7940:     sub end_data_table_row {
1.389     albertel 7941: 	return '</tr>'."\n";;
1.347     albertel 7942:     }
1.367     www      7943: 
1.421     albertel 7944:     sub start_data_table_empty_row {
1.707     bisitz   7945: #	$row_count[0]++;
1.421     albertel 7946: 	return  '<tr class="LC_empty_row" >'."\n";;
                   7947:     }
                   7948: 
                   7949:     sub end_data_table_empty_row {
                   7950: 	return '</tr>'."\n";;
                   7951:     }
                   7952: 
1.367     www      7953:     sub start_data_table_header_row {
1.389     albertel 7954: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      7955:     }
                   7956: 
                   7957:     sub end_data_table_header_row {
1.389     albertel 7958: 	return '</tr>'."\n";;
1.367     www      7959:     }
1.890     droeschl 7960: 
                   7961:     sub data_table_caption {
                   7962:         my $caption = shift;
                   7963:         return "<caption class=\"LC_caption\">$caption</caption>";
                   7964:     }
1.347     albertel 7965: }
                   7966: 
1.548     albertel 7967: =pod
                   7968: 
                   7969: =item * &inhibit_menu_check($arg)
                   7970: 
                   7971: Checks for a inhibitmenu state and generates output to preserve it
                   7972: 
                   7973: Inputs:         $arg - can be any of
                   7974:                      - undef - in which case the return value is a string 
                   7975:                                to add  into arguments list of a uri
                   7976:                      - 'input' - in which case the return value is a HTML
                   7977:                                  <form> <input> field of type hidden to
                   7978:                                  preserve the value
                   7979:                      - a url - in which case the return value is the url with
                   7980:                                the neccesary cgi args added to preserve the
                   7981:                                inhibitmenu state
                   7982:                      - a ref to a url - no return value, but the string is
                   7983:                                         updated to include the neccessary cgi
                   7984:                                         args to preserve the inhibitmenu state
                   7985: 
                   7986: =cut
                   7987: 
                   7988: sub inhibit_menu_check {
                   7989:     my ($arg) = @_;
                   7990:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   7991:     if ($arg eq 'input') {
                   7992: 	if ($env{'form.inhibitmenu'}) {
                   7993: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   7994: 	} else {
                   7995: 	    return
                   7996: 	}
                   7997:     }
                   7998:     if ($env{'form.inhibitmenu'}) {
                   7999: 	if (ref($arg)) {
                   8000: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8001: 	} elsif ($arg eq '') {
                   8002: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8003: 	} else {
                   8004: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8005: 	}
                   8006:     }
                   8007:     if (!ref($arg)) {
                   8008: 	return $arg;
                   8009:     }
                   8010: }
                   8011: 
1.251     albertel 8012: ###############################################
1.182     matthew  8013: 
                   8014: =pod
                   8015: 
1.549     albertel 8016: =back
                   8017: 
                   8018: =head1 User Information Routines
                   8019: 
                   8020: =over 4
                   8021: 
1.405     albertel 8022: =item * &get_users_function()
1.182     matthew  8023: 
                   8024: Used by &bodytag to determine the current users primary role.
                   8025: Returns either 'student','coordinator','admin', or 'author'.
                   8026: 
                   8027: =cut
                   8028: 
                   8029: ###############################################
                   8030: sub get_users_function {
1.815     tempelho 8031:     my $function = 'norole';
1.818     tempelho 8032:     if ($env{'request.role'}=~/^(st)/) {
                   8033:         $function='student';
                   8034:     }
1.907     raeburn  8035:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8036:         $function='coordinator';
                   8037:     }
1.258     albertel 8038:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8039:         $function='admin';
                   8040:     }
1.826     bisitz   8041:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8042:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8043:         $function='author';
                   8044:     }
                   8045:     return $function;
1.54      www      8046: }
1.99      www      8047: 
                   8048: ###############################################
                   8049: 
1.233     raeburn  8050: =pod
                   8051: 
1.821     raeburn  8052: =item * &show_course()
                   8053: 
                   8054: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8055: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8056: 
                   8057: Inputs:
                   8058: None
                   8059: 
                   8060: Outputs:
                   8061: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8062: 
                   8063: =cut
                   8064: 
                   8065: ###############################################
                   8066: sub show_course {
                   8067:     my $course = !$env{'user.adv'};
                   8068:     if (!$env{'user.adv'}) {
                   8069:         foreach my $env (keys(%env)) {
                   8070:             next if ($env !~ m/^user\.priv\./);
                   8071:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8072:                 $course = 0;
                   8073:                 last;
                   8074:             }
                   8075:         }
                   8076:     }
                   8077:     return $course;
                   8078: }
                   8079: 
                   8080: ###############################################
                   8081: 
                   8082: =pod
                   8083: 
1.542     raeburn  8084: =item * &check_user_status()
1.274     raeburn  8085: 
                   8086: Determines current status of supplied role for a
                   8087: specific user. Roles can be active, previous or future.
                   8088: 
                   8089: Inputs: 
                   8090: user's domain, user's username, course's domain,
1.375     raeburn  8091: course's number, optional section ID.
1.274     raeburn  8092: 
                   8093: Outputs:
                   8094: role status: active, previous or future. 
                   8095: 
                   8096: =cut
                   8097: 
                   8098: sub check_user_status {
1.412     raeburn  8099:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8100:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274     raeburn  8101:     my @uroles = keys %userinfo;
                   8102:     my $srchstr;
                   8103:     my $active_chk = 'none';
1.412     raeburn  8104:     my $now = time;
1.274     raeburn  8105:     if (@uroles > 0) {
1.908     raeburn  8106:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8107:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8108:         } else {
1.412     raeburn  8109:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8110:         }
                   8111:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8112:             my $role_end = 0;
                   8113:             my $role_start = 0;
                   8114:             $active_chk = 'active';
1.412     raeburn  8115:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8116:                 $role_end = $1;
                   8117:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8118:                     $role_start = $1;
1.274     raeburn  8119:                 }
                   8120:             }
                   8121:             if ($role_start > 0) {
1.412     raeburn  8122:                 if ($now < $role_start) {
1.274     raeburn  8123:                     $active_chk = 'future';
                   8124:                 }
                   8125:             }
                   8126:             if ($role_end > 0) {
1.412     raeburn  8127:                 if ($now > $role_end) {
1.274     raeburn  8128:                     $active_chk = 'previous';
                   8129:                 }
                   8130:             }
                   8131:         }
                   8132:     }
                   8133:     return $active_chk;
                   8134: }
                   8135: 
                   8136: ###############################################
                   8137: 
                   8138: =pod
                   8139: 
1.405     albertel 8140: =item * &get_sections()
1.233     raeburn  8141: 
                   8142: Determines all the sections for a course including
                   8143: sections with students and sections containing other roles.
1.419     raeburn  8144: Incoming parameters: 
                   8145: 
                   8146: 1. domain
                   8147: 2. course number 
                   8148: 3. reference to array containing roles for which sections should 
                   8149: be gathered (optional).
                   8150: 4. reference to array containing status types for which sections 
                   8151: should be gathered (optional).
                   8152: 
                   8153: If the third argument is undefined, sections are gathered for any role. 
                   8154: If the fourth argument is undefined, sections are gathered for any status.
                   8155: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  8156:  
1.374     raeburn  8157: Returns section hash (keys are section IDs, values are
                   8158: number of users in each section), subject to the
1.419     raeburn  8159: optional roles filter, optional status filter 
1.233     raeburn  8160: 
                   8161: =cut
                   8162: 
                   8163: ###############################################
                   8164: sub get_sections {
1.419     raeburn  8165:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 8166:     if (!defined($cdom) || !defined($cnum)) {
                   8167:         my $cid =  $env{'request.course.id'};
                   8168: 
                   8169: 	return if (!defined($cid));
                   8170: 
                   8171:         $cdom = $env{'course.'.$cid.'.domain'};
                   8172:         $cnum = $env{'course.'.$cid.'.num'};
                   8173:     }
                   8174: 
                   8175:     my %sectioncount;
1.419     raeburn  8176:     my $now = time;
1.240     albertel 8177: 
1.366     albertel 8178:     if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276     albertel 8179: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 8180: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   8181: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  8182:         my $start_index = &Apache::loncoursedata::CL_START();
                   8183:         my $end_index = &Apache::loncoursedata::CL_END();
                   8184:         my $status;
1.366     albertel 8185: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  8186: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   8187: 				                     $data->[$status_index],
                   8188:                                                      $data->[$start_index],
                   8189:                                                      $data->[$end_index]);
                   8190:             if ($stu_status eq 'Active') {
                   8191:                 $status = 'active';
                   8192:             } elsif ($end < $now) {
                   8193:                 $status = 'previous';
                   8194:             } elsif ($start > $now) {
                   8195:                 $status = 'future';
                   8196:             } 
                   8197: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   8198:                 if ((!defined($possible_status)) || (($status ne '') && 
                   8199:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   8200: 		    $sectioncount{$section}++;
                   8201:                 }
1.240     albertel 8202: 	    }
                   8203: 	}
                   8204:     }
                   8205:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8206:     foreach my $user (sort(keys(%courseroles))) {
                   8207: 	if ($user !~ /^(\w{2})/) { next; }
                   8208: 	my ($role) = ($user =~ /^(\w{2})/);
                   8209: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  8210: 	my ($section,$status);
1.240     albertel 8211: 	if ($role eq 'cr' &&
                   8212: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   8213: 	    $section=$1;
                   8214: 	}
                   8215: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   8216: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  8217:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   8218:         if ($end == -1 && $start == -1) {
                   8219:             next; #deleted role
                   8220:         }
                   8221:         if (!defined($possible_status)) { 
                   8222:             $sectioncount{$section}++;
                   8223:         } else {
                   8224:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   8225:                 $status = 'active';
                   8226:             } elsif ($end < $now) {
                   8227:                 $status = 'future';
                   8228:             } elsif ($start > $now) {
                   8229:                 $status = 'previous';
                   8230:             }
                   8231:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   8232:                 $sectioncount{$section}++;
                   8233:             }
                   8234:         }
1.233     raeburn  8235:     }
1.366     albertel 8236:     return %sectioncount;
1.233     raeburn  8237: }
                   8238: 
1.274     raeburn  8239: ###############################################
1.294     raeburn  8240: 
                   8241: =pod
1.405     albertel 8242: 
                   8243: =item * &get_course_users()
                   8244: 
1.275     raeburn  8245: Retrieves usernames:domains for users in the specified course
                   8246: with specific role(s), and access status. 
                   8247: 
                   8248: Incoming parameters:
1.277     albertel 8249: 1. course domain
                   8250: 2. course number
                   8251: 3. access status: users must have - either active, 
1.275     raeburn  8252: previous, future, or all.
1.277     albertel 8253: 4. reference to array of permissible roles
1.288     raeburn  8254: 5. reference to array of section restrictions (optional)
                   8255: 6. reference to results object (hash of hashes).
                   8256: 7. reference to optional userdata hash
1.609     raeburn  8257: 8. reference to optional statushash
1.630     raeburn  8258: 9. flag if privileged users (except those set to unhide in
                   8259:    course settings) should be excluded    
1.609     raeburn  8260: Keys of top level results hash are roles.
1.275     raeburn  8261: Keys of inner hashes are username:domain, with 
                   8262: values set to access type.
1.288     raeburn  8263: Optional userdata hash returns an array with arguments in the 
                   8264: same order as loncoursedata::get_classlist() for student data.
                   8265: 
1.609     raeburn  8266: Optional statushash returns
                   8267: 
1.288     raeburn  8268: Entries for end, start, section and status are blank because
                   8269: of the possibility of multiple values for non-student roles.
                   8270: 
1.275     raeburn  8271: =cut
1.405     albertel 8272: 
1.275     raeburn  8273: ###############################################
1.405     albertel 8274: 
1.275     raeburn  8275: sub get_course_users {
1.630     raeburn  8276:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  8277:     my %idx = ();
1.419     raeburn  8278:     my %seclists;
1.288     raeburn  8279: 
                   8280:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   8281:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   8282:     $idx{end} = &Apache::loncoursedata::CL_END();
                   8283:     $idx{start} = &Apache::loncoursedata::CL_START();
                   8284:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   8285:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   8286:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   8287:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   8288: 
1.290     albertel 8289:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 8290:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  8291:         my $now = time;
1.277     albertel 8292:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  8293:             my $match = 0;
1.412     raeburn  8294:             my $secmatch = 0;
1.419     raeburn  8295:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  8296:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  8297:             if ($section eq '') {
                   8298:                 $section = 'none';
                   8299:             }
1.291     albertel 8300:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8301:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8302:                     $secmatch = 1;
                   8303:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 8304:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8305:                         $secmatch = 1;
                   8306:                     }
                   8307:                 } else {  
1.419     raeburn  8308: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  8309: 		        $secmatch = 1;
                   8310:                     }
1.290     albertel 8311: 		}
1.412     raeburn  8312:                 if (!$secmatch) {
                   8313:                     next;
                   8314:                 }
1.419     raeburn  8315:             }
1.275     raeburn  8316:             if (defined($$types{'active'})) {
1.288     raeburn  8317:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  8318:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  8319:                     $match = 1;
1.275     raeburn  8320:                 }
                   8321:             }
                   8322:             if (defined($$types{'previous'})) {
1.609     raeburn  8323:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  8324:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  8325:                     $match = 1;
1.275     raeburn  8326:                 }
                   8327:             }
                   8328:             if (defined($$types{'future'})) {
1.609     raeburn  8329:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  8330:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  8331:                     $match = 1;
1.275     raeburn  8332:                 }
                   8333:             }
1.609     raeburn  8334:             if ($match) {
                   8335:                 push(@{$seclists{$student}},$section);
                   8336:                 if (ref($userdata) eq 'HASH') {
                   8337:                     $$userdata{$student} = $$classlist{$student};
                   8338:                 }
                   8339:                 if (ref($statushash) eq 'HASH') {
                   8340:                     $statushash->{$student}{'st'}{$section} = $status;
                   8341:                 }
1.288     raeburn  8342:             }
1.275     raeburn  8343:         }
                   8344:     }
1.412     raeburn  8345:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  8346:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8347:         my $now = time;
1.609     raeburn  8348:         my %displaystatus = ( previous => 'Expired',
                   8349:                               active   => 'Active',
                   8350:                               future   => 'Future',
                   8351:                             );
1.630     raeburn  8352:         my %nothide;
                   8353:         if ($hidepriv) {
                   8354:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   8355:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   8356:                 if ($user !~ /:/) {
                   8357:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   8358:                 } else {
                   8359:                     $nothide{$user} = 1;
                   8360:                 }
                   8361:             }
                   8362:         }
1.439     raeburn  8363:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  8364:             my $match = 0;
1.412     raeburn  8365:             my $secmatch = 0;
1.439     raeburn  8366:             my $status;
1.412     raeburn  8367:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  8368:             $user =~ s/:$//;
1.439     raeburn  8369:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   8370:             if ($end == -1 || $start == -1) {
                   8371:                 next;
                   8372:             }
                   8373:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   8374:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  8375:                 my ($uname,$udom) = split(/:/,$user);
                   8376:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8377:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8378:                         $secmatch = 1;
                   8379:                     } elsif ($usec eq '') {
1.420     albertel 8380:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8381:                             $secmatch = 1;
                   8382:                         }
                   8383:                     } else {
                   8384:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   8385:                             $secmatch = 1;
                   8386:                         }
                   8387:                     }
                   8388:                     if (!$secmatch) {
                   8389:                         next;
                   8390:                     }
1.288     raeburn  8391:                 }
1.419     raeburn  8392:                 if ($usec eq '') {
                   8393:                     $usec = 'none';
                   8394:                 }
1.275     raeburn  8395:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  8396:                     if ($hidepriv) {
                   8397:                         if ((&Apache::lonnet::privileged($uname,$udom)) &&
                   8398:                             (!$nothide{$uname.':'.$udom})) {
                   8399:                             next;
                   8400:                         }
                   8401:                     }
1.503     raeburn  8402:                     if ($end > 0 && $end < $now) {
1.439     raeburn  8403:                         $status = 'previous';
                   8404:                     } elsif ($start > $now) {
                   8405:                         $status = 'future';
                   8406:                     } else {
                   8407:                         $status = 'active';
                   8408:                     }
1.277     albertel 8409:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  8410:                         if ($status eq $type) {
1.420     albertel 8411:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  8412:                                 push(@{$$users{$role}{$user}},$type);
                   8413:                             }
1.288     raeburn  8414:                             $match = 1;
                   8415:                         }
                   8416:                     }
1.419     raeburn  8417:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   8418:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   8419: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   8420:                         }
1.420     albertel 8421:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  8422:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   8423:                         }
1.609     raeburn  8424:                         if (ref($statushash) eq 'HASH') {
                   8425:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   8426:                         }
1.275     raeburn  8427:                     }
                   8428:                 }
                   8429:             }
                   8430:         }
1.290     albertel 8431:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  8432:             if ((defined($cdom)) && (defined($cnum))) {
                   8433:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   8434:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   8435:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  8436:                     next if ($owner eq '');
                   8437:                     my ($ownername,$ownerdom);
                   8438:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   8439:                         $ownername = $1;
                   8440:                         $ownerdom = $2;
                   8441:                     } else {
                   8442:                         $ownername = $owner;
                   8443:                         $ownerdom = $cdom;
                   8444:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  8445:                     }
                   8446:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 8447:                     if (defined($userdata) && 
1.609     raeburn  8448: 			!exists($$userdata{$owner})) {
                   8449: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   8450:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   8451:                             push(@{$seclists{$owner}},'none');
                   8452:                         }
                   8453:                         if (ref($statushash) eq 'HASH') {
                   8454:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  8455:                         }
1.290     albertel 8456: 		    }
1.279     raeburn  8457:                 }
                   8458:             }
                   8459:         }
1.419     raeburn  8460:         foreach my $user (keys(%seclists)) {
                   8461:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   8462:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   8463:         }
1.275     raeburn  8464:     }
                   8465:     return;
                   8466: }
                   8467: 
1.288     raeburn  8468: sub get_user_info {
                   8469:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 8470:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   8471: 	&plainname($uname,$udom,'lastname');
1.291     albertel 8472:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  8473:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  8474:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   8475:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  8476:     return;
                   8477: }
1.275     raeburn  8478: 
1.472     raeburn  8479: ###############################################
                   8480: 
                   8481: =pod
                   8482: 
                   8483: =item * &get_user_quota()
                   8484: 
                   8485: Retrieves quota assigned for storage of portfolio files for a user  
                   8486: 
                   8487: Incoming parameters:
                   8488: 1. user's username
                   8489: 2. user's domain
                   8490: 
                   8491: Returns:
1.536     raeburn  8492: 1. Disk quota (in Mb) assigned to student.
                   8493: 2. (Optional) Type of setting: custom or default
                   8494:    (individually assigned or default for user's 
                   8495:    institutional status).
                   8496: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   8497:    or student - types as defined in localenroll::inst_usertypes 
                   8498:    for user's domain, which determines default quota for user.
                   8499: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  8500: 
                   8501: If a value has been stored in the user's environment, 
1.536     raeburn  8502: it will return that, otherwise it returns the maximal default
                   8503: defined for the user's instituional status(es) in the domain.
1.472     raeburn  8504: 
                   8505: =cut
                   8506: 
                   8507: ###############################################
                   8508: 
                   8509: 
                   8510: sub get_user_quota {
                   8511:     my ($uname,$udom) = @_;
1.536     raeburn  8512:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  8513:     if (!defined($udom)) {
                   8514:         $udom = $env{'user.domain'};
                   8515:     }
                   8516:     if (!defined($uname)) {
                   8517:         $uname = $env{'user.name'};
                   8518:     }
                   8519:     if (($udom eq '' || $uname eq '') ||
                   8520:         ($udom eq 'public') && ($uname eq 'public')) {
                   8521:         $quota = 0;
1.536     raeburn  8522:         $quotatype = 'default';
                   8523:         $defquota = 0; 
1.472     raeburn  8524:     } else {
1.536     raeburn  8525:         my $inststatus;
1.472     raeburn  8526:         if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   8527:             $quota = $env{'environment.portfolioquota'};
1.536     raeburn  8528:             $inststatus = $env{'environment.inststatus'};
1.472     raeburn  8529:         } else {
1.536     raeburn  8530:             my %userenv = 
                   8531:                 &Apache::lonnet::get('environment',['portfolioquota',
                   8532:                                      'inststatus'],$udom,$uname);
1.472     raeburn  8533:             my ($tmp) = keys(%userenv);
                   8534:             if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8535:                 $quota = $userenv{'portfolioquota'};
1.536     raeburn  8536:                 $inststatus = $userenv{'inststatus'};
1.472     raeburn  8537:             } else {
                   8538:                 undef(%userenv);
                   8539:             }
                   8540:         }
1.536     raeburn  8541:         ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472     raeburn  8542:         if ($quota eq '') {
1.536     raeburn  8543:             $quota = $defquota;
                   8544:             $quotatype = 'default';
                   8545:         } else {
                   8546:             $quotatype = 'custom';
1.472     raeburn  8547:         }
                   8548:     }
1.536     raeburn  8549:     if (wantarray) {
                   8550:         return ($quota,$quotatype,$settingstatus,$defquota);
                   8551:     } else {
                   8552:         return $quota;
                   8553:     }
1.472     raeburn  8554: }
                   8555: 
                   8556: ###############################################
                   8557: 
                   8558: =pod
                   8559: 
                   8560: =item * &default_quota()
                   8561: 
1.536     raeburn  8562: Retrieves default quota assigned for storage of user portfolio files,
                   8563: given an (optional) user's institutional status.
1.472     raeburn  8564: 
                   8565: Incoming parameters:
                   8566: 1. domain
1.536     raeburn  8567: 2. (Optional) institutional status(es).  This is a : separated list of 
                   8568:    status types (e.g., faculty, staff, student etc.)
                   8569:    which apply to the user for whom the default is being retrieved.
                   8570:    If the institutional status string in undefined, the domain
                   8571:    default quota will be returned. 
1.472     raeburn  8572: 
                   8573: Returns:
                   8574: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  8575: 2. (Optional) institutional type which determined the value of the
                   8576:    default quota.
1.472     raeburn  8577: 
                   8578: If a value has been stored in the domain's configuration db,
                   8579: it will return that, otherwise it returns 20 (for backwards 
                   8580: compatibility with domains which have not set up a configuration
                   8581: db file; the original statically defined portfolio quota was 20 Mb). 
                   8582: 
1.536     raeburn  8583: If the user's status includes multiple types (e.g., staff and student),
                   8584: the largest default quota which applies to the user determines the
                   8585: default quota returned.
                   8586: 
1.780     raeburn  8587: =back
                   8588: 
1.472     raeburn  8589: =cut
                   8590: 
                   8591: ###############################################
                   8592: 
                   8593: 
                   8594: sub default_quota {
1.536     raeburn  8595:     my ($udom,$inststatus) = @_;
                   8596:     my ($defquota,$settingstatus);
                   8597:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  8598:                                             ['quotas'],$udom);
                   8599:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  8600:         if ($inststatus ne '') {
1.765     raeburn  8601:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  8602:             foreach my $item (@statuses) {
1.711     raeburn  8603:                 if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   8604:                     if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
                   8605:                         if ($defquota eq '') {
                   8606:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   8607:                             $settingstatus = $item;
                   8608:                         } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
                   8609:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   8610:                             $settingstatus = $item;
                   8611:                         }
                   8612:                     }
                   8613:                 } else {
                   8614:                     if ($quotahash{'quotas'}{$item} ne '') {
                   8615:                         if ($defquota eq '') {
                   8616:                             $defquota = $quotahash{'quotas'}{$item};
                   8617:                             $settingstatus = $item;
                   8618:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   8619:                             $defquota = $quotahash{'quotas'}{$item};
                   8620:                             $settingstatus = $item;
                   8621:                         }
1.536     raeburn  8622:                     }
                   8623:                 }
                   8624:             }
                   8625:         }
                   8626:         if ($defquota eq '') {
1.711     raeburn  8627:             if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   8628:                 $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
                   8629:             } else {
                   8630:                 $defquota = $quotahash{'quotas'}{'default'};
                   8631:             }
1.536     raeburn  8632:             $settingstatus = 'default';
                   8633:         }
                   8634:     } else {
                   8635:         $settingstatus = 'default';
                   8636:         $defquota = 20;
                   8637:     }
                   8638:     if (wantarray) {
                   8639:         return ($defquota,$settingstatus);
1.472     raeburn  8640:     } else {
1.536     raeburn  8641:         return $defquota;
1.472     raeburn  8642:     }
                   8643: }
                   8644: 
1.384     raeburn  8645: sub get_secgrprole_info {
                   8646:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   8647:     my %sections_count = &get_sections($cdom,$cnum);
                   8648:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   8649:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   8650:     my @groups = sort(keys(%curr_groups));
                   8651:     my $allroles = [];
                   8652:     my $rolehash;
                   8653:     my $accesshash = {
                   8654:                      active => 'Currently has access',
                   8655:                      future => 'Will have future access',
                   8656:                      previous => 'Previously had access',
                   8657:                   };
                   8658:     if ($needroles) {
                   8659:         $rolehash = {'all' => 'all'};
1.385     albertel 8660:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8661: 	if (&Apache::lonnet::error(%user_roles)) {
                   8662: 	    undef(%user_roles);
                   8663: 	}
                   8664:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  8665:             my ($role)=split(/\:/,$item,2);
                   8666:             if ($role eq 'cr') { next; }
                   8667:             if ($role =~ /^cr/) {
                   8668:                 $$rolehash{$role} = (split('/',$role))[3];
                   8669:             } else {
                   8670:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   8671:             }
                   8672:         }
                   8673:         foreach my $key (sort(keys(%{$rolehash}))) {
                   8674:             push(@{$allroles},$key);
                   8675:         }
                   8676:         push (@{$allroles},'st');
                   8677:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   8678:     }
                   8679:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   8680: }
                   8681: 
1.555     raeburn  8682: sub user_picker {
1.994     raeburn  8683:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  8684:     my $currdom = $dom;
                   8685:     my %curr_selected = (
                   8686:                         srchin => 'dom',
1.580     raeburn  8687:                         srchby => 'lastname',
1.555     raeburn  8688:                       );
                   8689:     my $srchterm;
1.625     raeburn  8690:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  8691:         if ($srch->{'srchby'} ne '') {
                   8692:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   8693:         }
                   8694:         if ($srch->{'srchin'} ne '') {
                   8695:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   8696:         }
                   8697:         if ($srch->{'srchtype'} ne '') {
                   8698:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   8699:         }
                   8700:         if ($srch->{'srchdomain'} ne '') {
                   8701:             $currdom = $srch->{'srchdomain'};
                   8702:         }
                   8703:         $srchterm = $srch->{'srchterm'};
                   8704:     }
                   8705:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  8706:                     'usr'       => 'Search criteria',
1.563     raeburn  8707:                     'doma'      => 'Domain/institution to search',
1.558     albertel 8708:                     'uname'     => 'username',
                   8709:                     'lastname'  => 'last name',
1.555     raeburn  8710:                     'lastfirst' => 'last name, first name',
1.558     albertel 8711:                     'crs'       => 'in this course',
1.576     raeburn  8712:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 8713:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  8714:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 8715:                     'exact'     => 'is',
                   8716:                     'contains'  => 'contains',
1.569     raeburn  8717:                     'begins'    => 'begins with',
1.571     raeburn  8718:                     'youm'      => "You must include some text to search for.",
                   8719:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   8720:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   8721:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   8722:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   8723:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   8724:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   8725:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  8726:                                        );
1.563     raeburn  8727:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   8728:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  8729: 
                   8730:     my @srchins = ('crs','dom','alc','instd');
                   8731: 
                   8732:     foreach my $option (@srchins) {
                   8733:         # FIXME 'alc' option unavailable until 
                   8734:         #       loncreateuser::print_user_query_page()
                   8735:         #       has been completed.
                   8736:         next if ($option eq 'alc');
1.880     raeburn  8737:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  8738:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  8739:         if ($curr_selected{'srchin'} eq $option) {
                   8740:             $srchinsel .= ' 
                   8741:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8742:         } else {
                   8743:             $srchinsel .= '
                   8744:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8745:         }
1.555     raeburn  8746:     }
1.563     raeburn  8747:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  8748: 
                   8749:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  8750:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  8751:         if ($curr_selected{'srchby'} eq $option) {
                   8752:             $srchbysel .= '
                   8753:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8754:         } else {
                   8755:             $srchbysel .= '
                   8756:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8757:          }
                   8758:     }
                   8759:     $srchbysel .= "\n  </select>\n";
                   8760: 
                   8761:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  8762:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  8763:         if ($curr_selected{'srchtype'} eq $option) {
                   8764:             $srchtypesel .= '
                   8765:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8766:         } else {
                   8767:             $srchtypesel .= '
                   8768:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8769:         }
                   8770:     }
                   8771:     $srchtypesel .= "\n  </select>\n";
                   8772: 
1.558     albertel 8773:     my ($newuserscript,$new_user_create);
1.994     raeburn  8774:     my $context_dom = $env{'request.role.domain'};
                   8775:     if ($context eq 'requestcrs') {
                   8776:         if ($env{'form.coursedom'} ne '') { 
                   8777:             $context_dom = $env{'form.coursedom'};
                   8778:         }
                   8779:     }
1.556     raeburn  8780:     if ($forcenewuser) {
1.576     raeburn  8781:         if (ref($srch) eq 'HASH') {
1.994     raeburn  8782:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  8783:                 if ($cancreate) {
                   8784:                     $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>';
                   8785:                 } else {
1.799     bisitz   8786:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  8787:                     my %usertypetext = (
                   8788:                         official   => 'institutional',
                   8789:                         unofficial => 'non-institutional',
                   8790:                     );
1.799     bisitz   8791:                     $new_user_create = '<p class="LC_warning">'
                   8792:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   8793:                                       .' '
                   8794:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   8795:                                           ,'<a href="'.$helplink.'">','</a>')
                   8796:                                       .'</p><br />';
1.627     raeburn  8797:                 }
1.576     raeburn  8798:             }
                   8799:         }
                   8800: 
1.556     raeburn  8801:         $newuserscript = <<"ENDSCRIPT";
                   8802: 
1.570     raeburn  8803: function setSearch(createnew,callingForm) {
1.556     raeburn  8804:     if (createnew == 1) {
1.570     raeburn  8805:         for (var i=0; i<callingForm.srchby.length; i++) {
                   8806:             if (callingForm.srchby.options[i].value == 'uname') {
                   8807:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  8808:             }
                   8809:         }
1.570     raeburn  8810:         for (var i=0; i<callingForm.srchin.length; i++) {
                   8811:             if ( callingForm.srchin.options[i].value == 'dom') {
                   8812: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  8813:             }
                   8814:         }
1.570     raeburn  8815:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   8816:             if (callingForm.srchtype.options[i].value == 'exact') {
                   8817:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  8818:             }
                   8819:         }
1.570     raeburn  8820:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  8821:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  8822:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  8823:             }
                   8824:         }
                   8825:     }
                   8826: }
                   8827: ENDSCRIPT
1.558     albertel 8828: 
1.556     raeburn  8829:     }
                   8830: 
1.555     raeburn  8831:     my $output = <<"END_BLOCK";
1.556     raeburn  8832: <script type="text/javascript">
1.824     bisitz   8833: // <![CDATA[
1.570     raeburn  8834: function validateEntry(callingForm) {
1.558     albertel 8835: 
1.556     raeburn  8836:     var checkok = 1;
1.558     albertel 8837:     var srchin;
1.570     raeburn  8838:     for (var i=0; i<callingForm.srchin.length; i++) {
                   8839: 	if ( callingForm.srchin[i].checked ) {
                   8840: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 8841: 	}
                   8842:     }
                   8843: 
1.570     raeburn  8844:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   8845:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   8846:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   8847:     var srchterm =  callingForm.srchterm.value;
                   8848:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  8849:     var msg = "";
                   8850: 
                   8851:     if (srchterm == "") {
                   8852:         checkok = 0;
1.571     raeburn  8853:         msg += "$lt{'youm'}\\n";
1.556     raeburn  8854:     }
                   8855: 
1.569     raeburn  8856:     if (srchtype== 'begins') {
                   8857:         if (srchterm.length < 2) {
                   8858:             checkok = 0;
1.571     raeburn  8859:             msg += "$lt{'thte'}\\n";
1.569     raeburn  8860:         }
                   8861:     }
                   8862: 
1.556     raeburn  8863:     if (srchtype== 'contains') {
                   8864:         if (srchterm.length < 3) {
                   8865:             checkok = 0;
1.571     raeburn  8866:             msg += "$lt{'thet'}\\n";
1.556     raeburn  8867:         }
                   8868:     }
                   8869:     if (srchin == 'instd') {
                   8870:         if (srchdomain == '') {
                   8871:             checkok = 0;
1.571     raeburn  8872:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  8873:         }
                   8874:     }
                   8875:     if (srchin == 'dom') {
                   8876:         if (srchdomain == '') {
                   8877:             checkok = 0;
1.571     raeburn  8878:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  8879:         }
                   8880:     }
                   8881:     if (srchby == 'lastfirst') {
                   8882:         if (srchterm.indexOf(",") == -1) {
                   8883:             checkok = 0;
1.571     raeburn  8884:             msg += "$lt{'whus'}\\n";
1.556     raeburn  8885:         }
                   8886:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   8887:             checkok = 0;
1.571     raeburn  8888:             msg += "$lt{'whse'}\\n";
1.556     raeburn  8889:         }
                   8890:     }
                   8891:     if (checkok == 0) {
1.571     raeburn  8892:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  8893:         return;
                   8894:     }
                   8895:     if (checkok == 1) {
1.570     raeburn  8896:         callingForm.submit();
1.556     raeburn  8897:     }
                   8898: }
                   8899: 
                   8900: $newuserscript
                   8901: 
1.824     bisitz   8902: // ]]>
1.556     raeburn  8903: </script>
1.558     albertel 8904: 
                   8905: $new_user_create
                   8906: 
1.555     raeburn  8907: END_BLOCK
1.558     albertel 8908: 
1.876     raeburn  8909:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   8910:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   8911:                $domform.
                   8912:                &Apache::lonhtmlcommon::row_closure().
                   8913:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   8914:                $srchbysel.
                   8915:                $srchtypesel. 
                   8916:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   8917:                $srchinsel.
                   8918:                &Apache::lonhtmlcommon::row_closure(1). 
                   8919:                &Apache::lonhtmlcommon::end_pick_box().
                   8920:                '<br />';
1.555     raeburn  8921:     return $output;
                   8922: }
                   8923: 
1.612     raeburn  8924: sub user_rule_check {
1.615     raeburn  8925:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  8926:     my $response;
                   8927:     if (ref($usershash) eq 'HASH') {
                   8928:         foreach my $user (keys(%{$usershash})) {
                   8929:             my ($uname,$udom) = split(/:/,$user);
                   8930:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  8931:             my ($id,$newuser);
1.612     raeburn  8932:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  8933:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  8934:                 $id = $usershash->{$user}->{'id'};
                   8935:             }
                   8936:             my $inst_response;
                   8937:             if (ref($checks) eq 'HASH') {
                   8938:                 if (defined($checks->{'username'})) {
1.615     raeburn  8939:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  8940:                         &Apache::lonnet::get_instuser($udom,$uname);
                   8941:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  8942:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  8943:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   8944:                 }
1.615     raeburn  8945:             } else {
                   8946:                 ($inst_response,%{$inst_results->{$user}}) =
                   8947:                     &Apache::lonnet::get_instuser($udom,$uname);
                   8948:                 return;
1.612     raeburn  8949:             }
1.615     raeburn  8950:             if (!$got_rules->{$udom}) {
1.612     raeburn  8951:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   8952:                                                   ['usercreation'],$udom);
                   8953:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  8954:                     foreach my $item ('username','id') {
1.612     raeburn  8955:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   8956:                             $$curr_rules{$udom}{$item} = 
                   8957:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  8958:                         }
                   8959:                     }
                   8960:                 }
1.615     raeburn  8961:                 $got_rules->{$udom} = 1;  
1.585     raeburn  8962:             }
1.612     raeburn  8963:             foreach my $item (keys(%{$checks})) {
                   8964:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   8965:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   8966:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   8967:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   8968:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   8969:                                 if ($rule_check{$rule}) {
                   8970:                                     $$rulematch{$user}{$item} = $rule;
                   8971:                                     if ($inst_response eq 'ok') {
1.615     raeburn  8972:                                         if (ref($inst_results) eq 'HASH') {
                   8973:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   8974:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   8975:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   8976:                                                 }
1.612     raeburn  8977:                                             }
                   8978:                                         }
1.615     raeburn  8979:                                     }
                   8980:                                     last;
1.585     raeburn  8981:                                 }
                   8982:                             }
                   8983:                         }
                   8984:                     }
                   8985:                 }
                   8986:             }
                   8987:         }
                   8988:     }
1.612     raeburn  8989:     return;
                   8990: }
                   8991: 
                   8992: sub user_rule_formats {
                   8993:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   8994:     my %text = ( 
                   8995:                  'username' => 'Usernames',
                   8996:                  'id'       => 'IDs',
                   8997:                );
                   8998:     my $output;
                   8999:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   9000:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   9001:         if (@{$ruleorder} > 0) {
1.1075.2.20  raeburn  9002:             $output = '<br />'.
                   9003:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   9004:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   9005:                       ' <ul>';
1.612     raeburn  9006:             foreach my $rule (@{$ruleorder}) {
                   9007:                 if (ref($curr_rules) eq 'ARRAY') {
                   9008:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   9009:                         if (ref($rules->{$rule}) eq 'HASH') {
                   9010:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   9011:                                         $rules->{$rule}{'desc'}.'</li>';
                   9012:                         }
                   9013:                     }
                   9014:                 }
                   9015:             }
                   9016:             $output .= '</ul>';
                   9017:         }
                   9018:     }
                   9019:     return $output;
                   9020: }
                   9021: 
                   9022: sub instrule_disallow_msg {
1.615     raeburn  9023:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  9024:     my $response;
                   9025:     my %text = (
                   9026:                   item   => 'username',
                   9027:                   items  => 'usernames',
                   9028:                   match  => 'matches',
                   9029:                   do     => 'does',
                   9030:                   action => 'a username',
                   9031:                   one    => 'one',
                   9032:                );
                   9033:     if ($count > 1) {
                   9034:         $text{'item'} = 'usernames';
                   9035:         $text{'match'} ='match';
                   9036:         $text{'do'} = 'do';
                   9037:         $text{'action'} = 'usernames',
                   9038:         $text{'one'} = 'ones';
                   9039:     }
                   9040:     if ($checkitem eq 'id') {
                   9041:         $text{'items'} = 'IDs';
                   9042:         $text{'item'} = 'ID';
                   9043:         $text{'action'} = 'an ID';
1.615     raeburn  9044:         if ($count > 1) {
                   9045:             $text{'item'} = 'IDs';
                   9046:             $text{'action'} = 'IDs';
                   9047:         }
1.612     raeburn  9048:     }
1.674     bisitz   9049:     $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  9050:     if ($mode eq 'upload') {
                   9051:         if ($checkitem eq 'username') {
                   9052:             $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'}.");
                   9053:         } elsif ($checkitem eq 'id') {
1.674     bisitz   9054:             $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  9055:         }
1.669     raeburn  9056:     } elsif ($mode eq 'selfcreate') {
                   9057:         if ($checkitem eq 'id') {
                   9058:             $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.");
                   9059:         }
1.615     raeburn  9060:     } else {
                   9061:         if ($checkitem eq 'username') {
                   9062:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   9063:         } elsif ($checkitem eq 'id') {
                   9064:             $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.");
                   9065:         }
1.612     raeburn  9066:     }
                   9067:     return $response;
1.585     raeburn  9068: }
                   9069: 
1.624     raeburn  9070: sub personal_data_fieldtitles {
                   9071:     my %fieldtitles = &Apache::lonlocal::texthash (
                   9072:                         id => 'Student/Employee ID',
                   9073:                         permanentemail => 'E-mail address',
                   9074:                         lastname => 'Last Name',
                   9075:                         firstname => 'First Name',
                   9076:                         middlename => 'Middle Name',
                   9077:                         generation => 'Generation',
                   9078:                         gen => 'Generation',
1.765     raeburn  9079:                         inststatus => 'Affiliation',
1.624     raeburn  9080:                    );
                   9081:     return %fieldtitles;
                   9082: }
                   9083: 
1.642     raeburn  9084: sub sorted_inst_types {
                   9085:     my ($dom) = @_;
                   9086:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   9087:     my $othertitle = &mt('All users');
                   9088:     if ($env{'request.course.id'}) {
1.668     raeburn  9089:         $othertitle  = &mt('Any users');
1.642     raeburn  9090:     }
                   9091:     my @types;
                   9092:     if (ref($order) eq 'ARRAY') {
                   9093:         @types = @{$order};
                   9094:     }
                   9095:     if (@types == 0) {
                   9096:         if (ref($usertypes) eq 'HASH') {
                   9097:             @types = sort(keys(%{$usertypes}));
                   9098:         }
                   9099:     }
                   9100:     if (keys(%{$usertypes}) > 0) {
                   9101:         $othertitle = &mt('Other users');
                   9102:     }
                   9103:     return ($othertitle,$usertypes,\@types);
                   9104: }
                   9105: 
1.645     raeburn  9106: sub get_institutional_codes {
                   9107:     my ($settings,$allcourses,$LC_code) = @_;
                   9108: # Get complete list of course sections to update
                   9109:     my @currsections = ();
                   9110:     my @currxlists = ();
                   9111:     my $coursecode = $$settings{'internal.coursecode'};
                   9112: 
                   9113:     if ($$settings{'internal.sectionnums'} ne '') {
                   9114:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   9115:     }
                   9116: 
                   9117:     if ($$settings{'internal.crosslistings'} ne '') {
                   9118:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   9119:     }
                   9120: 
                   9121:     if (@currxlists > 0) {
                   9122:         foreach (@currxlists) {
                   9123:             if (m/^([^:]+):(\w*)$/) {
                   9124:                 unless (grep/^$1$/,@{$allcourses}) {
                   9125:                     push @{$allcourses},$1;
                   9126:                     $$LC_code{$1} = $2;
                   9127:                 }
                   9128:             }
                   9129:         }
                   9130:     }
                   9131:  
                   9132:     if (@currsections > 0) {
                   9133:         foreach (@currsections) {
                   9134:             if (m/^(\w+):(\w*)$/) {
                   9135:                 my $sec = $coursecode.$1;
                   9136:                 my $lc_sec = $2;
                   9137:                 unless (grep/^$sec$/,@{$allcourses}) {
                   9138:                     push @{$allcourses},$sec;
                   9139:                     $$LC_code{$sec} = $lc_sec;
                   9140:                 }
                   9141:             }
                   9142:         }
                   9143:     }
                   9144:     return;
                   9145: }
                   9146: 
1.971     raeburn  9147: sub get_standard_codeitems {
                   9148:     return ('Year','Semester','Department','Number','Section');
                   9149: }
                   9150: 
1.112     bowersj2 9151: =pod
                   9152: 
1.780     raeburn  9153: =head1 Slot Helpers
                   9154: 
                   9155: =over 4
                   9156: 
                   9157: =item * sorted_slots()
                   9158: 
1.1040    raeburn  9159: Sorts an array of slot names in order of an optional sort key,
                   9160: default sort is by slot start time (earliest first). 
1.780     raeburn  9161: 
                   9162: Inputs:
                   9163: 
                   9164: =over 4
                   9165: 
                   9166: slotsarr  - Reference to array of unsorted slot names.
                   9167: 
                   9168: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   9169: 
1.1040    raeburn  9170: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   9171: 
1.549     albertel 9172: =back
                   9173: 
1.780     raeburn  9174: Returns:
                   9175: 
                   9176: =over 4
                   9177: 
1.1040    raeburn  9178: sorted   - An array of slot names sorted by a specified sort key 
                   9179:            (default sort key is start time of the slot).
1.780     raeburn  9180: 
                   9181: =back
                   9182: 
                   9183: =cut
                   9184: 
                   9185: 
                   9186: sub sorted_slots {
1.1040    raeburn  9187:     my ($slotsarr,$slots,$sortkey) = @_;
                   9188:     if ($sortkey eq '') {
                   9189:         $sortkey = 'starttime';
                   9190:     }
1.780     raeburn  9191:     my @sorted;
                   9192:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   9193:         @sorted =
                   9194:             sort {
                   9195:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  9196:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  9197:                      }
                   9198:                      if (ref($slots->{$a})) { return -1;}
                   9199:                      if (ref($slots->{$b})) { return 1;}
                   9200:                      return 0;
                   9201:                  } @{$slotsarr};
                   9202:     }
                   9203:     return @sorted;
                   9204: }
                   9205: 
1.1040    raeburn  9206: =pod
                   9207: 
                   9208: =item * get_future_slots()
                   9209: 
                   9210: Inputs:
                   9211: 
                   9212: =over 4
                   9213: 
                   9214: cnum - course number
                   9215: 
                   9216: cdom - course domain
                   9217: 
                   9218: now - current UNIX time
                   9219: 
                   9220: symb - optional symb
                   9221: 
                   9222: =back
                   9223: 
                   9224: Returns:
                   9225: 
                   9226: =over 4
                   9227: 
                   9228: sorted_reservable - ref to array of student_schedulable slots currently 
                   9229:                     reservable, ordered by end date of reservation period.
                   9230: 
                   9231: reservable_now - ref to hash of student_schedulable slots currently
                   9232:                  reservable.
                   9233: 
                   9234:     Keys in inner hash are:
                   9235:     (a) symb: either blank or symb to which slot use is restricted.
                   9236:     (b) endreserve: end date of reservation period. 
                   9237: 
                   9238: sorted_future - ref to array of student_schedulable slots reservable in
                   9239:                 the future, ordered by start date of reservation period.
                   9240: 
                   9241: future_reservable - ref to hash of student_schedulable slots reservable
                   9242:                     in the future.
                   9243: 
                   9244:     Keys in inner hash are:
                   9245:     (a) symb: either blank or symb to which slot use is restricted.
                   9246:     (b) startreserve:  start date of reservation period.
                   9247: 
                   9248: =back
                   9249: 
                   9250: =cut
                   9251: 
                   9252: sub get_future_slots {
                   9253:     my ($cnum,$cdom,$now,$symb) = @_;
                   9254:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   9255:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   9256:     foreach my $slot (keys(%slots)) {
                   9257:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   9258:         if ($symb) {
                   9259:             next if (($slots{$slot}->{'symb'} ne '') && 
                   9260:                      ($slots{$slot}->{'symb'} ne $symb));
                   9261:         }
                   9262:         if (($slots{$slot}->{'starttime'} > $now) &&
                   9263:             ($slots{$slot}->{'endtime'} > $now)) {
                   9264:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   9265:                 my $userallowed = 0;
                   9266:                 if ($slots{$slot}->{'allowedsections'}) {
                   9267:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   9268:                     if (!defined($env{'request.role.sec'})
                   9269:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   9270:                         $userallowed=1;
                   9271:                     } else {
                   9272:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   9273:                             $userallowed=1;
                   9274:                         }
                   9275:                     }
                   9276:                     unless ($userallowed) {
                   9277:                         if (defined($env{'request.course.groups'})) {
                   9278:                             my @groups = split(/:/,$env{'request.course.groups'});
                   9279:                             foreach my $group (@groups) {
                   9280:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   9281:                                     $userallowed=1;
                   9282:                                     last;
                   9283:                                 }
                   9284:                             }
                   9285:                         }
                   9286:                     }
                   9287:                 }
                   9288:                 if ($slots{$slot}->{'allowedusers'}) {
                   9289:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   9290:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   9291:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   9292:                         $userallowed = 1;
                   9293:                     }
                   9294:                 }
                   9295:                 next unless($userallowed);
                   9296:             }
                   9297:             my $startreserve = $slots{$slot}->{'startreserve'};
                   9298:             my $endreserve = $slots{$slot}->{'endreserve'};
                   9299:             my $symb = $slots{$slot}->{'symb'};
                   9300:             if (($startreserve < $now) &&
                   9301:                 (!$endreserve || $endreserve > $now)) {
                   9302:                 my $lastres = $endreserve;
                   9303:                 if (!$lastres) {
                   9304:                     $lastres = $slots{$slot}->{'starttime'};
                   9305:                 }
                   9306:                 $reservable_now{$slot} = {
                   9307:                                            symb       => $symb,
                   9308:                                            endreserve => $lastres
                   9309:                                          };
                   9310:             } elsif (($startreserve > $now) &&
                   9311:                      (!$endreserve || $endreserve > $startreserve)) {
                   9312:                 $future_reservable{$slot} = {
                   9313:                                               symb         => $symb,
                   9314:                                               startreserve => $startreserve
                   9315:                                             };
                   9316:             }
                   9317:         }
                   9318:     }
                   9319:     my @unsorted_reservable = keys(%reservable_now);
                   9320:     if (@unsorted_reservable > 0) {
                   9321:         @sorted_reservable = 
                   9322:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   9323:     }
                   9324:     my @unsorted_future = keys(%future_reservable);
                   9325:     if (@unsorted_future > 0) {
                   9326:         @sorted_future =
                   9327:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   9328:     }
                   9329:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   9330: }
1.780     raeburn  9331: 
                   9332: =pod
                   9333: 
1.1057    foxr     9334: =back
                   9335: 
1.549     albertel 9336: =head1 HTTP Helpers
                   9337: 
                   9338: =over 4
                   9339: 
1.648     raeburn  9340: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 9341: 
1.258     albertel 9342: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 9343: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 9344: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 9345: 
                   9346: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   9347: $possible_names is an ref to an array of form element names.  As an example:
                   9348: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 9349: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 9350: 
                   9351: =cut
1.1       albertel 9352: 
1.6       albertel 9353: sub get_unprocessed_cgi {
1.25      albertel 9354:   my ($query,$possible_names)= @_;
1.26      matthew  9355:   # $Apache::lonxml::debug=1;
1.356     albertel 9356:   foreach my $pair (split(/&/,$query)) {
                   9357:     my ($name, $value) = split(/=/,$pair);
1.369     www      9358:     $name = &unescape($name);
1.25      albertel 9359:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   9360:       $value =~ tr/+/ /;
                   9361:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 9362:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 9363:     }
1.16      harris41 9364:   }
1.6       albertel 9365: }
                   9366: 
1.112     bowersj2 9367: =pod
                   9368: 
1.648     raeburn  9369: =item * &cacheheader() 
1.112     bowersj2 9370: 
                   9371: returns cache-controlling header code
                   9372: 
                   9373: =cut
                   9374: 
1.7       albertel 9375: sub cacheheader {
1.258     albertel 9376:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 9377:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   9378:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 9379:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   9380:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 9381:     return $output;
1.7       albertel 9382: }
                   9383: 
1.112     bowersj2 9384: =pod
                   9385: 
1.648     raeburn  9386: =item * &no_cache($r) 
1.112     bowersj2 9387: 
                   9388: specifies header code to not have cache
                   9389: 
                   9390: =cut
                   9391: 
1.9       albertel 9392: sub no_cache {
1.216     albertel 9393:     my ($r) = @_;
                   9394:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 9395: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 9396:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   9397:     $r->no_cache(1);
                   9398:     $r->header_out("Expires" => $date);
                   9399:     $r->header_out("Pragma" => "no-cache");
1.123     www      9400: }
                   9401: 
                   9402: sub content_type {
1.181     albertel 9403:     my ($r,$type,$charset) = @_;
1.299     foxr     9404:     if ($r) {
                   9405: 	#  Note that printout.pl calls this with undef for $r.
                   9406: 	&no_cache($r);
                   9407:     }
1.258     albertel 9408:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 9409:     unless ($charset) {
                   9410: 	$charset=&Apache::lonlocal::current_encoding;
                   9411:     }
                   9412:     if ($charset) { $type.='; charset='.$charset; }
                   9413:     if ($r) {
                   9414: 	$r->content_type($type);
                   9415:     } else {
                   9416: 	print("Content-type: $type\n\n");
                   9417:     }
1.9       albertel 9418: }
1.25      albertel 9419: 
1.112     bowersj2 9420: =pod
                   9421: 
1.648     raeburn  9422: =item * &add_to_env($name,$value) 
1.112     bowersj2 9423: 
1.258     albertel 9424: adds $name to the %env hash with value
1.112     bowersj2 9425: $value, if $name already exists, the entry is converted to an array
                   9426: reference and $value is added to the array.
                   9427: 
                   9428: =cut
                   9429: 
1.25      albertel 9430: sub add_to_env {
                   9431:   my ($name,$value)=@_;
1.258     albertel 9432:   if (defined($env{$name})) {
                   9433:     if (ref($env{$name})) {
1.25      albertel 9434:       #already have multiple values
1.258     albertel 9435:       push(@{ $env{$name} },$value);
1.25      albertel 9436:     } else {
                   9437:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 9438:       my $first=$env{$name};
                   9439:       undef($env{$name});
                   9440:       push(@{ $env{$name} },$first,$value);
1.25      albertel 9441:     }
                   9442:   } else {
1.258     albertel 9443:     $env{$name}=$value;
1.25      albertel 9444:   }
1.31      albertel 9445: }
1.149     albertel 9446: 
                   9447: =pod
                   9448: 
1.648     raeburn  9449: =item * &get_env_multiple($name) 
1.149     albertel 9450: 
1.258     albertel 9451: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 9452: values may be defined and end up as an array ref.
                   9453: 
                   9454: returns an array of values
                   9455: 
                   9456: =cut
                   9457: 
                   9458: sub get_env_multiple {
                   9459:     my ($name) = @_;
                   9460:     my @values;
1.258     albertel 9461:     if (defined($env{$name})) {
1.149     albertel 9462:         # exists is it an array
1.258     albertel 9463:         if (ref($env{$name})) {
                   9464:             @values=@{ $env{$name} };
1.149     albertel 9465:         } else {
1.258     albertel 9466:             $values[0]=$env{$name};
1.149     albertel 9467:         }
                   9468:     }
                   9469:     return(@values);
                   9470: }
                   9471: 
1.660     raeburn  9472: sub ask_for_embedded_content {
                   9473:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  9474:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11  raeburn  9475:         %currsubfile,%unused,$rem);
1.1071    raeburn  9476:     my $counter = 0;
                   9477:     my $numnew = 0;
1.987     raeburn  9478:     my $numremref = 0;
                   9479:     my $numinvalid = 0;
                   9480:     my $numpathchg = 0;
                   9481:     my $numexisting = 0;
1.1071    raeburn  9482:     my $numunused = 0;
                   9483:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
                   9484:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path);
                   9485:     my $heading = &mt('Upload embedded files');
                   9486:     my $buttontext = &mt('Upload');
                   9487: 
1.1075.2.11  raeburn  9488:     my $navmap;
                   9489:     if ($env{'request.course.id'}) {
                   9490:         $navmap = Apache::lonnavmaps::navmap->new();
                   9491:     }
1.984     raeburn  9492:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9493:         my $current_path='/';
                   9494:         if ($env{'form.currentpath'}) {
                   9495:             $current_path = $env{'form.currentpath'};
                   9496:         }
                   9497:         if ($actionurl eq '/adm/coursegrp_portfolio') {
                   9498:             $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9499:             $uname = $env{'course.'.$env{'request.course.id'}.'.num'};
                   9500:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   9501:         } else {
                   9502:             $udom = $env{'user.domain'};
                   9503:             $uname = $env{'user.name'};
                   9504:             $url = '/userfiles/portfolio';
                   9505:         }
1.987     raeburn  9506:         $toplevel = $url.'/';
1.984     raeburn  9507:         $url .= $current_path;
                   9508:         $getpropath = 1;
1.987     raeburn  9509:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   9510:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      9511:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  9512:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  9513:         $toplevel = $url;
1.984     raeburn  9514:         if ($rest ne '') {
1.987     raeburn  9515:             $url .= $rest;
                   9516:         }
                   9517:     } elsif ($actionurl eq '/adm/coursedocs') {
                   9518:         if (ref($args) eq 'HASH') {
1.1071    raeburn  9519:             $url = $args->{'docs_url'};
                   9520:             $toplevel = $url;
1.1075.2.11  raeburn  9521:             if ($args->{'context'} eq 'paste') {
                   9522:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   9523:                 ($path) =
                   9524:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9525:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9526:                 $fileloc =~ s{^/}{};
                   9527:             }
1.1071    raeburn  9528:         }
                   9529:     } elsif ($actionurl eq '/adm/dependencies') {
                   9530:         if ($env{'request.course.id'} ne '') {
                   9531:             $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9532:             $cnum =  $env{'course.'.$env{'request.course.id'}.'.num'};
                   9533:             if (ref($args) eq 'HASH') {
                   9534:                 $url = $args->{'docs_url'};
                   9535:                 $title = $args->{'docs_title'};
                   9536:                 $toplevel = "/$url";
1.1075.2.11  raeburn  9537:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1071    raeburn  9538:                 ($path) =  
                   9539:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9540:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9541:                 $fileloc =~ s{^/}{};
                   9542:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   9543:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   9544:             }
1.987     raeburn  9545:         }
                   9546:     }
                   9547:     my $now = time();
                   9548:     foreach my $embed_file (keys(%{$allfiles})) {
                   9549:         my $absolutepath;
                   9550:         if ($embed_file =~ m{^\w+://}) {
                   9551:             $newfiles{$embed_file} = 1;
                   9552:             $mapping{$embed_file} = $embed_file;
                   9553:         } else {
                   9554:             if ($embed_file =~ m{^/}) {
                   9555:                 $absolutepath = $embed_file;
                   9556:                 $embed_file =~ s{^(/+)}{};
                   9557:             }
                   9558:             if ($embed_file =~ m{/}) {
                   9559:                 my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
                   9560:                 $path = &check_for_traversal($path,$url,$toplevel);
                   9561:                 my $item = $fname;
                   9562:                 if ($path ne '') {
                   9563:                     $item = $path.'/'.$fname;
                   9564:                     $subdependencies{$path}{$fname} = 1;
                   9565:                 } else {
                   9566:                     $dependencies{$item} = 1;
                   9567:                 }
                   9568:                 if ($absolutepath) {
                   9569:                     $mapping{$item} = $absolutepath;
                   9570:                 } else {
                   9571:                     $mapping{$item} = $embed_file;
                   9572:                 }
                   9573:             } else {
                   9574:                 $dependencies{$embed_file} = 1;
                   9575:                 if ($absolutepath) {
                   9576:                     $mapping{$embed_file} = $absolutepath;
                   9577:                 } else {
                   9578:                     $mapping{$embed_file} = $embed_file;
                   9579:                 }
                   9580:             }
1.984     raeburn  9581:         }
                   9582:     }
1.1071    raeburn  9583:     my $dirptr = 16384;
1.984     raeburn  9584:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  9585:         $currsubfile{$path} = {};
1.984     raeburn  9586:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  9587:             my ($sublistref,$listerror) =
                   9588:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   9589:             if (ref($sublistref) eq 'ARRAY') {
                   9590:                 foreach my $line (@{$sublistref}) {
                   9591:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  9592:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  9593:                 }
1.984     raeburn  9594:             }
1.987     raeburn  9595:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9596:             if (opendir(my $dir,$url.'/'.$path)) {
                   9597:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  9598:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   9599:             }
1.1075.2.11  raeburn  9600:         } elsif (($actionurl eq '/adm/dependencies') ||
                   9601:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   9602:                   ($args->{'context'} eq 'paste'))) {
1.1071    raeburn  9603:             if ($env{'request.course.id'} ne '') {
                   9604:                 my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9605:                 if ($dir ne '') {
                   9606:                     my ($sublistref,$listerror) =
                   9607:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   9608:                     if (ref($sublistref) eq 'ARRAY') {
                   9609:                         foreach my $line (@{$sublistref}) {
                   9610:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   9611:                                 undef,$mtime)=split(/\&/,$line,12);
                   9612:                             unless (($testdir&$dirptr) ||
                   9613:                                     ($file_name =~ /^\.\.?$/)) {
                   9614:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   9615:                             }
                   9616:                         }
                   9617:                     }
                   9618:                 }
1.984     raeburn  9619:             }
                   9620:         }
                   9621:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  9622:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  9623:                 my $item = $path.'/'.$file;
                   9624:                 unless ($mapping{$item} eq $item) {
                   9625:                     $pathchanges{$item} = 1;
                   9626:                 }
                   9627:                 $existing{$item} = 1;
                   9628:                 $numexisting ++;
                   9629:             } else {
                   9630:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  9631:             }
                   9632:         }
1.1071    raeburn  9633:         if ($actionurl eq '/adm/dependencies') {
                   9634:             foreach my $path (keys(%currsubfile)) {
                   9635:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   9636:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   9637:                          unless ($subdependencies{$path}{$file}) {
1.1075.2.11  raeburn  9638:                              next if (($rem ne '') &&
                   9639:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   9640:                                        (ref($navmap) &&
                   9641:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   9642:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   9643:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  9644:                              $unused{$path.'/'.$file} = 1; 
                   9645:                          }
                   9646:                     }
                   9647:                 }
                   9648:             }
                   9649:         }
1.984     raeburn  9650:     }
1.987     raeburn  9651:     my %currfile;
1.984     raeburn  9652:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  9653:         my ($dirlistref,$listerror) =
                   9654:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   9655:         if (ref($dirlistref) eq 'ARRAY') {
                   9656:             foreach my $line (@{$dirlistref}) {
                   9657:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   9658:                 $currfile{$file_name} = 1;
                   9659:             }
1.984     raeburn  9660:         }
1.987     raeburn  9661:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9662:         if (opendir(my $dir,$url)) {
1.987     raeburn  9663:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  9664:             map {$currfile{$_} = 1;} @dir_list;
                   9665:         }
1.1075.2.11  raeburn  9666:     } elsif (($actionurl eq '/adm/dependencies') ||
                   9667:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   9668:               ($args->{'context'} eq 'paste'))) {
1.1071    raeburn  9669:         if ($env{'request.course.id'} ne '') {
                   9670:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9671:             if ($dir ne '') {
                   9672:                 my ($dirlistref,$listerror) =
                   9673:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   9674:                 if (ref($dirlistref) eq 'ARRAY') {
                   9675:                     foreach my $line (@{$dirlistref}) {
                   9676:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   9677:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   9678:                         unless (($testdir&$dirptr) ||
                   9679:                                 ($file_name =~ /^\.\.?$/)) {
                   9680:                             $currfile{$file_name} = [$size,$mtime];
                   9681:                         }
                   9682:                     }
                   9683:                 }
                   9684:             }
                   9685:         }
1.984     raeburn  9686:     }
                   9687:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  9688:         if (exists($currfile{$file})) {
1.987     raeburn  9689:             unless ($mapping{$file} eq $file) {
                   9690:                 $pathchanges{$file} = 1;
                   9691:             }
                   9692:             $existing{$file} = 1;
                   9693:             $numexisting ++;
                   9694:         } else {
1.984     raeburn  9695:             $newfiles{$file} = 1;
                   9696:         }
                   9697:     }
1.1071    raeburn  9698:     foreach my $file (keys(%currfile)) {
                   9699:         unless (($file eq $filename) ||
                   9700:                 ($file eq $filename.'.bak') ||
                   9701:                 ($dependencies{$file})) {
1.1075.2.11  raeburn  9702:             if ($actionurl eq '/adm/dependencies') {
                   9703:                 next if (($rem ne '') &&
                   9704:                          (($env{"httpref.$rem".$file} ne '') ||
                   9705:                           (ref($navmap) &&
                   9706:                           (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   9707:                            (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   9708:                             ($navmap->getResourceByUrl($rem.$1)))))));
                   9709:             }
1.1071    raeburn  9710:             $unused{$file} = 1;
                   9711:         }
                   9712:     }
1.1075.2.11  raeburn  9713:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   9714:         ($args->{'context'} eq 'paste')) {
                   9715:         $counter = scalar(keys(%existing));
                   9716:         $numpathchg = scalar(keys(%pathchanges));
                   9717:         return ($output,$counter,$numpathchg,\%existing);
                   9718:     }
1.984     raeburn  9719:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  9720:         if ($actionurl eq '/adm/dependencies') {
                   9721:             next if ($embed_file =~ m{^\w+://});
                   9722:         }
1.660     raeburn  9723:         $upload_output .= &start_data_table_row().
1.1071    raeburn  9724:                           '<td><img src="'.&icon($embed_file).'" />&nbsp;'.
                   9725:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  9726:         unless ($mapping{$embed_file} eq $embed_file) {
                   9727:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.&mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
                   9728:         }
                   9729:         $upload_output .= '</td><td>';
1.1071    raeburn  9730:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.660     raeburn  9731:             $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
1.987     raeburn  9732:             $numremref++;
1.660     raeburn  9733:         } elsif ($args->{'error_on_invalid_names'}
                   9734:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.987     raeburn  9735:             $upload_output.='<span class="LC_warning">'.&mt('Invalid characters').'</span>';
                   9736:             $numinvalid++;
1.660     raeburn  9737:         } else {
1.1071    raeburn  9738:             $upload_output .= &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  9739:                                                      $embed_file,\%mapping,
1.1071    raeburn  9740:                                                      $allfiles,$codebase,'upload');
                   9741:             $counter ++;
                   9742:             $numnew ++;
1.987     raeburn  9743:         }
                   9744:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   9745:     }
                   9746:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  9747:         if ($actionurl eq '/adm/dependencies') {
                   9748:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   9749:             $modify_output .= &start_data_table_row().
                   9750:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   9751:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   9752:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   9753:                               '<td>'.$size.'</td>'.
                   9754:                               '<td>'.$mtime.'</td>'.
                   9755:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   9756:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   9757:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   9758:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   9759:                               &embedded_file_element('upload_embedded',$counter,
                   9760:                                                      $embed_file,\%mapping,
                   9761:                                                      $allfiles,$codebase,'modify').
                   9762:                               '</div></td>'.
                   9763:                               &end_data_table_row()."\n";
                   9764:             $counter ++;
                   9765:         } else {
                   9766:             $upload_output .= &start_data_table_row().
                   9767:                               '<td><span class="LC_filename">'.$embed_file.'</span></td>';
                   9768:                               '<td><span class="LC_warning">'.&mt('Already exists').'</span></td>'.
                   9769:                               &Apache::loncommon::end_data_table_row()."\n";
                   9770:         }
                   9771:     }
                   9772:     my $delidx = $counter;
                   9773:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   9774:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   9775:         $delete_output .= &start_data_table_row().
                   9776:                           '<td><img src="'.&icon($oldfile).'" />'.
                   9777:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   9778:                           '<td>'.$size.'</td>'.
                   9779:                           '<td>'.$mtime.'</td>'.
                   9780:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   9781:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   9782:                           &embedded_file_element('upload_embedded',$delidx,
                   9783:                                                  $oldfile,\%mapping,$allfiles,
                   9784:                                                  $codebase,'delete').'</td>'.
                   9785:                           &end_data_table_row()."\n"; 
                   9786:         $numunused ++;
                   9787:         $delidx ++;
1.987     raeburn  9788:     }
                   9789:     if ($upload_output) {
                   9790:         $upload_output = &start_data_table().
                   9791:                          $upload_output.
                   9792:                          &end_data_table()."\n";
                   9793:     }
1.1071    raeburn  9794:     if ($modify_output) {
                   9795:         $modify_output = &start_data_table().
                   9796:                          &start_data_table_header_row().
                   9797:                          '<th>'.&mt('File').'</th>'.
                   9798:                          '<th>'.&mt('Size (KB)').'</th>'.
                   9799:                          '<th>'.&mt('Modified').'</th>'.
                   9800:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   9801:                          &end_data_table_header_row().
                   9802:                          $modify_output.
                   9803:                          &end_data_table()."\n";
                   9804:     }
                   9805:     if ($delete_output) {
                   9806:         $delete_output = &start_data_table().
                   9807:                          &start_data_table_header_row().
                   9808:                          '<th>'.&mt('File').'</th>'.
                   9809:                          '<th>'.&mt('Size (KB)').'</th>'.
                   9810:                          '<th>'.&mt('Modified').'</th>'.
                   9811:                          '<th>'.&mt('Delete?').'</th>'.
                   9812:                          &end_data_table_header_row().
                   9813:                          $delete_output.
                   9814:                          &end_data_table()."\n";
                   9815:     }
1.987     raeburn  9816:     my $applies = 0;
                   9817:     if ($numremref) {
                   9818:         $applies ++;
                   9819:     }
                   9820:     if ($numinvalid) {
                   9821:         $applies ++;
                   9822:     }
                   9823:     if ($numexisting) {
                   9824:         $applies ++;
                   9825:     }
1.1071    raeburn  9826:     if ($counter || $numunused) {
1.987     raeburn  9827:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   9828:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  9829:                   $state.'<h3>'.$heading.'</h3>'; 
                   9830:         if ($actionurl eq '/adm/dependencies') {
                   9831:             if ($numnew) {
                   9832:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   9833:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   9834:                            $upload_output.'<br />'."\n";
                   9835:             }
                   9836:             if ($numexisting) {
                   9837:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   9838:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   9839:                            $modify_output.'<br />'."\n";
                   9840:                            $buttontext = &mt('Save changes');
                   9841:             }
                   9842:             if ($numunused) {
                   9843:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   9844:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   9845:                            $delete_output.'<br />'."\n";
                   9846:                            $buttontext = &mt('Save changes');
                   9847:             }
                   9848:         } else {
                   9849:             $output .= $upload_output.'<br />'."\n";
                   9850:         }
                   9851:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   9852:                    $counter.'" />'."\n";
                   9853:         if ($actionurl eq '/adm/dependencies') { 
                   9854:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   9855:                        $numnew.'" />'."\n";
                   9856:         } elsif ($actionurl eq '') {
1.987     raeburn  9857:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   9858:         }
                   9859:     } elsif ($applies) {
                   9860:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   9861:         if ($applies > 1) {
                   9862:             $output .=  
                   9863:                 &mt('No files need to be uploaded, as one of the following applies to each reference:').'<ul>';
                   9864:             if ($numremref) {
                   9865:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   9866:             }
                   9867:             if ($numinvalid) {
                   9868:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   9869:             }
                   9870:             if ($numexisting) {
                   9871:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   9872:             }
                   9873:             $output .= '</ul><br />';
                   9874:         } elsif ($numremref) {
                   9875:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   9876:         } elsif ($numinvalid) {
                   9877:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   9878:         } elsif ($numexisting) {
                   9879:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   9880:         }
                   9881:         $output .= $upload_output.'<br />';
                   9882:     }
                   9883:     my ($pathchange_output,$chgcount);
1.1071    raeburn  9884:     $chgcount = $counter;
1.987     raeburn  9885:     if (keys(%pathchanges) > 0) {
                   9886:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  9887:             if ($counter) {
1.987     raeburn  9888:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   9889:                                                   $embed_file,\%mapping,
1.1071    raeburn  9890:                                                   $allfiles,$codebase,'change');
1.987     raeburn  9891:             } else {
                   9892:                 $pathchange_output .= 
                   9893:                     &start_data_table_row().
                   9894:                     '<td><input type ="checkbox" name="namechange" value="'.
                   9895:                     $chgcount.'" checked="checked" /></td>'.
                   9896:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   9897:                     '<td>'.$embed_file.
                   9898:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  9899:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  9900:                     '</td>'.&end_data_table_row();
1.660     raeburn  9901:             }
1.987     raeburn  9902:             $numpathchg ++;
                   9903:             $chgcount ++;
1.660     raeburn  9904:         }
                   9905:     }
1.1071    raeburn  9906:     if ($counter) {
1.987     raeburn  9907:         if ($numpathchg) {
                   9908:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   9909:                        $numpathchg.'" />'."\n";
                   9910:         }
                   9911:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   9912:             ($actionurl eq '/adm/imsimport')) {
                   9913:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   9914:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   9915:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  9916:         } elsif ($actionurl eq '/adm/dependencies') {
                   9917:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  9918:         }
1.1071    raeburn  9919:         $output .=  '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  9920:     } elsif ($numpathchg) {
                   9921:         my %pathchange = ();
                   9922:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   9923:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9924:             $output .= '<p>'.&mt('or').'</p>'; 
                   9925:         } 
                   9926:     }
1.1071    raeburn  9927:     return ($output,$counter,$numpathchg);
1.987     raeburn  9928: }
                   9929: 
                   9930: sub embedded_file_element {
1.1071    raeburn  9931:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  9932:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   9933:                    (ref($codebase) eq 'HASH'));
                   9934:     my $output;
1.1071    raeburn  9935:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  9936:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   9937:     }
                   9938:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   9939:                &escape($embed_file).'" />';
                   9940:     unless (($context eq 'upload_embedded') && 
                   9941:             ($mapping->{$embed_file} eq $embed_file)) {
                   9942:         $output .='
                   9943:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   9944:     }
                   9945:     my $attrib;
                   9946:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   9947:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   9948:     }
                   9949:     $output .=
                   9950:         "\n\t\t".
                   9951:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   9952:         $attrib.'" />';
                   9953:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   9954:         $output .=
                   9955:             "\n\t\t".
                   9956:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   9957:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  9958:     }
1.987     raeburn  9959:     return $output;
1.660     raeburn  9960: }
                   9961: 
1.1071    raeburn  9962: sub get_dependency_details {
                   9963:     my ($currfile,$currsubfile,$embed_file) = @_;
                   9964:     my ($size,$mtime,$showsize,$showmtime);
                   9965:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   9966:         if ($embed_file =~ m{/}) {
                   9967:             my ($path,$fname) = split(/\//,$embed_file);
                   9968:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   9969:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   9970:             }
                   9971:         } else {
                   9972:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   9973:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   9974:             }
                   9975:         }
                   9976:         $showsize = $size/1024.0;
                   9977:         $showsize = sprintf("%.1f",$showsize);
                   9978:         if ($mtime > 0) {
                   9979:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   9980:         }
                   9981:     }
                   9982:     return ($showsize,$showmtime);
                   9983: }
                   9984: 
                   9985: sub ask_embedded_js {
                   9986:     return <<"END";
                   9987: <script type="text/javascript"">
                   9988: // <![CDATA[
                   9989: function toggleBrowse(counter) {
                   9990:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   9991:     var fileid = document.getElementById('embedded_item_'+counter);
                   9992:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   9993:     if (chkboxid.checked == true) {
                   9994:         uploaddivid.style.display='block';
                   9995:     } else {
                   9996:         uploaddivid.style.display='none';
                   9997:         fileid.value = '';
                   9998:     }
                   9999: }
                   10000: // ]]>
                   10001: </script>
                   10002: 
                   10003: END
                   10004: }
                   10005: 
1.661     raeburn  10006: sub upload_embedded {
                   10007:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  10008:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   10009:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  10010:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   10011:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   10012:         my $orig_uploaded_filename =
                   10013:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  10014:         foreach my $type ('orig','ref','attrib','codebase') {
                   10015:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   10016:                 $env{'form.embedded_'.$type.'_'.$i} =
                   10017:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   10018:             }
                   10019:         }
1.661     raeburn  10020:         my ($path,$fname) =
                   10021:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   10022:         # no path, whole string is fname
                   10023:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   10024:         $fname = &Apache::lonnet::clean_filename($fname);
                   10025:         # See if there is anything left
                   10026:         next if ($fname eq '');
                   10027: 
                   10028:         # Check if file already exists as a file or directory.
                   10029:         my ($state,$msg);
                   10030:         if ($context eq 'portfolio') {
                   10031:             my $port_path = $dirpath;
                   10032:             if ($group ne '') {
                   10033:                 $port_path = "groups/$group/$port_path";
                   10034:             }
1.987     raeburn  10035:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   10036:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  10037:                                               $dir_root,$port_path,$disk_quota,
                   10038:                                               $current_disk_usage,$uname,$udom);
                   10039:             if ($state eq 'will_exceed_quota'
1.984     raeburn  10040:                 || $state eq 'file_locked') {
1.661     raeburn  10041:                 $output .= $msg;
                   10042:                 next;
                   10043:             }
                   10044:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   10045:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   10046:             if ($state eq 'exists') {
                   10047:                 $output .= $msg;
                   10048:                 next;
                   10049:             }
                   10050:         }
                   10051:         # Check if extension is valid
                   10052:         if (($fname =~ /\.(\w+)$/) &&
                   10053:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.987     raeburn  10054:             $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  10055:             next;
                   10056:         } elsif (($fname =~ /\.(\w+)$/) &&
                   10057:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  10058:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  10059:             next;
                   10060:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.987     raeburn  10061:             $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  10062:             next;
                   10063:         }
                   10064:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
                   10065:         if ($context eq 'portfolio') {
1.984     raeburn  10066:             my $result;
                   10067:             if ($state eq 'existingfile') {
                   10068:                 $result=
                   10069:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.987     raeburn  10070:                                                     $dirpath.$env{'form.currentpath'}.$path);
1.661     raeburn  10071:             } else {
1.984     raeburn  10072:                 $result=
                   10073:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  10074:                                                     $dirpath.
                   10075:                                                     $env{'form.currentpath'}.$path);
1.984     raeburn  10076:                 if ($result !~ m|^/uploaded/|) {
                   10077:                     $output .= '<span class="LC_error">'
                   10078:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10079:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10080:                                .'</span><br />';
                   10081:                     next;
                   10082:                 } else {
1.987     raeburn  10083:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10084:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  10085:                 }
1.661     raeburn  10086:             }
1.987     raeburn  10087:         } elsif ($context eq 'coursedoc') {
                   10088:             my $result =
                   10089:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',
                   10090:                                                 $dirpath.'/'.$path);
                   10091:             if ($result !~ m|^/uploaded/|) {
                   10092:                 $output .= '<span class="LC_error">'
                   10093:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10094:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10095:                            .'</span><br />';
                   10096:                     next;
                   10097:             } else {
                   10098:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10099:                            $path.$fname.'</span>').'<br />';
                   10100:             }
1.661     raeburn  10101:         } else {
                   10102: # Save the file
                   10103:             my $target = $env{'form.embedded_item_'.$i};
                   10104:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   10105:             my $dest = $fullpath.$fname;
                   10106:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  10107:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  10108:             my $count;
                   10109:             my $filepath = $dir_root;
1.1027    raeburn  10110:             foreach my $subdir (@parts) {
                   10111:                 $filepath .= "/$subdir";
                   10112:                 if (!-e $filepath) {
1.661     raeburn  10113:                     mkdir($filepath,0770);
                   10114:                 }
                   10115:             }
                   10116:             my $fh;
                   10117:             if (!open($fh,'>'.$dest)) {
                   10118:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   10119:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  10120:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   10121:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10122:                            '</span><br />';
                   10123:             } else {
                   10124:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   10125:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   10126:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  10127:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   10128:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10129:                               '</span><br />';
                   10130:                 } else {
1.987     raeburn  10131:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10132:                                $url.'</span>').'<br />';
                   10133:                     unless ($context eq 'testbank') {
                   10134:                         $footer .= &mt('View embedded file: [_1]',
                   10135:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   10136:                     }
                   10137:                 }
                   10138:                 close($fh);
                   10139:             }
                   10140:         }
                   10141:         if ($env{'form.embedded_ref_'.$i}) {
                   10142:             $pathchange{$i} = 1;
                   10143:         }
                   10144:     }
                   10145:     if ($output) {
                   10146:         $output = '<p>'.$output.'</p>';
                   10147:     }
                   10148:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   10149:     $returnflag = 'ok';
1.1071    raeburn  10150:     my $numpathchgs = scalar(keys(%pathchange));
                   10151:     if ($numpathchgs > 0) {
1.987     raeburn  10152:         if ($context eq 'portfolio') {
                   10153:             $output .= '<p>'.&mt('or').'</p>';
                   10154:         } elsif ($context eq 'testbank') {
1.1071    raeburn  10155:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   10156:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  10157:             $returnflag = 'modify_orightml';
                   10158:         }
                   10159:     }
1.1071    raeburn  10160:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  10161: }
                   10162: 
                   10163: sub modify_html_form {
                   10164:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   10165:     my $end = 0;
                   10166:     my $modifyform;
                   10167:     if ($context eq 'upload_embedded') {
                   10168:         return unless (ref($pathchange) eq 'HASH');
                   10169:         if ($env{'form.number_embedded_items'}) {
                   10170:             $end += $env{'form.number_embedded_items'};
                   10171:         }
                   10172:         if ($env{'form.number_pathchange_items'}) {
                   10173:             $end += $env{'form.number_pathchange_items'};
                   10174:         }
                   10175:         if ($end) {
                   10176:             for (my $i=0; $i<$end; $i++) {
                   10177:                 if ($i < $env{'form.number_embedded_items'}) {
                   10178:                     next unless($pathchange->{$i});
                   10179:                 }
                   10180:                 $modifyform .=
                   10181:                     &start_data_table_row().
                   10182:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   10183:                     'checked="checked" /></td>'.
                   10184:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   10185:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   10186:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   10187:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   10188:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   10189:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   10190:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   10191:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   10192:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   10193:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   10194:                     &end_data_table_row();
1.1071    raeburn  10195:             }
1.987     raeburn  10196:         }
                   10197:     } else {
                   10198:         $modifyform = $pathchgtable;
                   10199:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   10200:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   10201:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10202:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   10203:         }
                   10204:     }
                   10205:     if ($modifyform) {
1.1071    raeburn  10206:         if ($actionurl eq '/adm/dependencies') {
                   10207:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   10208:         }
1.987     raeburn  10209:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   10210:                '<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".
                   10211:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   10212:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   10213:                '</ol></p>'."\n".'<p>'.
                   10214:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   10215:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   10216:                &start_data_table()."\n".
                   10217:                &start_data_table_header_row().
                   10218:                '<th>'.&mt('Change?').'</th>'.
                   10219:                '<th>'.&mt('Current reference').'</th>'.
                   10220:                '<th>'.&mt('Required reference').'</th>'.
                   10221:                &end_data_table_header_row()."\n".
                   10222:                $modifyform.
                   10223:                &end_data_table().'<br />'."\n".$hiddenstate.
                   10224:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   10225:                '</form>'."\n";
                   10226:     }
                   10227:     return;
                   10228: }
                   10229: 
                   10230: sub modify_html_refs {
                   10231:     my ($context,$dirpath,$uname,$udom,$dir_root) = @_;
                   10232:     my $container;
                   10233:     if ($context eq 'portfolio') {
                   10234:         $container = $env{'form.container'};
                   10235:     } elsif ($context eq 'coursedoc') {
                   10236:         $container = $env{'form.primaryurl'};
1.1071    raeburn  10237:     } elsif ($context eq 'manage_dependencies') {
                   10238:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   10239:         $container = "/$container";
1.987     raeburn  10240:     } else {
1.1027    raeburn  10241:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  10242:     }
                   10243:     my (%allfiles,%codebase,$output,$content);
                   10244:     my @changes = &get_env_multiple('form.namechange');
1.1071    raeburn  10245:     unless (@changes > 0) {
                   10246:         if (wantarray) {
                   10247:             return ('',0,0); 
                   10248:         } else {
                   10249:             return;
                   10250:         }
                   10251:     }
                   10252:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
                   10253:         ($context eq 'manage_dependencies')) {
                   10254:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   10255:             if (wantarray) {
                   10256:                 return ('',0,0);
                   10257:             } else {
                   10258:                 return;
                   10259:             }
                   10260:         } 
1.987     raeburn  10261:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  10262:         if ($content eq '-1') {
                   10263:             if (wantarray) {
                   10264:                 return ('',0,0);
                   10265:             } else {
                   10266:                 return;
                   10267:             }
                   10268:         }
1.987     raeburn  10269:     } else {
1.1071    raeburn  10270:         unless ($container =~ /^\Q$dir_root\E/) {
                   10271:             if (wantarray) {
                   10272:                 return ('',0,0);
                   10273:             } else {
                   10274:                 return;
                   10275:             }
                   10276:         } 
1.987     raeburn  10277:         if (open(my $fh,"<$container")) {
                   10278:             $content = join('', <$fh>);
                   10279:             close($fh);
                   10280:         } else {
1.1071    raeburn  10281:             if (wantarray) {
                   10282:                 return ('',0,0);
                   10283:             } else {
                   10284:                 return;
                   10285:             }
1.987     raeburn  10286:         }
                   10287:     }
                   10288:     my ($count,$codebasecount) = (0,0);
                   10289:     my $mm = new File::MMagic;
                   10290:     my $mime_type = $mm->checktype_contents($content);
                   10291:     if ($mime_type eq 'text/html') {
                   10292:         my $parse_result = 
                   10293:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   10294:                                                     \%codebase,\$content);
                   10295:         if ($parse_result eq 'ok') {
                   10296:             foreach my $i (@changes) {
                   10297:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   10298:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   10299:                 if ($allfiles{$ref}) {
                   10300:                     my $newname =  $orig;
                   10301:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  10302:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  10303:                     if ($attrib_regexp =~ /:/) {
                   10304:                         $attrib_regexp =~ s/\:/|/g;
                   10305:                     }
                   10306:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10307:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10308:                         $count += $numchg;
                   10309:                     }
                   10310:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  10311:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  10312:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   10313:                         $codebasecount ++;
                   10314:                     }
                   10315:                 }
                   10316:             }
                   10317:             if ($count || $codebasecount) {
                   10318:                 my $saveresult;
1.1071    raeburn  10319:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
                   10320:                     ($context eq 'manage_dependencies')) {
1.987     raeburn  10321:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10322:                     if ($url eq $container) {
                   10323:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   10324:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10325:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  10326:                                             $fname.'</span>').'</p>';
1.987     raeburn  10327:                     } else {
                   10328:                          $output = '<p class="LC_error">'.
                   10329:                                    &mt('Error: update failed for: [_1].',
                   10330:                                    '<span class="LC_filename">'.
                   10331:                                    $container.'</span>').'</p>';
                   10332:                     }
                   10333:                 } else {
                   10334:                     if (open(my $fh,">$container")) {
                   10335:                         print $fh $content;
                   10336:                         close($fh);
                   10337:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10338:                                   $count,'<span class="LC_filename">'.
                   10339:                                   $container.'</span>').'</p>';
1.661     raeburn  10340:                     } else {
1.987     raeburn  10341:                          $output = '<p class="LC_error">'.
                   10342:                                    &mt('Error: could not update [_1].',
                   10343:                                    '<span class="LC_filename">'.
                   10344:                                    $container.'</span>').'</p>';
1.661     raeburn  10345:                     }
                   10346:                 }
                   10347:             }
1.987     raeburn  10348:         } else {
                   10349:             &logthis('Failed to parse '.$container.
                   10350:                      ' to modify references: '.$parse_result);
1.661     raeburn  10351:         }
                   10352:     }
1.1071    raeburn  10353:     if (wantarray) {
                   10354:         return ($output,$count,$codebasecount);
                   10355:     } else {
                   10356:         return $output;
                   10357:     }
1.661     raeburn  10358: }
                   10359: 
                   10360: sub check_for_existing {
                   10361:     my ($path,$fname,$element) = @_;
                   10362:     my ($state,$msg);
                   10363:     if (-d $path.'/'.$fname) {
                   10364:         $state = 'exists';
                   10365:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10366:     } elsif (-e $path.'/'.$fname) {
                   10367:         $state = 'exists';
                   10368:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10369:     }
                   10370:     if ($state eq 'exists') {
                   10371:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   10372:     }
                   10373:     return ($state,$msg);
                   10374: }
                   10375: 
                   10376: sub check_for_upload {
                   10377:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   10378:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  10379:     my $filesize = length($env{'form.'.$element});
                   10380:     if (!$filesize) {
                   10381:         my $msg = '<span class="LC_error">'.
                   10382:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   10383:                       '<span class="LC_filename">'.$fname.'</span>',
                   10384:                       $filesize).'<br />'.
1.1007    raeburn  10385:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  10386:                   '</span>';
                   10387:         return ('zero_bytes',$msg);
                   10388:     }
                   10389:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  10390:     my $getpropath = 1;
1.1021    raeburn  10391:     my ($dirlistref,$listerror) =
                   10392:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  10393:     my $found_file = 0;
                   10394:     my $locked_file = 0;
1.991     raeburn  10395:     my @lockers;
                   10396:     my $navmap;
                   10397:     if ($env{'request.course.id'}) {
                   10398:         $navmap = Apache::lonnavmaps::navmap->new();
                   10399:     }
1.1021    raeburn  10400:     if (ref($dirlistref) eq 'ARRAY') {
                   10401:         foreach my $line (@{$dirlistref}) {
                   10402:             my ($file_name,$rest)=split(/\&/,$line,2);
                   10403:             if ($file_name eq $fname){
                   10404:                 $file_name = $path.$file_name;
                   10405:                 if ($group ne '') {
                   10406:                     $file_name = $group.$file_name;
                   10407:                 }
                   10408:                 $found_file = 1;
                   10409:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   10410:                     foreach my $lock (@lockers) {
                   10411:                         if (ref($lock) eq 'ARRAY') {
                   10412:                             my ($symb,$crsid) = @{$lock};
                   10413:                             if ($crsid eq $env{'request.course.id'}) {
                   10414:                                 if (ref($navmap)) {
                   10415:                                     my $res = $navmap->getBySymb($symb);
                   10416:                                     foreach my $part (@{$res->parts()}) { 
                   10417:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   10418:                                         unless (($slot_status == $res->RESERVED) ||
                   10419:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   10420:                                             $locked_file = 1;
                   10421:                                         }
1.991     raeburn  10422:                                     }
1.1021    raeburn  10423:                                 } else {
                   10424:                                     $locked_file = 1;
1.991     raeburn  10425:                                 }
                   10426:                             } else {
                   10427:                                 $locked_file = 1;
                   10428:                             }
                   10429:                         }
1.1021    raeburn  10430:                    }
                   10431:                 } else {
                   10432:                     my @info = split(/\&/,$rest);
                   10433:                     my $currsize = $info[6]/1000;
                   10434:                     if ($currsize < $filesize) {
                   10435:                         my $extra = $filesize - $currsize;
                   10436:                         if (($current_disk_usage + $extra) > $disk_quota) {
                   10437:                             my $msg = '<span class="LC_error">'.
                   10438:                                       &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.',
                   10439:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
                   10440:                                       '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   10441:                                                    $disk_quota,$current_disk_usage);
                   10442:                             return ('will_exceed_quota',$msg);
                   10443:                         }
1.984     raeburn  10444:                     }
                   10445:                 }
1.661     raeburn  10446:             }
                   10447:         }
                   10448:     }
                   10449:     if (($current_disk_usage + $filesize) > $disk_quota){
                   10450:         my $msg = '<span class="LC_error">'.
                   10451:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   10452:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   10453:         return ('will_exceed_quota',$msg);
                   10454:     } elsif ($found_file) {
                   10455:         if ($locked_file) {
                   10456:             my $msg = '<span class="LC_error">';
                   10457:             $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>');
                   10458:             $msg .= '</span><br />';
                   10459:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   10460:             return ('file_locked',$msg);
                   10461:         } else {
                   10462:             my $msg = '<span class="LC_error">';
1.984     raeburn  10463:             $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  10464:             $msg .= '</span>';
1.984     raeburn  10465:             return ('existingfile',$msg);
1.661     raeburn  10466:         }
                   10467:     }
                   10468: }
                   10469: 
1.987     raeburn  10470: sub check_for_traversal {
                   10471:     my ($path,$url,$toplevel) = @_;
                   10472:     my @parts=split(/\//,$path);
                   10473:     my $cleanpath;
                   10474:     my $fullpath = $url;
                   10475:     for (my $i=0;$i<@parts;$i++) {
                   10476:         next if ($parts[$i] eq '.');
                   10477:         if ($parts[$i] eq '..') {
                   10478:             $fullpath =~ s{([^/]+/)$}{};
                   10479:         } else {
                   10480:             $fullpath .= $parts[$i].'/';
                   10481:         }
                   10482:     }
                   10483:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   10484:         $cleanpath = $1;
                   10485:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   10486:         my $curr_toprel = $1;
                   10487:         my @parts = split(/\//,$curr_toprel);
                   10488:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   10489:         my @urlparts = split(/\//,$url_toprel);
                   10490:         my $doubledots;
                   10491:         my $startdiff = -1;
                   10492:         for (my $i=0; $i<@urlparts; $i++) {
                   10493:             if ($startdiff == -1) {
                   10494:                 unless ($urlparts[$i] eq $parts[$i]) {
                   10495:                     $startdiff = $i;
                   10496:                     $doubledots .= '../';
                   10497:                 }
                   10498:             } else {
                   10499:                 $doubledots .= '../';
                   10500:             }
                   10501:         }
                   10502:         if ($startdiff > -1) {
                   10503:             $cleanpath = $doubledots;
                   10504:             for (my $i=$startdiff; $i<@parts; $i++) {
                   10505:                 $cleanpath .= $parts[$i].'/';
                   10506:             }
                   10507:         }
                   10508:     }
                   10509:     $cleanpath =~ s{(/)$}{};
                   10510:     return $cleanpath;
                   10511: }
1.31      albertel 10512: 
1.1053    raeburn  10513: sub is_archive_file {
                   10514:     my ($mimetype) = @_;
                   10515:     if (($mimetype eq 'application/octet-stream') ||
                   10516:         ($mimetype eq 'application/x-stuffit') ||
                   10517:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   10518:         return 1;
                   10519:     }
                   10520:     return;
                   10521: }
                   10522: 
                   10523: sub decompress_form {
1.1065    raeburn  10524:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  10525:     my %lt = &Apache::lonlocal::texthash (
                   10526:         this => 'This file is an archive file.',
1.1067    raeburn  10527:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  10528:         itsc => 'Its contents are as follows:',
1.1053    raeburn  10529:         youm => 'You may wish to extract its contents.',
                   10530:         extr => 'Extract contents',
1.1067    raeburn  10531:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   10532:         proa => 'Process automatically?',
1.1053    raeburn  10533:         yes  => 'Yes',
                   10534:         no   => 'No',
1.1067    raeburn  10535:         fold => 'Title for folder containing movie',
                   10536:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  10537:     );
1.1065    raeburn  10538:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  10539:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  10540:     my $info = &list_archive_contents($fileloc,\@paths);
                   10541:     if (@paths) {
                   10542:         foreach my $path (@paths) {
                   10543:             $path =~ s{^/}{};
1.1067    raeburn  10544:             if ($path =~ m{^([^/]+)/$}) {
                   10545:                 $topdir = $1;
                   10546:             }
1.1065    raeburn  10547:             if ($path =~ m{^([^/]+)/}) {
                   10548:                 $toplevel{$1} = $path;
                   10549:             } else {
                   10550:                 $toplevel{$path} = $path;
                   10551:             }
                   10552:         }
                   10553:     }
1.1067    raeburn  10554:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
                   10555:         my @camtasia = ("$topdir/","$topdir/index.html",
                   10556:                         "$topdir/media/",
                   10557:                         "$topdir/media/$topdir.mp4",
                   10558:                         "$topdir/media/FirstFrame.png",
                   10559:                         "$topdir/media/player.swf",
                   10560:                         "$topdir/media/swfobject.js",
                   10561:                         "$topdir/media/expressInstall.swf");
                   10562:         my @diffs = &compare_arrays(\@paths,\@camtasia);
                   10563:         if (@diffs == 0) {
                   10564:             $is_camtasia = 1;
                   10565:         }
                   10566:     }
                   10567:     my $output;
                   10568:     if ($is_camtasia) {
                   10569:         $output = <<"ENDCAM";
                   10570: <script type="text/javascript" language="Javascript">
                   10571: // <![CDATA[
                   10572: 
                   10573: function camtasiaToggle() {
                   10574:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   10575:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
                   10576:             if (document.uploaded_decompress.autoextract_camtasia[i].value == 1) {
                   10577: 
                   10578:                 document.getElementById('camtasia_titles').style.display='block';
                   10579:             } else {
                   10580:                 document.getElementById('camtasia_titles').style.display='none';
                   10581:             }
                   10582:         }
                   10583:     }
                   10584:     return;
                   10585: }
                   10586: 
                   10587: // ]]>
                   10588: </script>
                   10589: <p>$lt{'camt'}</p>
                   10590: ENDCAM
1.1065    raeburn  10591:     } else {
1.1067    raeburn  10592:         $output = '<p>'.$lt{'this'};
                   10593:         if ($info eq '') {
                   10594:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   10595:         } else {
                   10596:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   10597:                        '<div><pre>'.$info.'</pre></div>';
                   10598:         }
1.1065    raeburn  10599:     }
1.1067    raeburn  10600:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  10601:     my $duplicates;
                   10602:     my $num = 0;
                   10603:     if (ref($dirlist) eq 'ARRAY') {
                   10604:         foreach my $item (@{$dirlist}) {
                   10605:             if (ref($item) eq 'ARRAY') {
                   10606:                 if (exists($toplevel{$item->[0]})) {
                   10607:                     $duplicates .= 
                   10608:                         &start_data_table_row().
                   10609:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   10610:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   10611:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   10612:                         'value="1" />'.&mt('Yes').'</label>'.
                   10613:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   10614:                         '<td>'.$item->[0].'</td>';
                   10615:                     if ($item->[2]) {
                   10616:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   10617:                     } else {
                   10618:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   10619:                     }
                   10620:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   10621:                                    '<td>'.
                   10622:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   10623:                                    '</td>'.
                   10624:                                    &end_data_table_row();
                   10625:                     $num ++;
                   10626:                 }
                   10627:             }
                   10628:         }
                   10629:     }
                   10630:     my $itemcount;
                   10631:     if (@paths > 0) {
                   10632:         $itemcount = scalar(@paths);
                   10633:     } else {
                   10634:         $itemcount = 1;
                   10635:     }
1.1067    raeburn  10636:     if ($is_camtasia) {
                   10637:         $output .= $lt{'auto'}.'<br />'.
                   10638:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
                   10639:                    '<input type="radio" name="autoextract_camtasia" value="1" onclick="javascript:camtasiaToggle();" checked="checked" />'.
                   10640:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   10641:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   10642:                    $lt{'no'}.'</label></span><br />'.
                   10643:                    '<div id="camtasia_titles" style="display:block">'.
                   10644:                    &Apache::lonhtmlcommon::start_pick_box().
                   10645:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   10646:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   10647:                    &Apache::lonhtmlcommon::row_closure().
                   10648:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   10649:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   10650:                    &Apache::lonhtmlcommon::row_closure(1).
                   10651:                    &Apache::lonhtmlcommon::end_pick_box().
                   10652:                    '</div>';
                   10653:     }
1.1065    raeburn  10654:     $output .= 
                   10655:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  10656:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   10657:         "\n";
1.1065    raeburn  10658:     if ($duplicates ne '') {
                   10659:         $output .= '<p><span class="LC_warning">'.
                   10660:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   10661:                    &start_data_table().
                   10662:                    &start_data_table_header_row().
                   10663:                    '<th>'.&mt('Overwrite?').'</th>'.
                   10664:                    '<th>'.&mt('Name').'</th>'.
                   10665:                    '<th>'.&mt('Type').'</th>'.
                   10666:                    '<th>'.&mt('Size').'</th>'.
                   10667:                    '<th>'.&mt('Last modified').'</th>'.
                   10668:                    &end_data_table_header_row().
                   10669:                    $duplicates.
                   10670:                    &end_data_table().
                   10671:                    '</p>';
                   10672:     }
1.1067    raeburn  10673:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  10674:     if (ref($hiddenelements) eq 'HASH') {
                   10675:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   10676:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   10677:         }
                   10678:     }
                   10679:     $output .= <<"END";
1.1067    raeburn  10680: <br />
1.1053    raeburn  10681: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   10682: </form>
                   10683: $noextract
                   10684: END
                   10685:     return $output;
                   10686: }
                   10687: 
1.1065    raeburn  10688: sub decompression_utility {
                   10689:     my ($program) = @_;
                   10690:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   10691:     my $location;
                   10692:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   10693:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   10694:                          '/usr/sbin/') {
                   10695:             if (-x $dir.$program) {
                   10696:                 $location = $dir.$program;
                   10697:                 last;
                   10698:             }
                   10699:         }
                   10700:     }
                   10701:     return $location;
                   10702: }
                   10703: 
                   10704: sub list_archive_contents {
                   10705:     my ($file,$pathsref) = @_;
                   10706:     my (@cmd,$output);
                   10707:     my $needsregexp;
                   10708:     if ($file =~ /\.zip$/) {
                   10709:         @cmd = (&decompression_utility('unzip'),"-l");
                   10710:         $needsregexp = 1;
                   10711:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   10712:              ($file =~ /\.tgz$/)) {
                   10713:         @cmd = (&decompression_utility('tar'),"-ztf");
                   10714:     } elsif ($file =~ /\.tar\.bz2$/) {
                   10715:         @cmd = (&decompression_utility('tar'),"-jtf");
                   10716:     } elsif ($file =~ m|\.tar$|) {
                   10717:         @cmd = (&decompression_utility('tar'),"-tf");
                   10718:     }
                   10719:     if (@cmd) {
                   10720:         undef($!);
                   10721:         undef($@);
                   10722:         if (open(my $fh,"-|", @cmd, $file)) {
                   10723:             while (my $line = <$fh>) {
                   10724:                 $output .= $line;
                   10725:                 chomp($line);
                   10726:                 my $item;
                   10727:                 if ($needsregexp) {
                   10728:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   10729:                 } else {
                   10730:                     $item = $line;
                   10731:                 }
                   10732:                 if ($item ne '') {
                   10733:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   10734:                         push(@{$pathsref},$item);
                   10735:                     } 
                   10736:                 }
                   10737:             }
                   10738:             close($fh);
                   10739:         }
                   10740:     }
                   10741:     return $output;
                   10742: }
                   10743: 
1.1053    raeburn  10744: sub decompress_uploaded_file {
                   10745:     my ($file,$dir) = @_;
                   10746:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   10747:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   10748:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   10749:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   10750:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   10751:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   10752:     my $decompressed = $env{'cgi.decompressed'};
                   10753:     &Apache::lonnet::delenv('cgi.file');
                   10754:     &Apache::lonnet::delenv('cgi.dir');
                   10755:     &Apache::lonnet::delenv('cgi.decompressed');
                   10756:     return ($decompressed,$result);
                   10757: }
                   10758: 
1.1055    raeburn  10759: sub process_decompression {
                   10760:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   10761:     my ($dir,$error,$warning,$output);
                   10762:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {
                   10763:         $error = &mt('File name not a supported archive file type.').
                   10764:                  '<br />'.&mt('File name should end with one of: [_1].',
                   10765:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   10766:     } else {
                   10767:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   10768:         if ($docuhome eq 'no_host') {
                   10769:             $error = &mt('Could not determine home server for course.');
                   10770:         } else {
                   10771:             my @ids=&Apache::lonnet::current_machine_ids();
                   10772:             my $currdir = "$dir_root/$destination";
                   10773:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   10774:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   10775:                        "$dir_root/$destination";
                   10776:             } else {
                   10777:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   10778:                        "$dir_root/$docudom/$docuname/$destination";
                   10779:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   10780:                     $error = &mt('Archive file not found.');
                   10781:                 }
                   10782:             }
1.1065    raeburn  10783:             my (@to_overwrite,@to_skip);
                   10784:             if ($env{'form.archive_overwrite_total'} > 0) {
                   10785:                 my $total = $env{'form.archive_overwrite_total'};
                   10786:                 for (my $i=0; $i<$total; $i++) {
                   10787:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   10788:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   10789:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   10790:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   10791:                     }
                   10792:                 }
                   10793:             }
                   10794:             my $numskip = scalar(@to_skip);
                   10795:             if (($numskip > 0) && 
                   10796:                 ($numskip == $env{'form.archive_itemcount'})) {
                   10797:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   10798:             } elsif ($dir eq '') {
1.1055    raeburn  10799:                 $error = &mt('Directory containing archive file unavailable.');
                   10800:             } elsif (!$error) {
1.1065    raeburn  10801:                 my ($decompressed,$display);
                   10802:                 if ($numskip > 0) {
                   10803:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   10804:                     mkdir("$dir/$tempdir",0755);
                   10805:                     system("mv $dir/$file $dir/$tempdir/$file");
                   10806:                     ($decompressed,$display) = 
                   10807:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   10808:                     foreach my $item (@to_skip) {
                   10809:                         if (($item ne '') && ($item !~ /\.\./)) {
                   10810:                             if (-f "$dir/$tempdir/$item") { 
                   10811:                                 unlink("$dir/$tempdir/$item");
                   10812:                             } elsif (-d "$dir/$tempdir/$item") {
                   10813:                                 system("rm -rf $dir/$tempdir/$item");
                   10814:                             }
                   10815:                         }
                   10816:                     }
                   10817:                     system("mv $dir/$tempdir/* $dir");
                   10818:                     rmdir("$dir/$tempdir");   
                   10819:                 } else {
                   10820:                     ($decompressed,$display) = 
                   10821:                         &decompress_uploaded_file($file,$dir);
                   10822:                 }
1.1055    raeburn  10823:                 if ($decompressed eq 'ok') {
1.1065    raeburn  10824:                     $output = '<p class="LC_info">'.
                   10825:                               &mt('Files extracted successfully from archive.').
                   10826:                               '</p>'."\n";
1.1055    raeburn  10827:                     my ($warning,$result,@contents);
                   10828:                     my ($newdirlistref,$newlisterror) =
                   10829:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   10830:                                                  $docuname,1);
                   10831:                     my (%is_dir,%changes,@newitems);
                   10832:                     my $dirptr = 16384;
1.1065    raeburn  10833:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  10834:                         foreach my $dir_line (@{$newdirlistref}) {
                   10835:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  10836:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   10837:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  10838:                                 push(@newitems,$item);
                   10839:                                 if ($dirptr&$testdir) {
                   10840:                                     $is_dir{$item} = 1;
                   10841:                                 }
                   10842:                                 $changes{$item} = 1;
                   10843:                             }
                   10844:                         }
                   10845:                     }
                   10846:                     if (keys(%changes) > 0) {
                   10847:                         foreach my $item (sort(@newitems)) {
                   10848:                             if ($changes{$item}) {
                   10849:                                 push(@contents,$item);
                   10850:                             }
                   10851:                         }
                   10852:                     }
                   10853:                     if (@contents > 0) {
1.1067    raeburn  10854:                         my $wantform;
                   10855:                         unless ($env{'form.autoextract_camtasia'}) {
                   10856:                             $wantform = 1;
                   10857:                         }
1.1056    raeburn  10858:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  10859:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   10860:                                                                 $currdir,\%is_dir,
                   10861:                                                                 \%children,\%parent,
1.1056    raeburn  10862:                                                                 \@contents,\%dirorder,
                   10863:                                                                 \%titles,$wantform);
1.1055    raeburn  10864:                         if ($datatable ne '') {
                   10865:                             $output .= &archive_options_form('decompressed',$datatable,
                   10866:                                                              $count,$hiddenelem);
1.1065    raeburn  10867:                             my $startcount = 6;
1.1055    raeburn  10868:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  10869:                                                            \%titles,\%children);
1.1055    raeburn  10870:                         }
1.1067    raeburn  10871:                         if ($env{'form.autoextract_camtasia'}) {
                   10872:                             my %displayed;
                   10873:                             my $total = 1;
                   10874:                             $env{'form.archive_directory'} = [];
                   10875:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   10876:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   10877:                                 $path =~ s{/$}{};
                   10878:                                 my $item;
                   10879:                                 if ($path ne '') {
                   10880:                                     $item = "$path/$titles{$i}";
                   10881:                                 } else {
                   10882:                                     $item = $titles{$i};
                   10883:                                 }
                   10884:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   10885:                                 if ($item eq $contents[0]) {
                   10886:                                     push(@{$env{'form.archive_directory'}},$i);
                   10887:                                     $env{'form.archive_'.$i} = 'display';
                   10888:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   10889:                                     $displayed{'folder'} = $i;
                   10890:                                 } elsif ($item eq "$contents[0]/index.html") {
                   10891:                                     $env{'form.archive_'.$i} = 'display';
                   10892:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   10893:                                     $displayed{'web'} = $i;
                   10894:                                 } else {
                   10895:                                     if ($item eq "$contents[0]/media") {
                   10896:                                         push(@{$env{'form.archive_directory'}},$i);
                   10897:                                     }
                   10898:                                     $env{'form.archive_'.$i} = 'dependency';
                   10899:                                 }
                   10900:                                 $total ++;
                   10901:                             }
                   10902:                             for (my $i=1; $i<$total; $i++) {
                   10903:                                 next if ($i == $displayed{'web'});
                   10904:                                 next if ($i == $displayed{'folder'});
                   10905:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   10906:                             }
                   10907:                             $env{'form.phase'} = 'decompress_cleanup';
                   10908:                             $env{'form.archivedelete'} = 1;
                   10909:                             $env{'form.archive_count'} = $total-1;
                   10910:                             $output .=
                   10911:                                 &process_extracted_files('coursedocs',$docudom,
                   10912:                                                          $docuname,$destination,
                   10913:                                                          $dir_root,$hiddenelem);
                   10914:                         }
1.1055    raeburn  10915:                     } else {
                   10916:                         $warning = &mt('No new items extracted from archive file.');
                   10917:                     }
                   10918:                 } else {
                   10919:                     $output = $display;
                   10920:                     $error = &mt('An error occurred during extraction from the archive file.');
                   10921:                 }
                   10922:             }
                   10923:         }
                   10924:     }
                   10925:     if ($error) {
                   10926:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   10927:                    $error.'</p>'."\n";
                   10928:     }
                   10929:     if ($warning) {
                   10930:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   10931:     }
                   10932:     return $output;
                   10933: }
                   10934: 
                   10935: sub get_extracted {
1.1056    raeburn  10936:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   10937:         $titles,$wantform) = @_;
1.1055    raeburn  10938:     my $count = 0;
                   10939:     my $depth = 0;
                   10940:     my $datatable;
1.1056    raeburn  10941:     my @hierarchy;
1.1055    raeburn  10942:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  10943:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   10944:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  10945:     foreach my $item (@{$contents}) {
                   10946:         $count ++;
1.1056    raeburn  10947:         @{$dirorder->{$count}} = @hierarchy;
                   10948:         $titles->{$count} = $item;
1.1055    raeburn  10949:         &archive_hierarchy($depth,$count,$parent,$children);
                   10950:         if ($wantform) {
                   10951:             $datatable .= &archive_row($is_dir->{$item},$item,
                   10952:                                        $currdir,$depth,$count);
                   10953:         }
                   10954:         if ($is_dir->{$item}) {
                   10955:             $depth ++;
1.1056    raeburn  10956:             push(@hierarchy,$count);
                   10957:             $parent->{$depth} = $count;
1.1055    raeburn  10958:             $datatable .=
                   10959:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  10960:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   10961:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  10962:             $depth --;
1.1056    raeburn  10963:             pop(@hierarchy);
1.1055    raeburn  10964:         }
                   10965:     }
                   10966:     return ($count,$datatable);
                   10967: }
                   10968: 
                   10969: sub recurse_extracted_archive {
1.1056    raeburn  10970:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   10971:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  10972:     my $result='';
1.1056    raeburn  10973:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   10974:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   10975:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  10976:         return $result;
                   10977:     }
                   10978:     my $dirptr = 16384;
                   10979:     my ($newdirlistref,$newlisterror) =
                   10980:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   10981:     if (ref($newdirlistref) eq 'ARRAY') {
                   10982:         foreach my $dir_line (@{$newdirlistref}) {
                   10983:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   10984:             unless ($item =~ /^\.+$/) {
                   10985:                 $$count ++;
1.1056    raeburn  10986:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   10987:                 $titles->{$$count} = $item;
1.1055    raeburn  10988:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  10989: 
1.1055    raeburn  10990:                 my $is_dir;
                   10991:                 if ($dirptr&$testdir) {
                   10992:                     $is_dir = 1;
                   10993:                 }
                   10994:                 if ($wantform) {
                   10995:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   10996:                 }
                   10997:                 if ($is_dir) {
                   10998:                     $$depth ++;
1.1056    raeburn  10999:                     push(@{$hierarchy},$$count);
                   11000:                     $parent->{$$depth} = $$count;
1.1055    raeburn  11001:                     $result .=
                   11002:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   11003:                                                    $docuname,$depth,$count,
1.1056    raeburn  11004:                                                    $hierarchy,$dirorder,$children,
                   11005:                                                    $parent,$titles,$wantform);
1.1055    raeburn  11006:                     $$depth --;
1.1056    raeburn  11007:                     pop(@{$hierarchy});
1.1055    raeburn  11008:                 }
                   11009:             }
                   11010:         }
                   11011:     }
                   11012:     return $result;
                   11013: }
                   11014: 
                   11015: sub archive_hierarchy {
                   11016:     my ($depth,$count,$parent,$children) =@_;
                   11017:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   11018:         if (exists($parent->{$depth})) {
                   11019:              $children->{$parent->{$depth}} .= $count.':';
                   11020:         }
                   11021:     }
                   11022:     return;
                   11023: }
                   11024: 
                   11025: sub archive_row {
                   11026:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   11027:     my ($name) = ($item =~ m{([^/]+)$});
                   11028:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  11029:                                        'display'    => 'Add as file',
1.1055    raeburn  11030:                                        'dependency' => 'Include as dependency',
                   11031:                                        'discard'    => 'Discard',
                   11032:                                       );
                   11033:     if ($is_dir) {
1.1059    raeburn  11034:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  11035:     }
1.1056    raeburn  11036:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   11037:     my $offset = 0;
1.1055    raeburn  11038:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  11039:         $offset ++;
1.1065    raeburn  11040:         if ($action ne 'display') {
                   11041:             $offset ++;
                   11042:         }  
1.1055    raeburn  11043:         $output .= '<td><span class="LC_nobreak">'.
                   11044:                    '<label><input type="radio" name="archive_'.$count.
                   11045:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   11046:         my $text = $choices{$action};
                   11047:         if ($is_dir) {
                   11048:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   11049:             if ($action eq 'display') {
1.1059    raeburn  11050:                 $text = &mt('Add as folder');
1.1055    raeburn  11051:             }
1.1056    raeburn  11052:         } else {
                   11053:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   11054: 
                   11055:         }
                   11056:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   11057:         if ($action eq 'dependency') {
                   11058:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   11059:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   11060:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   11061:                        '<option value=""></option>'."\n".
                   11062:                        '</select>'."\n".
                   11063:                        '</div>';
1.1059    raeburn  11064:         } elsif ($action eq 'display') {
                   11065:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   11066:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   11067:                        '</div>';
1.1055    raeburn  11068:         }
1.1056    raeburn  11069:         $output .= '</td>';
1.1055    raeburn  11070:     }
                   11071:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   11072:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   11073:     for (my $i=0; $i<$depth; $i++) {
                   11074:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   11075:     }
                   11076:     if ($is_dir) {
                   11077:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   11078:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   11079:     } else {
                   11080:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   11081:     }
                   11082:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   11083:                &end_data_table_row();
                   11084:     return $output;
                   11085: }
                   11086: 
                   11087: sub archive_options_form {
1.1065    raeburn  11088:     my ($form,$display,$count,$hiddenelem) = @_;
                   11089:     my %lt = &Apache::lonlocal::texthash(
                   11090:                perm => 'Permanently remove archive file?',
                   11091:                hows => 'How should each extracted item be incorporated in the course?',
                   11092:                cont => 'Content actions for all',
                   11093:                addf => 'Add as folder/file',
                   11094:                incd => 'Include as dependency for a displayed file',
                   11095:                disc => 'Discard',
                   11096:                no   => 'No',
                   11097:                yes  => 'Yes',
                   11098:                save => 'Save',
                   11099:     );
                   11100:     my $output = <<"END";
                   11101: <form name="$form" method="post" action="">
                   11102: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   11103: <label>
                   11104:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   11105: </label>
                   11106: &nbsp;
                   11107: <label>
                   11108:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   11109: </span>
                   11110: </p>
                   11111: <input type="hidden" name="phase" value="decompress_cleanup" />
                   11112: <br />$lt{'hows'}
                   11113: <div class="LC_columnSection">
                   11114:   <fieldset>
                   11115:     <legend>$lt{'cont'}</legend>
                   11116:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   11117:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   11118:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   11119:   </fieldset>
                   11120: </div>
                   11121: END
                   11122:     return $output.
1.1055    raeburn  11123:            &start_data_table()."\n".
1.1065    raeburn  11124:            $display."\n".
1.1055    raeburn  11125:            &end_data_table()."\n".
                   11126:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   11127:            $hiddenelem.
1.1065    raeburn  11128:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  11129:            '</form>';
                   11130: }
                   11131: 
                   11132: sub archive_javascript {
1.1056    raeburn  11133:     my ($startcount,$numitems,$titles,$children) = @_;
                   11134:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  11135:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  11136:     my $scripttag = <<START;
                   11137: <script type="text/javascript">
                   11138: // <![CDATA[
                   11139: 
                   11140: function checkAll(form,prefix) {
                   11141:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   11142:     for (var i=0; i < form.elements.length; i++) {
                   11143:         var id = form.elements[i].id;
                   11144:         if ((id != '') && (id != undefined)) {
                   11145:             if (idstr.test(id)) {
                   11146:                 if (form.elements[i].type == 'radio') {
                   11147:                     form.elements[i].checked = true;
1.1056    raeburn  11148:                     var nostart = i-$startcount;
1.1059    raeburn  11149:                     var offset = nostart%7;
                   11150:                     var count = (nostart-offset)/7;    
1.1056    raeburn  11151:                     dependencyCheck(form,count,offset);
1.1055    raeburn  11152:                 }
                   11153:             }
                   11154:         }
                   11155:     }
                   11156: }
                   11157: 
                   11158: function propagateCheck(form,count) {
                   11159:     if (count > 0) {
1.1059    raeburn  11160:         var startelement = $startcount + ((count-1) * 7);
                   11161:         for (var j=1; j<6; j++) {
                   11162:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  11163:                 var item = startelement + j; 
                   11164:                 if (form.elements[item].type == 'radio') {
                   11165:                     if (form.elements[item].checked) {
                   11166:                         containerCheck(form,count,j);
                   11167:                         break;
                   11168:                     }
1.1055    raeburn  11169:                 }
                   11170:             }
                   11171:         }
                   11172:     }
                   11173: }
                   11174: 
                   11175: numitems = $numitems
1.1056    raeburn  11176: var titles = new Array(numitems);
                   11177: var parents = new Array(numitems);
1.1055    raeburn  11178: for (var i=0; i<numitems; i++) {
1.1056    raeburn  11179:     parents[i] = new Array;
1.1055    raeburn  11180: }
1.1059    raeburn  11181: var maintitle = '$maintitle';
1.1055    raeburn  11182: 
                   11183: START
                   11184: 
1.1056    raeburn  11185:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   11186:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  11187:         for (my $i=0; $i<@contents; $i ++) {
                   11188:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   11189:         }
                   11190:     }
                   11191: 
1.1056    raeburn  11192:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   11193:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   11194:     }
                   11195: 
1.1055    raeburn  11196:     $scripttag .= <<END;
                   11197: 
                   11198: function containerCheck(form,count,offset) {
                   11199:     if (count > 0) {
1.1056    raeburn  11200:         dependencyCheck(form,count,offset);
1.1059    raeburn  11201:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  11202:         form.elements[item].checked = true;
                   11203:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11204:             if (parents[count].length > 0) {
                   11205:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  11206:                     containerCheck(form,parents[count][j],offset);
                   11207:                 }
                   11208:             }
                   11209:         }
                   11210:     }
                   11211: }
                   11212: 
                   11213: function dependencyCheck(form,count,offset) {
                   11214:     if (count > 0) {
1.1059    raeburn  11215:         var chosen = (offset+$startcount)+7*(count-1);
                   11216:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  11217:         var currtype = form.elements[depitem].type;
                   11218:         if (form.elements[chosen].value == 'dependency') {
                   11219:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   11220:             form.elements[depitem].options.length = 0;
                   11221:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11  raeburn  11222:             for (var i=1; i<=numitems; i++) {
                   11223:                 if (i == count) {
                   11224:                     continue;
                   11225:                 }
1.1059    raeburn  11226:                 var startelement = $startcount + (i-1) * 7;
                   11227:                 for (var j=1; j<6; j++) {
                   11228:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  11229:                         var item = startelement + j;
                   11230:                         if (form.elements[item].type == 'radio') {
                   11231:                             if (form.elements[item].checked) {
                   11232:                                 if (form.elements[item].value == 'display') {
                   11233:                                     var n = form.elements[depitem].options.length;
                   11234:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   11235:                                 }
                   11236:                             }
                   11237:                         }
                   11238:                     }
                   11239:                 }
                   11240:             }
                   11241:         } else {
                   11242:             document.getElementById('arc_depon_'+count).style.display='none';
                   11243:             form.elements[depitem].options.length = 0;
                   11244:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   11245:         }
1.1059    raeburn  11246:         titleCheck(form,count,offset);
1.1056    raeburn  11247:     }
                   11248: }
                   11249: 
                   11250: function propagateSelect(form,count,offset) {
                   11251:     if (count > 0) {
1.1065    raeburn  11252:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  11253:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   11254:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11255:             if (parents[count].length > 0) {
                   11256:                 for (var j=0; j<parents[count].length; j++) {
                   11257:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  11258:                 }
                   11259:             }
                   11260:         }
                   11261:     }
                   11262: }
1.1056    raeburn  11263: 
                   11264: function containerSelect(form,count,offset,picked) {
                   11265:     if (count > 0) {
1.1065    raeburn  11266:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  11267:         if (form.elements[item].type == 'radio') {
                   11268:             if (form.elements[item].value == 'dependency') {
                   11269:                 if (form.elements[item+1].type == 'select-one') {
                   11270:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   11271:                         if (form.elements[item+1].options[i].value == picked) {
                   11272:                             form.elements[item+1].selectedIndex = i;
                   11273:                             break;
                   11274:                         }
                   11275:                     }
                   11276:                 }
                   11277:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11278:                     if (parents[count].length > 0) {
                   11279:                         for (var j=0; j<parents[count].length; j++) {
                   11280:                             containerSelect(form,parents[count][j],offset,picked);
                   11281:                         }
                   11282:                     }
                   11283:                 }
                   11284:             }
                   11285:         }
                   11286:     }
                   11287: }
                   11288: 
1.1059    raeburn  11289: function titleCheck(form,count,offset) {
                   11290:     if (count > 0) {
                   11291:         var chosen = (offset+$startcount)+7*(count-1);
                   11292:         var depitem = $startcount + ((count-1) * 7) + 2;
                   11293:         var currtype = form.elements[depitem].type;
                   11294:         if (form.elements[chosen].value == 'display') {
                   11295:             document.getElementById('arc_title_'+count).style.display='block';
                   11296:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   11297:                 document.getElementById('archive_title_'+count).value=maintitle;
                   11298:             }
                   11299:         } else {
                   11300:             document.getElementById('arc_title_'+count).style.display='none';
                   11301:             if (currtype == 'text') { 
                   11302:                 document.getElementById('archive_title_'+count).value='';
                   11303:             }
                   11304:         }
                   11305:     }
                   11306:     return;
                   11307: }
                   11308: 
1.1055    raeburn  11309: // ]]>
                   11310: </script>
                   11311: END
                   11312:     return $scripttag;
                   11313: }
                   11314: 
                   11315: sub process_extracted_files {
1.1067    raeburn  11316:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  11317:     my $numitems = $env{'form.archive_count'};
                   11318:     return unless ($numitems);
                   11319:     my @ids=&Apache::lonnet::current_machine_ids();
                   11320:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  11321:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  11322:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11323:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11324:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   11325:         $pathtocheck = "$dir_root/$destination";
                   11326:         $dir = $dir_root;
                   11327:         $ishome = 1;
                   11328:     } else {
                   11329:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   11330:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   11331:         $dir = "$dir_root/$docudom/$docuname";    
                   11332:     }
                   11333:     my $currdir = "$dir_root/$destination";
                   11334:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   11335:     if ($env{'form.folderpath'}) {
                   11336:         my @items = split('&',$env{'form.folderpath'});
                   11337:         $folders{'0'} = $items[-2];
1.1075.2.17  raeburn  11338:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   11339:             $containers{'0'}='page';
                   11340:         } else {
                   11341:             $containers{'0'}='sequence';
                   11342:         }
1.1055    raeburn  11343:     }
                   11344:     my @archdirs = &get_env_multiple('form.archive_directory');
                   11345:     if ($numitems) {
                   11346:         for (my $i=1; $i<=$numitems; $i++) {
                   11347:             my $path = $env{'form.archive_content_'.$i};
                   11348:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   11349:                 my $item = $1;
                   11350:                 $toplevelitems{$item} = $i;
                   11351:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   11352:                     $is_dir{$item} = 1;
                   11353:                 }
                   11354:             }
                   11355:         }
                   11356:     }
1.1067    raeburn  11357:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  11358:     if (keys(%toplevelitems) > 0) {
                   11359:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  11360:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   11361:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  11362:     }
1.1066    raeburn  11363:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  11364:     if ($numitems) {
                   11365:         for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11  raeburn  11366:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  11367:             my $path = $env{'form.archive_content_'.$i};
                   11368:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11369:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   11370:                     if ($prefix ne '' && $path ne '') {
                   11371:                         if (-e $prefix.$path) {
1.1066    raeburn  11372:                             if ((@archdirs > 0) && 
                   11373:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   11374:                                 $todeletedir{$prefix.$path} = 1;
                   11375:                             } else {
                   11376:                                 $todelete{$prefix.$path} = 1;
                   11377:                             }
1.1055    raeburn  11378:                         }
                   11379:                     }
                   11380:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  11381:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  11382:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  11383:                     $docstitle = $env{'form.archive_title_'.$i};
                   11384:                     if ($docstitle eq '') {
                   11385:                         $docstitle = $title;
                   11386:                     }
1.1055    raeburn  11387:                     $outer = 0;
1.1056    raeburn  11388:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11389:                         if (@{$dirorder{$i}} > 0) {
                   11390:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  11391:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   11392:                                     $outer = $item;
                   11393:                                     last;
                   11394:                                 }
                   11395:                             }
                   11396:                         }
                   11397:                     }
                   11398:                     my ($errtext,$fatal) = 
                   11399:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   11400:                                                '/'.$folders{$outer}.'.'.
                   11401:                                                $containers{$outer});
                   11402:                     next if ($fatal);
                   11403:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   11404:                         if ($context eq 'coursedocs') {
1.1056    raeburn  11405:                             $mapinner{$i} = time;
1.1055    raeburn  11406:                             $folders{$i} = 'default_'.$mapinner{$i};
                   11407:                             $containers{$i} = 'sequence';
                   11408:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11409:                                       $folders{$i}.'.'.$containers{$i};
                   11410:                             my $newidx = &LONCAPA::map::getresidx();
                   11411:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11412:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11413:                             push(@LONCAPA::map::order,$newidx);
                   11414:                             my ($outtext,$errtext) =
                   11415:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11416:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  11417:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  11418:                             $newseqid{$i} = $newidx;
1.1067    raeburn  11419:                             unless ($errtext) {
                   11420:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   11421:                             }
1.1055    raeburn  11422:                         }
                   11423:                     } else {
                   11424:                         if ($context eq 'coursedocs') {
                   11425:                             my $newidx=&LONCAPA::map::getresidx();
                   11426:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11427:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   11428:                                       $title;
                   11429:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   11430:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   11431:                             }
                   11432:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11433:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   11434:                             }
                   11435:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11436:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  11437:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  11438:                                 unless ($ishome) {
                   11439:                                     my $fetch = "$newdest{$i}/$title";
                   11440:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   11441:                                     $prompttofetch{$fetch} = 1;
                   11442:                                 }
1.1055    raeburn  11443:                             }
                   11444:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11445:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11446:                             push(@LONCAPA::map::order, $newidx);
                   11447:                             my ($outtext,$errtext)=
                   11448:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11449:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  11450:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  11451:                             unless ($errtext) {
                   11452:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   11453:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   11454:                                 }
                   11455:                             }
1.1055    raeburn  11456:                         }
                   11457:                     }
1.1075.2.11  raeburn  11458:                 }
                   11459:             } else {
                   11460:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
                   11461:             }
                   11462:         }
                   11463:         for (my $i=1; $i<=$numitems; $i++) {
                   11464:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   11465:             my $path = $env{'form.archive_content_'.$i};
                   11466:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11467:                 my ($title) = ($path =~ m{/([^/]+)$});
                   11468:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   11469:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   11470:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11471:                         my ($itemidx,$fullpath,$relpath);
                   11472:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   11473:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  11474:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11  raeburn  11475:                                 if ($dirorder{$i}->[$j] eq $container) {
                   11476:                                     $itemidx = $j;
1.1056    raeburn  11477:                                 }
                   11478:                             }
1.1075.2.11  raeburn  11479:                         }
                   11480:                         if ($itemidx eq '') {
                   11481:                             $itemidx =  0;
                   11482:                         }
                   11483:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   11484:                             if ($mapinner{$referrer{$i}}) {
                   11485:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   11486:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11487:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11488:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11489:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11490:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11491:                                             if (!-e $fullpath) {
                   11492:                                                 mkdir($fullpath,0755);
1.1056    raeburn  11493:                                             }
                   11494:                                         }
1.1075.2.11  raeburn  11495:                                     } else {
                   11496:                                         last;
1.1056    raeburn  11497:                                     }
1.1075.2.11  raeburn  11498:                                 }
                   11499:                             }
                   11500:                         } elsif ($newdest{$referrer{$i}}) {
                   11501:                             $fullpath = $newdest{$referrer{$i}};
                   11502:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11503:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   11504:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   11505:                                     last;
                   11506:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11507:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11508:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11509:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11510:                                         if (!-e $fullpath) {
                   11511:                                             mkdir($fullpath,0755);
1.1056    raeburn  11512:                                         }
                   11513:                                     }
1.1075.2.11  raeburn  11514:                                 } else {
                   11515:                                     last;
1.1056    raeburn  11516:                                 }
1.1075.2.11  raeburn  11517:                             }
                   11518:                         }
                   11519:                         if ($fullpath ne '') {
                   11520:                             if (-e "$prefix$path") {
                   11521:                                 system("mv $prefix$path $fullpath/$title");
                   11522:                             }
                   11523:                             if (-e "$fullpath/$title") {
                   11524:                                 my $showpath;
                   11525:                                 if ($relpath ne '') {
                   11526:                                     $showpath = "$relpath/$title";
                   11527:                                 } else {
                   11528:                                     $showpath = "/$title";
1.1056    raeburn  11529:                                 }
1.1075.2.11  raeburn  11530:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   11531:                             }
                   11532:                             unless ($ishome) {
                   11533:                                 my $fetch = "$fullpath/$title";
                   11534:                                 $fetch =~ s/^\Q$prefix$dir\E//;
                   11535:                                 $prompttofetch{$fetch} = 1;
1.1055    raeburn  11536:                             }
                   11537:                         }
                   11538:                     }
1.1075.2.11  raeburn  11539:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   11540:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   11541:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  11542:                 }
                   11543:             } else {
1.1075.2.11  raeburn  11544:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055    raeburn  11545:             }
                   11546:         }
                   11547:         if (keys(%todelete)) {
                   11548:             foreach my $key (keys(%todelete)) {
                   11549:                 unlink($key);
1.1066    raeburn  11550:             }
                   11551:         }
                   11552:         if (keys(%todeletedir)) {
                   11553:             foreach my $key (keys(%todeletedir)) {
                   11554:                 rmdir($key);
                   11555:             }
                   11556:         }
                   11557:         foreach my $dir (sort(keys(%is_dir))) {
                   11558:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   11559:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  11560:             }
                   11561:         }
1.1067    raeburn  11562:         if ($result ne '') {
                   11563:             $output .= '<ul>'."\n".
                   11564:                        $result."\n".
                   11565:                        '</ul>';
                   11566:         }
                   11567:         unless ($ishome) {
                   11568:             my $replicationfail;
                   11569:             foreach my $item (keys(%prompttofetch)) {
                   11570:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   11571:                 unless ($fetchresult eq 'ok') {
                   11572:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   11573:                 }
                   11574:             }
                   11575:             if ($replicationfail) {
                   11576:                 $output .= '<p class="LC_error">'.
                   11577:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   11578:                            $replicationfail.
                   11579:                            '</ul></p>';
                   11580:             }
                   11581:         }
1.1055    raeburn  11582:     } else {
                   11583:         $warning = &mt('No items found in archive.');
                   11584:     }
                   11585:     if ($error) {
                   11586:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11587:                    $error.'</p>'."\n";
                   11588:     }
                   11589:     if ($warning) {
                   11590:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11591:     }
                   11592:     return $output;
                   11593: }
                   11594: 
1.1066    raeburn  11595: sub cleanup_empty_dirs {
                   11596:     my ($path) = @_;
                   11597:     if (($path ne '') && (-d $path)) {
                   11598:         if (opendir(my $dirh,$path)) {
                   11599:             my @dircontents = grep(!/^\./,readdir($dirh));
                   11600:             my $numitems = 0;
                   11601:             foreach my $item (@dircontents) {
                   11602:                 if (-d "$path/$item") {
                   11603:                     &recurse_dirs("$path/$item");
                   11604:                     if (-e "$path/$item") {
                   11605:                         $numitems ++;
                   11606:                     }
                   11607:                 } else {
                   11608:                     $numitems ++;
                   11609:                 }
                   11610:             }
                   11611:             if ($numitems == 0) {
                   11612:                 rmdir($path);
                   11613:             }
                   11614:             closedir($dirh);
                   11615:         }
                   11616:     }
                   11617:     return;
                   11618: }
                   11619: 
1.41      ng       11620: =pod
1.45      matthew  11621: 
1.1068    raeburn  11622: =item &get_folder_hierarchy()
                   11623: 
                   11624: Provides hierarchy of names of folders/sub-folders containing the current
                   11625: item,
                   11626: 
                   11627: Inputs: 3
                   11628:      - $navmap - navmaps object
                   11629: 
                   11630:      - $map - url for map (either the trigger itself, or map containing
                   11631:                            the resource, which is the trigger).
                   11632: 
                   11633:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   11634: 
                   11635: Outputs: 1 @pathitems - array of folder/subfolder names.
                   11636: 
                   11637: =cut
                   11638: 
                   11639: sub get_folder_hierarchy {
                   11640:     my ($navmap,$map,$showitem) = @_;
                   11641:     my @pathitems;
                   11642:     if (ref($navmap)) {
                   11643:         my $mapres = $navmap->getResourceByUrl($map);
                   11644:         if (ref($mapres)) {
                   11645:             my $pcslist = $mapres->map_hierarchy();
                   11646:             if ($pcslist ne '') {
                   11647:                 my @pcs = split(/,/,$pcslist);
                   11648:                 foreach my $pc (@pcs) {
                   11649:                     if ($pc == 1) {
                   11650:                         push(@pathitems,&mt('Main Course Documents'));
                   11651:                     } else {
                   11652:                         my $res = $navmap->getByMapPc($pc);
                   11653:                         if (ref($res)) {
                   11654:                             my $title = $res->compTitle();
                   11655:                             $title =~ s/\W+/_/g;
                   11656:                             if ($title ne '') {
                   11657:                                 push(@pathitems,$title);
                   11658:                             }
                   11659:                         }
                   11660:                     }
                   11661:                 }
                   11662:             }
1.1071    raeburn  11663:             if ($showitem) {
                   11664:                 if ($mapres->{ID} eq '0.0') {
                   11665:                     push(@pathitems,&mt('Main Course Documents'));
                   11666:                 } else {
                   11667:                     my $maptitle = $mapres->compTitle();
                   11668:                     $maptitle =~ s/\W+/_/g;
                   11669:                     if ($maptitle ne '') {
                   11670:                         push(@pathitems,$maptitle);
                   11671:                     }
1.1068    raeburn  11672:                 }
                   11673:             }
                   11674:         }
                   11675:     }
                   11676:     return @pathitems;
                   11677: }
                   11678: 
                   11679: =pod
                   11680: 
1.1015    raeburn  11681: =item * &get_turnedin_filepath()
                   11682: 
                   11683: Determines path in a user's portfolio file for storage of files uploaded
                   11684: to a specific essayresponse or dropbox item.
                   11685: 
                   11686: Inputs: 3 required + 1 optional.
                   11687: $symb is symb for resource, $uname and $udom are for current user (required).
                   11688: $caller is optional (can be "submission", if routine is called when storing
                   11689: an upoaded file when "Submit Answer" button was pressed).
                   11690: 
                   11691: Returns array containing $path and $multiresp. 
                   11692: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   11693: than one file upload item.  Callers of routine should append partid as a 
                   11694: subdirectory to $path in cases where $multiresp is 1.
                   11695: 
                   11696: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   11697: 
                   11698: =cut
                   11699: 
                   11700: sub get_turnedin_filepath {
                   11701:     my ($symb,$uname,$udom,$caller) = @_;
                   11702:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   11703:     my $turnindir;
                   11704:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   11705:     $turnindir = $userhash{'turnindir'};
                   11706:     my ($path,$multiresp);
                   11707:     if ($turnindir eq '') {
                   11708:         if ($caller eq 'submission') {
                   11709:             $turnindir = &mt('turned in');
                   11710:             $turnindir =~ s/\W+/_/g;
                   11711:             my %newhash = (
                   11712:                             'turnindir' => $turnindir,
                   11713:                           );
                   11714:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   11715:         }
                   11716:     }
                   11717:     if ($turnindir ne '') {
                   11718:         $path = '/'.$turnindir.'/';
                   11719:         my ($multipart,$turnin,@pathitems);
                   11720:         my $navmap = Apache::lonnavmaps::navmap->new();
                   11721:         if (defined($navmap)) {
                   11722:             my $mapres = $navmap->getResourceByUrl($map);
                   11723:             if (ref($mapres)) {
                   11724:                 my $pcslist = $mapres->map_hierarchy();
                   11725:                 if ($pcslist ne '') {
                   11726:                     foreach my $pc (split(/,/,$pcslist)) {
                   11727:                         my $res = $navmap->getByMapPc($pc);
                   11728:                         if (ref($res)) {
                   11729:                             my $title = $res->compTitle();
                   11730:                             $title =~ s/\W+/_/g;
                   11731:                             if ($title ne '') {
                   11732:                                 push(@pathitems,$title);
                   11733:                             }
                   11734:                         }
                   11735:                     }
                   11736:                 }
                   11737:                 my $maptitle = $mapres->compTitle();
                   11738:                 $maptitle =~ s/\W+/_/g;
                   11739:                 if ($maptitle ne '') {
                   11740:                     push(@pathitems,$maptitle);
                   11741:                 }
                   11742:                 unless ($env{'request.state'} eq 'construct') {
                   11743:                     my $res = $navmap->getBySymb($symb);
                   11744:                     if (ref($res)) {
                   11745:                         my $partlist = $res->parts();
                   11746:                         my $totaluploads = 0;
                   11747:                         if (ref($partlist) eq 'ARRAY') {
                   11748:                             foreach my $part (@{$partlist}) {
                   11749:                                 my @types = $res->responseType($part);
                   11750:                                 my @ids = $res->responseIds($part);
                   11751:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   11752:                                     if ($types[$i] eq 'essay') {
                   11753:                                         my $partid = $part.'_'.$ids[$i];
                   11754:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   11755:                                             $totaluploads ++;
                   11756:                                         }
                   11757:                                     }
                   11758:                                 }
                   11759:                             }
                   11760:                             if ($totaluploads > 1) {
                   11761:                                 $multiresp = 1;
                   11762:                             }
                   11763:                         }
                   11764:                     }
                   11765:                 }
                   11766:             } else {
                   11767:                 return;
                   11768:             }
                   11769:         } else {
                   11770:             return;
                   11771:         }
                   11772:         my $restitle=&Apache::lonnet::gettitle($symb);
                   11773:         $restitle =~ s/\W+/_/g;
                   11774:         if ($restitle eq '') {
                   11775:             $restitle = ($resurl =~ m{/[^/]+$});
                   11776:             if ($restitle eq '') {
                   11777:                 $restitle = time;
                   11778:             }
                   11779:         }
                   11780:         push(@pathitems,$restitle);
                   11781:         $path .= join('/',@pathitems);
                   11782:     }
                   11783:     return ($path,$multiresp);
                   11784: }
                   11785: 
                   11786: =pod
                   11787: 
1.464     albertel 11788: =back
1.41      ng       11789: 
1.112     bowersj2 11790: =head1 CSV Upload/Handling functions
1.38      albertel 11791: 
1.41      ng       11792: =over 4
                   11793: 
1.648     raeburn  11794: =item * &upfile_store($r)
1.41      ng       11795: 
                   11796: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 11797: needs $env{'form.upfile'}
1.41      ng       11798: returns $datatoken to be put into hidden field
                   11799: 
                   11800: =cut
1.31      albertel 11801: 
                   11802: sub upfile_store {
                   11803:     my $r=shift;
1.258     albertel 11804:     $env{'form.upfile'}=~s/\r/\n/gs;
                   11805:     $env{'form.upfile'}=~s/\f/\n/gs;
                   11806:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   11807:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 11808: 
1.258     albertel 11809:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   11810: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 11811:     {
1.158     raeburn  11812:         my $datafile = $r->dir_config('lonDaemons').
                   11813:                            '/tmp/'.$datatoken.'.tmp';
                   11814:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 11815:             print $fh $env{'form.upfile'};
1.158     raeburn  11816:             close($fh);
                   11817:         }
1.31      albertel 11818:     }
                   11819:     return $datatoken;
                   11820: }
                   11821: 
1.56      matthew  11822: =pod
                   11823: 
1.648     raeburn  11824: =item * &load_tmp_file($r)
1.41      ng       11825: 
                   11826: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 11827: needs $env{'form.datatoken'},
                   11828: sets $env{'form.upfile'} to the contents of the file
1.41      ng       11829: 
                   11830: =cut
1.31      albertel 11831: 
                   11832: sub load_tmp_file {
                   11833:     my $r=shift;
                   11834:     my @studentdata=();
                   11835:     {
1.158     raeburn  11836:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 11837:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  11838:         if ( open(my $fh,"<$studentfile") ) {
                   11839:             @studentdata=<$fh>;
                   11840:             close($fh);
                   11841:         }
1.31      albertel 11842:     }
1.258     albertel 11843:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 11844: }
                   11845: 
1.56      matthew  11846: =pod
                   11847: 
1.648     raeburn  11848: =item * &upfile_record_sep()
1.41      ng       11849: 
                   11850: Separate uploaded file into records
                   11851: returns array of records,
1.258     albertel 11852: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       11853: 
                   11854: =cut
1.31      albertel 11855: 
                   11856: sub upfile_record_sep {
1.258     albertel 11857:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 11858:     } else {
1.248     albertel 11859: 	my @records;
1.258     albertel 11860: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 11861: 	    if ($line=~/^\s*$/) { next; }
                   11862: 	    push(@records,$line);
                   11863: 	}
                   11864: 	return @records;
1.31      albertel 11865:     }
                   11866: }
                   11867: 
1.56      matthew  11868: =pod
                   11869: 
1.648     raeburn  11870: =item * &record_sep($record)
1.41      ng       11871: 
1.258     albertel 11872: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       11873: 
                   11874: =cut
                   11875: 
1.263     www      11876: sub takeleft {
                   11877:     my $index=shift;
                   11878:     return substr('0000'.$index,-4,4);
                   11879: }
                   11880: 
1.31      albertel 11881: sub record_sep {
                   11882:     my $record=shift;
                   11883:     my %components=();
1.258     albertel 11884:     if ($env{'form.upfiletype'} eq 'xml') {
                   11885:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 11886:         my $i=0;
1.356     albertel 11887:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 11888:             $field=~s/^(\"|\')//;
                   11889:             $field=~s/(\"|\')$//;
1.263     www      11890:             $components{&takeleft($i)}=$field;
1.31      albertel 11891:             $i++;
                   11892:         }
1.258     albertel 11893:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 11894:         my $i=0;
1.356     albertel 11895:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 11896:             $field=~s/^(\"|\')//;
                   11897:             $field=~s/(\"|\')$//;
1.263     www      11898:             $components{&takeleft($i)}=$field;
1.31      albertel 11899:             $i++;
                   11900:         }
                   11901:     } else {
1.561     www      11902:         my $separator=',';
1.480     banghart 11903:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      11904:             $separator=';';
1.480     banghart 11905:         }
1.31      albertel 11906:         my $i=0;
1.561     www      11907: # the character we are looking for to indicate the end of a quote or a record 
                   11908:         my $looking_for=$separator;
                   11909: # do not add the characters to the fields
                   11910:         my $ignore=0;
                   11911: # we just encountered a separator (or the beginning of the record)
                   11912:         my $just_found_separator=1;
                   11913: # store the field we are working on here
                   11914:         my $field='';
                   11915: # work our way through all characters in record
                   11916:         foreach my $character ($record=~/(.)/g) {
                   11917:             if ($character eq $looking_for) {
                   11918:                if ($character ne $separator) {
                   11919: # Found the end of a quote, again looking for separator
                   11920:                   $looking_for=$separator;
                   11921:                   $ignore=1;
                   11922:                } else {
                   11923: # Found a separator, store away what we got
                   11924:                   $components{&takeleft($i)}=$field;
                   11925: 	          $i++;
                   11926:                   $just_found_separator=1;
                   11927:                   $ignore=0;
                   11928:                   $field='';
                   11929:                }
                   11930:                next;
                   11931:             }
                   11932: # single or double quotation marks after a separator indicate beginning of a quote
                   11933: # we are now looking for the end of the quote and need to ignore separators
                   11934:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   11935:                $looking_for=$character;
                   11936:                next;
                   11937:             }
                   11938: # ignore would be true after we reached the end of a quote
                   11939:             if ($ignore) { next; }
                   11940:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   11941:             $field.=$character;
                   11942:             $just_found_separator=0; 
1.31      albertel 11943:         }
1.561     www      11944: # catch the very last entry, since we never encountered the separator
                   11945:         $components{&takeleft($i)}=$field;
1.31      albertel 11946:     }
                   11947:     return %components;
                   11948: }
                   11949: 
1.144     matthew  11950: ######################################################
                   11951: ######################################################
                   11952: 
1.56      matthew  11953: =pod
                   11954: 
1.648     raeburn  11955: =item * &upfile_select_html()
1.41      ng       11956: 
1.144     matthew  11957: Return HTML code to select a file from the users machine and specify 
                   11958: the file type.
1.41      ng       11959: 
                   11960: =cut
                   11961: 
1.144     matthew  11962: ######################################################
                   11963: ######################################################
1.31      albertel 11964: sub upfile_select_html {
1.144     matthew  11965:     my %Types = (
                   11966:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 11967:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  11968:                  space => &mt('Space separated'),
                   11969:                  tab   => &mt('Tabulator separated'),
                   11970: #                 xml   => &mt('HTML/XML'),
                   11971:                  );
                   11972:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  11973:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  11974:     foreach my $type (sort(keys(%Types))) {
                   11975:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   11976:     }
                   11977:     $Str .= "</select>\n";
                   11978:     return $Str;
1.31      albertel 11979: }
                   11980: 
1.301     albertel 11981: sub get_samples {
                   11982:     my ($records,$toget) = @_;
                   11983:     my @samples=({});
                   11984:     my $got=0;
                   11985:     foreach my $rec (@$records) {
                   11986: 	my %temp = &record_sep($rec);
                   11987: 	if (! grep(/\S/, values(%temp))) { next; }
                   11988: 	if (%temp) {
                   11989: 	    $samples[$got]=\%temp;
                   11990: 	    $got++;
                   11991: 	    if ($got == $toget) { last; }
                   11992: 	}
                   11993:     }
                   11994:     return \@samples;
                   11995: }
                   11996: 
1.144     matthew  11997: ######################################################
                   11998: ######################################################
                   11999: 
1.56      matthew  12000: =pod
                   12001: 
1.648     raeburn  12002: =item * &csv_print_samples($r,$records)
1.41      ng       12003: 
                   12004: Prints a table of sample values from each column uploaded $r is an
                   12005: Apache Request ref, $records is an arrayref from
                   12006: &Apache::loncommon::upfile_record_sep
                   12007: 
                   12008: =cut
                   12009: 
1.144     matthew  12010: ######################################################
                   12011: ######################################################
1.31      albertel 12012: sub csv_print_samples {
                   12013:     my ($r,$records) = @_;
1.662     bisitz   12014:     my $samples = &get_samples($records,5);
1.301     albertel 12015: 
1.594     raeburn  12016:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   12017:               &start_data_table_header_row());
1.356     albertel 12018:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   12019:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  12020:     $r->print(&end_data_table_header_row());
1.301     albertel 12021:     foreach my $hash (@$samples) {
1.594     raeburn  12022: 	$r->print(&start_data_table_row());
1.356     albertel 12023: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 12024: 	    $r->print('<td>');
1.356     albertel 12025: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 12026: 	    $r->print('</td>');
                   12027: 	}
1.594     raeburn  12028: 	$r->print(&end_data_table_row());
1.31      albertel 12029:     }
1.594     raeburn  12030:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 12031: }
                   12032: 
1.144     matthew  12033: ######################################################
                   12034: ######################################################
                   12035: 
1.56      matthew  12036: =pod
                   12037: 
1.648     raeburn  12038: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       12039: 
                   12040: Prints a table to create associations between values and table columns.
1.144     matthew  12041: 
1.41      ng       12042: $r is an Apache Request ref,
                   12043: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  12044: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       12045: 
                   12046: =cut
                   12047: 
1.144     matthew  12048: ######################################################
                   12049: ######################################################
1.31      albertel 12050: sub csv_print_select_table {
                   12051:     my ($r,$records,$d) = @_;
1.301     albertel 12052:     my $i=0;
                   12053:     my $samples = &get_samples($records,1);
1.144     matthew  12054:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  12055: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  12056:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  12057:               '<th>'.&mt('Column').'</th>'.
                   12058:               &end_data_table_header_row()."\n");
1.356     albertel 12059:     foreach my $array_ref (@$d) {
                   12060: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  12061: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 12062: 
1.875     bisitz   12063: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  12064: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 12065: 	$r->print('<option value="none"></option>');
1.356     albertel 12066: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   12067: 	    $r->print('<option value="'.$sample.'"'.
                   12068:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   12069:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 12070: 	}
1.594     raeburn  12071: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 12072: 	$i++;
                   12073:     }
1.594     raeburn  12074:     $r->print(&end_data_table());
1.31      albertel 12075:     $i--;
                   12076:     return $i;
                   12077: }
1.56      matthew  12078: 
1.144     matthew  12079: ######################################################
                   12080: ######################################################
                   12081: 
1.56      matthew  12082: =pod
1.31      albertel 12083: 
1.648     raeburn  12084: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       12085: 
                   12086: Prints a table of sample values from the upload and can make associate samples to internal names.
                   12087: 
                   12088: $r is an Apache Request ref,
                   12089: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   12090: $d is an array of 2 element arrays (internal name, displayed name)
                   12091: 
                   12092: =cut
                   12093: 
1.144     matthew  12094: ######################################################
                   12095: ######################################################
1.31      albertel 12096: sub csv_samples_select_table {
                   12097:     my ($r,$records,$d) = @_;
                   12098:     my $i=0;
1.144     matthew  12099:     #
1.662     bisitz   12100:     my $max_samples = 5;
                   12101:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  12102:     $r->print(&start_data_table().
                   12103:               &start_data_table_header_row().'<th>'.
                   12104:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   12105:               &end_data_table_header_row());
1.301     albertel 12106: 
                   12107:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  12108: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  12109: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 12110: 	foreach my $option (@$d) {
                   12111: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  12112: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 12113:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  12114:                       $display.'</option>');
1.31      albertel 12115: 	}
                   12116: 	$r->print('</select></td><td>');
1.662     bisitz   12117: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 12118: 	    if (defined($samples->[$line]{$key})) { 
                   12119: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   12120: 	    }
                   12121: 	}
1.594     raeburn  12122: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 12123: 	$i++;
                   12124:     }
1.594     raeburn  12125:     $r->print(&end_data_table());
1.31      albertel 12126:     $i--;
                   12127:     return($i);
1.115     matthew  12128: }
                   12129: 
1.144     matthew  12130: ######################################################
                   12131: ######################################################
                   12132: 
1.115     matthew  12133: =pod
                   12134: 
1.648     raeburn  12135: =item * &clean_excel_name($name)
1.115     matthew  12136: 
                   12137: Returns a replacement for $name which does not contain any illegal characters.
                   12138: 
                   12139: =cut
                   12140: 
1.144     matthew  12141: ######################################################
                   12142: ######################################################
1.115     matthew  12143: sub clean_excel_name {
                   12144:     my ($name) = @_;
                   12145:     $name =~ s/[:\*\?\/\\]//g;
                   12146:     if (length($name) > 31) {
                   12147:         $name = substr($name,0,31);
                   12148:     }
                   12149:     return $name;
1.25      albertel 12150: }
1.84      albertel 12151: 
1.85      albertel 12152: =pod
                   12153: 
1.648     raeburn  12154: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 12155: 
                   12156: Returns either 1 or undef
                   12157: 
                   12158: 1 if the part is to be hidden, undef if it is to be shown
                   12159: 
                   12160: Arguments are:
                   12161: 
                   12162: $id the id of the part to be checked
                   12163: $symb, optional the symb of the resource to check
                   12164: $udom, optional the domain of the user to check for
                   12165: $uname, optional the username of the user to check for
                   12166: 
                   12167: =cut
1.84      albertel 12168: 
                   12169: sub check_if_partid_hidden {
                   12170:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 12171:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 12172: 					 $symb,$udom,$uname);
1.141     albertel 12173:     my $truth=1;
                   12174:     #if the string starts with !, then the list is the list to show not hide
                   12175:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 12176:     my @hiddenlist=split(/,/,$hiddenparts);
                   12177:     foreach my $checkid (@hiddenlist) {
1.141     albertel 12178: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 12179:     }
1.141     albertel 12180:     return !$truth;
1.84      albertel 12181: }
1.127     matthew  12182: 
1.138     matthew  12183: 
                   12184: ############################################################
                   12185: ############################################################
                   12186: 
                   12187: =pod
                   12188: 
1.157     matthew  12189: =back 
                   12190: 
1.138     matthew  12191: =head1 cgi-bin script and graphing routines
                   12192: 
1.157     matthew  12193: =over 4
                   12194: 
1.648     raeburn  12195: =item * &get_cgi_id()
1.138     matthew  12196: 
                   12197: Inputs: none
                   12198: 
                   12199: Returns an id which can be used to pass environment variables
                   12200: to various cgi-bin scripts.  These environment variables will
                   12201: be removed from the users environment after a given time by
                   12202: the routine &Apache::lonnet::transfer_profile_to_env.
                   12203: 
                   12204: =cut
                   12205: 
                   12206: ############################################################
                   12207: ############################################################
1.152     albertel 12208: my $uniq=0;
1.136     matthew  12209: sub get_cgi_id {
1.154     albertel 12210:     $uniq=($uniq+1)%100000;
1.280     albertel 12211:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  12212: }
                   12213: 
1.127     matthew  12214: ############################################################
                   12215: ############################################################
                   12216: 
                   12217: =pod
                   12218: 
1.648     raeburn  12219: =item * &DrawBarGraph()
1.127     matthew  12220: 
1.138     matthew  12221: Facilitates the plotting of data in a (stacked) bar graph.
                   12222: Puts plot definition data into the users environment in order for 
                   12223: graph.png to plot it.  Returns an <img> tag for the plot.
                   12224: The bars on the plot are labeled '1','2',...,'n'.
                   12225: 
                   12226: Inputs:
                   12227: 
                   12228: =over 4
                   12229: 
                   12230: =item $Title: string, the title of the plot
                   12231: 
                   12232: =item $xlabel: string, text describing the X-axis of the plot
                   12233: 
                   12234: =item $ylabel: string, text describing the Y-axis of the plot
                   12235: 
                   12236: =item $Max: scalar, the maximum Y value to use in the plot
                   12237: If $Max is < any data point, the graph will not be rendered.
                   12238: 
1.140     matthew  12239: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  12240: they are plotted.  If undefined, default values will be used.
                   12241: 
1.178     matthew  12242: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   12243: 
1.138     matthew  12244: =item @Values: An array of array references.  Each array reference holds data
                   12245: to be plotted in a stacked bar chart.
                   12246: 
1.239     matthew  12247: =item If the final element of @Values is a hash reference the key/value
                   12248: pairs will be added to the graph definition.
                   12249: 
1.138     matthew  12250: =back
                   12251: 
                   12252: Returns:
                   12253: 
                   12254: An <img> tag which references graph.png and the appropriate identifying
                   12255: information for the plot.
                   12256: 
1.127     matthew  12257: =cut
                   12258: 
                   12259: ############################################################
                   12260: ############################################################
1.134     matthew  12261: sub DrawBarGraph {
1.178     matthew  12262:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  12263:     #
                   12264:     if (! defined($colors)) {
                   12265:         $colors = ['#33ff00', 
                   12266:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   12267:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   12268:                   ]; 
                   12269:     }
1.228     matthew  12270:     my $extra_settings = {};
                   12271:     if (ref($Values[-1]) eq 'HASH') {
                   12272:         $extra_settings = pop(@Values);
                   12273:     }
1.127     matthew  12274:     #
1.136     matthew  12275:     my $identifier = &get_cgi_id();
                   12276:     my $id = 'cgi.'.$identifier;        
1.129     matthew  12277:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  12278:         return '';
                   12279:     }
1.225     matthew  12280:     #
                   12281:     my @Labels;
                   12282:     if (defined($labels)) {
                   12283:         @Labels = @$labels;
                   12284:     } else {
                   12285:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   12286:             push (@Labels,$i+1);
                   12287:         }
                   12288:     }
                   12289:     #
1.129     matthew  12290:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  12291:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  12292:     my %ValuesHash;
                   12293:     my $NumSets=1;
                   12294:     foreach my $array (@Values) {
                   12295:         next if (! ref($array));
1.136     matthew  12296:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  12297:             join(',',@$array);
1.129     matthew  12298:     }
1.127     matthew  12299:     #
1.136     matthew  12300:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  12301:     if ($NumBars < 3) {
                   12302:         $width = 120+$NumBars*32;
1.220     matthew  12303:         $xskip = 1;
1.225     matthew  12304:         $bar_width = 30;
                   12305:     } elsif ($NumBars < 5) {
                   12306:         $width = 120+$NumBars*20;
                   12307:         $xskip = 1;
                   12308:         $bar_width = 20;
1.220     matthew  12309:     } elsif ($NumBars < 10) {
1.136     matthew  12310:         $width = 120+$NumBars*15;
                   12311:         $xskip = 1;
                   12312:         $bar_width = 15;
                   12313:     } elsif ($NumBars <= 25) {
                   12314:         $width = 120+$NumBars*11;
                   12315:         $xskip = 5;
                   12316:         $bar_width = 8;
                   12317:     } elsif ($NumBars <= 50) {
                   12318:         $width = 120+$NumBars*8;
                   12319:         $xskip = 5;
                   12320:         $bar_width = 4;
                   12321:     } else {
                   12322:         $width = 120+$NumBars*8;
                   12323:         $xskip = 5;
                   12324:         $bar_width = 4;
                   12325:     }
                   12326:     #
1.137     matthew  12327:     $Max = 1 if ($Max < 1);
                   12328:     if ( int($Max) < $Max ) {
                   12329:         $Max++;
                   12330:         $Max = int($Max);
                   12331:     }
1.127     matthew  12332:     $Title  = '' if (! defined($Title));
                   12333:     $xlabel = '' if (! defined($xlabel));
                   12334:     $ylabel = '' if (! defined($ylabel));
1.369     www      12335:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   12336:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   12337:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  12338:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  12339:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   12340:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   12341:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   12342:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12343:     $ValuesHash{$id.'.height'}   = $height;
                   12344:     $ValuesHash{$id.'.width'}    = $width;
                   12345:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   12346:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   12347:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  12348:     #
1.228     matthew  12349:     # Deal with other parameters
                   12350:     while (my ($key,$value) = each(%$extra_settings)) {
                   12351:         $ValuesHash{$id.'.'.$key} = $value;
                   12352:     }
                   12353:     #
1.646     raeburn  12354:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  12355:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12356: }
                   12357: 
                   12358: ############################################################
                   12359: ############################################################
                   12360: 
                   12361: =pod
                   12362: 
1.648     raeburn  12363: =item * &DrawXYGraph()
1.137     matthew  12364: 
1.138     matthew  12365: Facilitates the plotting of data in an XY graph.
                   12366: Puts plot definition data into the users environment in order for 
                   12367: graph.png to plot it.  Returns an <img> tag for the plot.
                   12368: 
                   12369: Inputs:
                   12370: 
                   12371: =over 4
                   12372: 
                   12373: =item $Title: string, the title of the plot
                   12374: 
                   12375: =item $xlabel: string, text describing the X-axis of the plot
                   12376: 
                   12377: =item $ylabel: string, text describing the Y-axis of the plot
                   12378: 
                   12379: =item $Max: scalar, the maximum Y value to use in the plot
                   12380: If $Max is < any data point, the graph will not be rendered.
                   12381: 
                   12382: =item $colors: Array ref containing the hex color codes for the data to be 
                   12383: plotted in.  If undefined, default values will be used.
                   12384: 
                   12385: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12386: 
                   12387: =item $Ydata: Array ref containing Array refs.  
1.185     www      12388: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  12389: 
                   12390: =item %Values: hash indicating or overriding any default values which are 
                   12391: passed to graph.png.  
                   12392: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12393: 
                   12394: =back
                   12395: 
                   12396: Returns:
                   12397: 
                   12398: An <img> tag which references graph.png and the appropriate identifying
                   12399: information for the plot.
                   12400: 
1.137     matthew  12401: =cut
                   12402: 
                   12403: ############################################################
                   12404: ############################################################
                   12405: sub DrawXYGraph {
                   12406:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   12407:     #
                   12408:     # Create the identifier for the graph
                   12409:     my $identifier = &get_cgi_id();
                   12410:     my $id = 'cgi.'.$identifier;
                   12411:     #
                   12412:     $Title  = '' if (! defined($Title));
                   12413:     $xlabel = '' if (! defined($xlabel));
                   12414:     $ylabel = '' if (! defined($ylabel));
                   12415:     my %ValuesHash = 
                   12416:         (
1.369     www      12417:          $id.'.title'  => &escape($Title),
                   12418:          $id.'.xlabel' => &escape($xlabel),
                   12419:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  12420:          $id.'.y_max_value'=> $Max,
                   12421:          $id.'.labels'     => join(',',@$Xlabels),
                   12422:          $id.'.PlotType'   => 'XY',
                   12423:          );
                   12424:     #
                   12425:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12426:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12427:     }
                   12428:     #
                   12429:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   12430:         return '';
                   12431:     }
                   12432:     my $NumSets=1;
1.138     matthew  12433:     foreach my $array (@{$Ydata}){
1.137     matthew  12434:         next if (! ref($array));
                   12435:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   12436:     }
1.138     matthew  12437:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  12438:     #
                   12439:     # Deal with other parameters
                   12440:     while (my ($key,$value) = each(%Values)) {
                   12441:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  12442:     }
                   12443:     #
1.646     raeburn  12444:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  12445:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12446: }
                   12447: 
                   12448: ############################################################
                   12449: ############################################################
                   12450: 
                   12451: =pod
                   12452: 
1.648     raeburn  12453: =item * &DrawXYYGraph()
1.138     matthew  12454: 
                   12455: Facilitates the plotting of data in an XY graph with two Y axes.
                   12456: Puts plot definition data into the users environment in order for 
                   12457: graph.png to plot it.  Returns an <img> tag for the plot.
                   12458: 
                   12459: Inputs:
                   12460: 
                   12461: =over 4
                   12462: 
                   12463: =item $Title: string, the title of the plot
                   12464: 
                   12465: =item $xlabel: string, text describing the X-axis of the plot
                   12466: 
                   12467: =item $ylabel: string, text describing the Y-axis of the plot
                   12468: 
                   12469: =item $colors: Array ref containing the hex color codes for the data to be 
                   12470: plotted in.  If undefined, default values will be used.
                   12471: 
                   12472: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12473: 
                   12474: =item $Ydata1: The first data set
                   12475: 
                   12476: =item $Min1: The minimum value of the left Y-axis
                   12477: 
                   12478: =item $Max1: The maximum value of the left Y-axis
                   12479: 
                   12480: =item $Ydata2: The second data set
                   12481: 
                   12482: =item $Min2: The minimum value of the right Y-axis
                   12483: 
                   12484: =item $Max2: The maximum value of the left Y-axis
                   12485: 
                   12486: =item %Values: hash indicating or overriding any default values which are 
                   12487: passed to graph.png.  
                   12488: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12489: 
                   12490: =back
                   12491: 
                   12492: Returns:
                   12493: 
                   12494: An <img> tag which references graph.png and the appropriate identifying
                   12495: information for the plot.
1.136     matthew  12496: 
                   12497: =cut
                   12498: 
                   12499: ############################################################
                   12500: ############################################################
1.137     matthew  12501: sub DrawXYYGraph {
                   12502:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   12503:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  12504:     #
                   12505:     # Create the identifier for the graph
                   12506:     my $identifier = &get_cgi_id();
                   12507:     my $id = 'cgi.'.$identifier;
                   12508:     #
                   12509:     $Title  = '' if (! defined($Title));
                   12510:     $xlabel = '' if (! defined($xlabel));
                   12511:     $ylabel = '' if (! defined($ylabel));
                   12512:     my %ValuesHash = 
                   12513:         (
1.369     www      12514:          $id.'.title'  => &escape($Title),
                   12515:          $id.'.xlabel' => &escape($xlabel),
                   12516:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  12517:          $id.'.labels' => join(',',@$Xlabels),
                   12518:          $id.'.PlotType' => 'XY',
                   12519:          $id.'.NumSets' => 2,
1.137     matthew  12520:          $id.'.two_axes' => 1,
                   12521:          $id.'.y1_max_value' => $Max1,
                   12522:          $id.'.y1_min_value' => $Min1,
                   12523:          $id.'.y2_max_value' => $Max2,
                   12524:          $id.'.y2_min_value' => $Min2,
1.136     matthew  12525:          );
                   12526:     #
1.137     matthew  12527:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12528:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12529:     }
                   12530:     #
                   12531:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   12532:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  12533:         return '';
                   12534:     }
                   12535:     my $NumSets=1;
1.137     matthew  12536:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  12537:         next if (! ref($array));
                   12538:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  12539:     }
                   12540:     #
                   12541:     # Deal with other parameters
                   12542:     while (my ($key,$value) = each(%Values)) {
                   12543:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  12544:     }
                   12545:     #
1.646     raeburn  12546:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 12547:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  12548: }
                   12549: 
                   12550: ############################################################
                   12551: ############################################################
                   12552: 
                   12553: =pod
                   12554: 
1.157     matthew  12555: =back 
                   12556: 
1.139     matthew  12557: =head1 Statistics helper routines?  
                   12558: 
                   12559: Bad place for them but what the hell.
                   12560: 
1.157     matthew  12561: =over 4
                   12562: 
1.648     raeburn  12563: =item * &chartlink()
1.139     matthew  12564: 
                   12565: Returns a link to the chart for a specific student.  
                   12566: 
                   12567: Inputs:
                   12568: 
                   12569: =over 4
                   12570: 
                   12571: =item $linktext: The text of the link
                   12572: 
                   12573: =item $sname: The students username
                   12574: 
                   12575: =item $sdomain: The students domain
                   12576: 
                   12577: =back
                   12578: 
1.157     matthew  12579: =back
                   12580: 
1.139     matthew  12581: =cut
                   12582: 
                   12583: ############################################################
                   12584: ############################################################
                   12585: sub chartlink {
                   12586:     my ($linktext, $sname, $sdomain) = @_;
                   12587:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      12588:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 12589:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  12590:        '">'.$linktext.'</a>';
1.153     matthew  12591: }
                   12592: 
                   12593: #######################################################
                   12594: #######################################################
                   12595: 
                   12596: =pod
                   12597: 
                   12598: =head1 Course Environment Routines
1.157     matthew  12599: 
                   12600: =over 4
1.153     matthew  12601: 
1.648     raeburn  12602: =item * &restore_course_settings()
1.153     matthew  12603: 
1.648     raeburn  12604: =item * &store_course_settings()
1.153     matthew  12605: 
                   12606: Restores/Store indicated form parameters from the course environment.
                   12607: Will not overwrite existing values of the form parameters.
                   12608: 
                   12609: Inputs: 
                   12610: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   12611: 
                   12612: a hash ref describing the data to be stored.  For example:
                   12613:    
                   12614: %Save_Parameters = ('Status' => 'scalar',
                   12615:     'chartoutputmode' => 'scalar',
                   12616:     'chartoutputdata' => 'scalar',
                   12617:     'Section' => 'array',
1.373     raeburn  12618:     'Group' => 'array',
1.153     matthew  12619:     'StudentData' => 'array',
                   12620:     'Maps' => 'array');
                   12621: 
                   12622: Returns: both routines return nothing
                   12623: 
1.631     raeburn  12624: =back
                   12625: 
1.153     matthew  12626: =cut
                   12627: 
                   12628: #######################################################
                   12629: #######################################################
                   12630: sub store_course_settings {
1.496     albertel 12631:     return &store_settings($env{'request.course.id'},@_);
                   12632: }
                   12633: 
                   12634: sub store_settings {
1.153     matthew  12635:     # save to the environment
                   12636:     # appenv the same items, just to be safe
1.300     albertel 12637:     my $udom  = $env{'user.domain'};
                   12638:     my $uname = $env{'user.name'};
1.496     albertel 12639:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  12640:     my %SaveHash;
                   12641:     my %AppHash;
                   12642:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 12643:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 12644:         my $envname = 'environment.'.$basename;
1.258     albertel 12645:         if (exists($env{'form.'.$setting})) {
1.153     matthew  12646:             # Save this value away
                   12647:             if ($type eq 'scalar' &&
1.258     albertel 12648:                 (! exists($env{$envname}) || 
                   12649:                  $env{$envname} ne $env{'form.'.$setting})) {
                   12650:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   12651:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  12652:             } elsif ($type eq 'array') {
                   12653:                 my $stored_form;
1.258     albertel 12654:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  12655:                     $stored_form = join(',',
                   12656:                                         map {
1.369     www      12657:                                             &escape($_);
1.258     albertel 12658:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  12659:                 } else {
                   12660:                     $stored_form = 
1.369     www      12661:                         &escape($env{'form.'.$setting});
1.153     matthew  12662:                 }
                   12663:                 # Determine if the array contents are the same.
1.258     albertel 12664:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  12665:                     $SaveHash{$basename} = $stored_form;
                   12666:                     $AppHash{$envname}   = $stored_form;
                   12667:                 }
                   12668:             }
                   12669:         }
                   12670:     }
                   12671:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 12672:                                           $udom,$uname);
1.153     matthew  12673:     if ($put_result !~ /^(ok|delayed)/) {
                   12674:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   12675:                                  'got error:'.$put_result);
                   12676:     }
                   12677:     # Make sure these settings stick around in this session, too
1.646     raeburn  12678:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  12679:     return;
                   12680: }
                   12681: 
                   12682: sub restore_course_settings {
1.499     albertel 12683:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 12684: }
                   12685: 
                   12686: sub restore_settings {
                   12687:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  12688:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 12689:         next if (exists($env{'form.'.$setting}));
1.496     albertel 12690:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  12691:             '.'.$setting;
1.258     albertel 12692:         if (exists($env{$envname})) {
1.153     matthew  12693:             if ($type eq 'scalar') {
1.258     albertel 12694:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  12695:             } elsif ($type eq 'array') {
1.258     albertel 12696:                 $env{'form.'.$setting} = [ 
1.153     matthew  12697:                                            map { 
1.369     www      12698:                                                &unescape($_); 
1.258     albertel 12699:                                            } split(',',$env{$envname})
1.153     matthew  12700:                                            ];
                   12701:             }
                   12702:         }
                   12703:     }
1.127     matthew  12704: }
                   12705: 
1.618     raeburn  12706: #######################################################
                   12707: #######################################################
                   12708: 
                   12709: =pod
                   12710: 
                   12711: =head1 Domain E-mail Routines  
                   12712: 
                   12713: =over 4
                   12714: 
1.648     raeburn  12715: =item * &build_recipient_list()
1.618     raeburn  12716: 
1.884     raeburn  12717: Build recipient lists for five types of e-mail:
1.766     raeburn  12718: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884     raeburn  12719: (d) Help requests, (e) Course requests needing approval,  generated by
                   12720: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
                   12721: loncoursequeueadmin.pm respectively.
1.618     raeburn  12722: 
                   12723: Inputs:
1.619     raeburn  12724: defmail (scalar - email address of default recipient), 
1.618     raeburn  12725: mailing type (scalar - errormail, packagesmail, or helpdeskmail), 
1.619     raeburn  12726: defdom (domain for which to retrieve configuration settings),
                   12727: origmail (scalar - email address of recipient from loncapa.conf, 
                   12728: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  12729: 
1.655     raeburn  12730: Returns: comma separated list of addresses to which to send e-mail.
                   12731: 
                   12732: =back
1.618     raeburn  12733: 
                   12734: =cut
                   12735: 
                   12736: ############################################################
                   12737: ############################################################
                   12738: sub build_recipient_list {
1.619     raeburn  12739:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  12740:     my @recipients;
                   12741:     my $otheremails;
                   12742:     my %domconfig =
                   12743:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   12744:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  12745:         if (exists($domconfig{'contacts'}{$mailing})) {
                   12746:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   12747:                 my @contacts = ('adminemail','supportemail');
                   12748:                 foreach my $item (@contacts) {
                   12749:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   12750:                         my $addr = $domconfig{'contacts'}{$item}; 
                   12751:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   12752:                             push(@recipients,$addr);
                   12753:                         }
1.619     raeburn  12754:                     }
1.766     raeburn  12755:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  12756:                 }
                   12757:             }
1.766     raeburn  12758:         } elsif ($origmail ne '') {
                   12759:             push(@recipients,$origmail);
1.618     raeburn  12760:         }
1.619     raeburn  12761:     } elsif ($origmail ne '') {
                   12762:         push(@recipients,$origmail);
1.618     raeburn  12763:     }
1.688     raeburn  12764:     if (defined($defmail)) {
                   12765:         if ($defmail ne '') {
                   12766:             push(@recipients,$defmail);
                   12767:         }
1.618     raeburn  12768:     }
                   12769:     if ($otheremails) {
1.619     raeburn  12770:         my @others;
                   12771:         if ($otheremails =~ /,/) {
                   12772:             @others = split(/,/,$otheremails);
1.618     raeburn  12773:         } else {
1.619     raeburn  12774:             push(@others,$otheremails);
                   12775:         }
                   12776:         foreach my $addr (@others) {
                   12777:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   12778:                 push(@recipients,$addr);
                   12779:             }
1.618     raeburn  12780:         }
                   12781:     }
1.619     raeburn  12782:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  12783:     return $recipientlist;
                   12784: }
                   12785: 
1.127     matthew  12786: ############################################################
                   12787: ############################################################
1.154     albertel 12788: 
1.655     raeburn  12789: =pod
                   12790: 
                   12791: =head1 Course Catalog Routines
                   12792: 
                   12793: =over 4
                   12794: 
                   12795: =item * &gather_categories()
                   12796: 
                   12797: Converts category definitions - keys of categories hash stored in  
                   12798: coursecategories in configuration.db on the primary library server in a 
                   12799: domain - to an array.  Also generates javascript and idx hash used to 
                   12800: generate Domain Coordinator interface for editing Course Categories.
                   12801: 
                   12802: Inputs:
1.663     raeburn  12803: 
1.655     raeburn  12804: categories (reference to hash of category definitions).
1.663     raeburn  12805: 
1.655     raeburn  12806: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12807:       categories and subcategories).
1.663     raeburn  12808: 
1.655     raeburn  12809: idx (reference to hash of counters used in Domain Coordinator interface for 
                   12810:       editing Course Categories).
1.663     raeburn  12811: 
1.655     raeburn  12812: jsarray (reference to array of categories used to create Javascript arrays for
                   12813:          Domain Coordinator interface for editing Course Categories).
                   12814: 
                   12815: Returns: nothing
                   12816: 
                   12817: Side effects: populates cats, idx and jsarray. 
                   12818: 
                   12819: =cut
                   12820: 
                   12821: sub gather_categories {
                   12822:     my ($categories,$cats,$idx,$jsarray) = @_;
                   12823:     my %counters;
                   12824:     my $num = 0;
                   12825:     foreach my $item (keys(%{$categories})) {
                   12826:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   12827:         if ($container eq '' && $depth == 0) {
                   12828:             $cats->[$depth][$categories->{$item}] = $cat;
                   12829:         } else {
                   12830:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   12831:         }
                   12832:         my ($escitem,$tail) = split(/:/,$item,2);
                   12833:         if ($counters{$tail} eq '') {
                   12834:             $counters{$tail} = $num;
                   12835:             $num ++;
                   12836:         }
                   12837:         if (ref($idx) eq 'HASH') {
                   12838:             $idx->{$item} = $counters{$tail};
                   12839:         }
                   12840:         if (ref($jsarray) eq 'ARRAY') {
                   12841:             push(@{$jsarray->[$counters{$tail}]},$item);
                   12842:         }
                   12843:     }
                   12844:     return;
                   12845: }
                   12846: 
                   12847: =pod
                   12848: 
                   12849: =item * &extract_categories()
                   12850: 
                   12851: Used to generate breadcrumb trails for course categories.
                   12852: 
                   12853: Inputs:
1.663     raeburn  12854: 
1.655     raeburn  12855: categories (reference to hash of category definitions).
1.663     raeburn  12856: 
1.655     raeburn  12857: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12858:       categories and subcategories).
1.663     raeburn  12859: 
1.655     raeburn  12860: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  12861: 
1.655     raeburn  12862: allitems (reference to hash - key is category key 
                   12863:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  12864: 
1.655     raeburn  12865: idx (reference to hash of counters used in Domain Coordinator interface for
                   12866:       editing Course Categories).
1.663     raeburn  12867: 
1.655     raeburn  12868: jsarray (reference to array of categories used to create Javascript arrays for
                   12869:          Domain Coordinator interface for editing Course Categories).
                   12870: 
1.665     raeburn  12871: subcats (reference to hash of arrays containing all subcategories within each 
                   12872:          category, -recursive)
                   12873: 
1.655     raeburn  12874: Returns: nothing
                   12875: 
                   12876: Side effects: populates trails and allitems hash references.
                   12877: 
                   12878: =cut
                   12879: 
                   12880: sub extract_categories {
1.665     raeburn  12881:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  12882:     if (ref($categories) eq 'HASH') {
                   12883:         &gather_categories($categories,$cats,$idx,$jsarray);
                   12884:         if (ref($cats->[0]) eq 'ARRAY') {
                   12885:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   12886:                 my $name = $cats->[0][$i];
                   12887:                 my $item = &escape($name).'::0';
                   12888:                 my $trailstr;
                   12889:                 if ($name eq 'instcode') {
                   12890:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  12891:                 } elsif ($name eq 'communities') {
                   12892:                     $trailstr = &mt('Communities');
1.655     raeburn  12893:                 } else {
                   12894:                     $trailstr = $name;
                   12895:                 }
                   12896:                 if ($allitems->{$item} eq '') {
                   12897:                     push(@{$trails},$trailstr);
                   12898:                     $allitems->{$item} = scalar(@{$trails})-1;
                   12899:                 }
                   12900:                 my @parents = ($name);
                   12901:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   12902:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   12903:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  12904:                         if (ref($subcats) eq 'HASH') {
                   12905:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   12906:                         }
                   12907:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   12908:                     }
                   12909:                 } else {
                   12910:                     if (ref($subcats) eq 'HASH') {
                   12911:                         $subcats->{$item} = [];
1.655     raeburn  12912:                     }
                   12913:                 }
                   12914:             }
                   12915:         }
                   12916:     }
                   12917:     return;
                   12918: }
                   12919: 
                   12920: =pod
                   12921: 
                   12922: =item *&recurse_categories()
                   12923: 
                   12924: Recursively used to generate breadcrumb trails for course categories.
                   12925: 
                   12926: Inputs:
1.663     raeburn  12927: 
1.655     raeburn  12928: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12929:       categories and subcategories).
1.663     raeburn  12930: 
1.655     raeburn  12931: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  12932: 
                   12933: category (current course category, for which breadcrumb trail is being generated).
                   12934: 
                   12935: trails (reference to array of breadcrumb trails for each category).
                   12936: 
1.655     raeburn  12937: allitems (reference to hash - key is category key
                   12938:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  12939: 
1.655     raeburn  12940: parents (array containing containers directories for current category, 
                   12941:          back to top level). 
                   12942: 
                   12943: Returns: nothing
                   12944: 
                   12945: Side effects: populates trails and allitems hash references
                   12946: 
                   12947: =cut
                   12948: 
                   12949: sub recurse_categories {
1.665     raeburn  12950:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  12951:     my $shallower = $depth - 1;
                   12952:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   12953:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   12954:             my $name = $cats->[$depth]{$category}[$k];
                   12955:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   12956:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   12957:             if ($allitems->{$item} eq '') {
                   12958:                 push(@{$trails},$trailstr);
                   12959:                 $allitems->{$item} = scalar(@{$trails})-1;
                   12960:             }
                   12961:             my $deeper = $depth+1;
                   12962:             push(@{$parents},$category);
1.665     raeburn  12963:             if (ref($subcats) eq 'HASH') {
                   12964:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   12965:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   12966:                     my $higher;
                   12967:                     if ($j > 0) {
                   12968:                         $higher = &escape($parents->[$j]).':'.
                   12969:                                   &escape($parents->[$j-1]).':'.$j;
                   12970:                     } else {
                   12971:                         $higher = &escape($parents->[$j]).'::'.$j;
                   12972:                     }
                   12973:                     push(@{$subcats->{$higher}},$subcat);
                   12974:                 }
                   12975:             }
                   12976:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   12977:                                 $subcats);
1.655     raeburn  12978:             pop(@{$parents});
                   12979:         }
                   12980:     } else {
                   12981:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   12982:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   12983:         if ($allitems->{$item} eq '') {
                   12984:             push(@{$trails},$trailstr);
                   12985:             $allitems->{$item} = scalar(@{$trails})-1;
                   12986:         }
                   12987:     }
                   12988:     return;
                   12989: }
                   12990: 
1.663     raeburn  12991: =pod
                   12992: 
                   12993: =item *&assign_categories_table()
                   12994: 
                   12995: Create a datatable for display of hierarchical categories in a domain,
                   12996: with checkboxes to allow a course to be categorized. 
                   12997: 
                   12998: Inputs:
                   12999: 
                   13000: cathash - reference to hash of categories defined for the domain (from
                   13001:           configuration.db)
                   13002: 
                   13003: currcat - scalar with an & separated list of categories assigned to a course. 
                   13004: 
1.919     raeburn  13005: type    - scalar contains course type (Course or Community).
                   13006: 
1.663     raeburn  13007: Returns: $output (markup to be displayed) 
                   13008: 
                   13009: =cut
                   13010: 
                   13011: sub assign_categories_table {
1.919     raeburn  13012:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  13013:     my $output;
                   13014:     if (ref($cathash) eq 'HASH') {
                   13015:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   13016:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   13017:         $maxdepth = scalar(@cats);
                   13018:         if (@cats > 0) {
                   13019:             my $itemcount = 0;
                   13020:             if (ref($cats[0]) eq 'ARRAY') {
                   13021:                 my @currcategories;
                   13022:                 if ($currcat ne '') {
                   13023:                     @currcategories = split('&',$currcat);
                   13024:                 }
1.919     raeburn  13025:                 my $table;
1.663     raeburn  13026:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   13027:                     my $parent = $cats[0][$i];
1.919     raeburn  13028:                     next if ($parent eq 'instcode');
                   13029:                     if ($type eq 'Community') {
                   13030:                         next unless ($parent eq 'communities');
                   13031:                     } else {
                   13032:                         next if ($parent eq 'communities');
                   13033:                     }
1.663     raeburn  13034:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13035:                     my $item = &escape($parent).'::0';
                   13036:                     my $checked = '';
                   13037:                     if (@currcategories > 0) {
                   13038:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   13039:                             $checked = ' checked="checked"';
1.663     raeburn  13040:                         }
                   13041:                     }
1.919     raeburn  13042:                     my $parent_title = $parent;
                   13043:                     if ($parent eq 'communities') {
                   13044:                         $parent_title = &mt('Communities');
                   13045:                     }
                   13046:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   13047:                               '<input type="checkbox" name="usecategory" value="'.
                   13048:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   13049:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  13050:                     my $depth = 1;
                   13051:                     push(@path,$parent);
1.919     raeburn  13052:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  13053:                     pop(@path);
1.919     raeburn  13054:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  13055:                     $itemcount ++;
                   13056:                 }
1.919     raeburn  13057:                 if ($itemcount) {
                   13058:                     $output = &Apache::loncommon::start_data_table().
                   13059:                               $table.
                   13060:                               &Apache::loncommon::end_data_table();
                   13061:                 }
1.663     raeburn  13062:             }
                   13063:         }
                   13064:     }
                   13065:     return $output;
                   13066: }
                   13067: 
                   13068: =pod
                   13069: 
                   13070: =item *&assign_category_rows()
                   13071: 
                   13072: Create a datatable row for display of nested categories in a domain,
                   13073: with checkboxes to allow a course to be categorized,called recursively.
                   13074: 
                   13075: Inputs:
                   13076: 
                   13077: itemcount - track row number for alternating colors
                   13078: 
                   13079: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   13080:       categories and subcategories.
                   13081: 
                   13082: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   13083: 
                   13084: parent - parent of current category item
                   13085: 
                   13086: path - Array containing all categories back up through the hierarchy from the
                   13087:        current category to the top level.
                   13088: 
                   13089: currcategories - reference to array of current categories assigned to the course
                   13090: 
                   13091: Returns: $output (markup to be displayed).
                   13092: 
                   13093: =cut
                   13094: 
                   13095: sub assign_category_rows {
                   13096:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   13097:     my ($text,$name,$item,$chgstr);
                   13098:     if (ref($cats) eq 'ARRAY') {
                   13099:         my $maxdepth = scalar(@{$cats});
                   13100:         if (ref($cats->[$depth]) eq 'HASH') {
                   13101:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   13102:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   13103:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13104:                 $text .= '<td><table class="LC_datatable">';
                   13105:                 for (my $j=0; $j<$numchildren; $j++) {
                   13106:                     $name = $cats->[$depth]{$parent}[$j];
                   13107:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   13108:                     my $deeper = $depth+1;
                   13109:                     my $checked = '';
                   13110:                     if (ref($currcategories) eq 'ARRAY') {
                   13111:                         if (@{$currcategories} > 0) {
                   13112:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   13113:                                 $checked = ' checked="checked"';
1.663     raeburn  13114:                             }
                   13115:                         }
                   13116:                     }
1.664     raeburn  13117:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   13118:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  13119:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   13120:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   13121:                              '</td><td>';
1.663     raeburn  13122:                     if (ref($path) eq 'ARRAY') {
                   13123:                         push(@{$path},$name);
                   13124:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   13125:                         pop(@{$path});
                   13126:                     }
                   13127:                     $text .= '</td></tr>';
                   13128:                 }
                   13129:                 $text .= '</table></td>';
                   13130:             }
                   13131:         }
                   13132:     }
                   13133:     return $text;
                   13134: }
                   13135: 
1.655     raeburn  13136: ############################################################
                   13137: ############################################################
                   13138: 
                   13139: 
1.443     albertel 13140: sub commit_customrole {
1.664     raeburn  13141:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  13142:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 13143:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   13144:                          ($end?', ending '.localtime($end):'').': <b>'.
                   13145:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  13146:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 13147:                  '</b><br />';
                   13148:     return $output;
                   13149: }
                   13150: 
                   13151: sub commit_standardrole {
1.541     raeburn  13152:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
                   13153:     my ($output,$logmsg,$linefeed);
                   13154:     if ($context eq 'auto') {
                   13155:         $linefeed = "\n";
                   13156:     } else {
                   13157:         $linefeed = "<br />\n";
                   13158:     }  
1.443     albertel 13159:     if ($three eq 'st') {
1.541     raeburn  13160:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
                   13161:                                          $one,$two,$sec,$context);
                   13162:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  13163:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   13164:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 13165:         } else {
1.541     raeburn  13166:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 13167:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13168:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   13169:             if ($context eq 'auto') {
                   13170:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   13171:             } else {
                   13172:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   13173:                &mt('Add to classlist').': <b>ok</b>';
                   13174:             }
                   13175:             $output .= $linefeed;
1.443     albertel 13176:         }
                   13177:     } else {
                   13178:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   13179:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13180:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  13181:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  13182:         if ($context eq 'auto') {
                   13183:             $output .= $result.$linefeed;
                   13184:         } else {
                   13185:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   13186:         }
1.443     albertel 13187:     }
                   13188:     return $output;
                   13189: }
                   13190: 
                   13191: sub commit_studentrole {
1.541     raeburn  13192:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626     raeburn  13193:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  13194:     if ($context eq 'auto') {
                   13195:         $linefeed = "\n";
                   13196:     } else {
                   13197:         $linefeed = '<br />'."\n";
                   13198:     }
1.443     albertel 13199:     if (defined($one) && defined($two)) {
                   13200:         my $cid=$one.'_'.$two;
                   13201:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   13202:         my $secchange = 0;
                   13203:         my $expire_role_result;
                   13204:         my $modify_section_result;
1.628     raeburn  13205:         if ($oldsec ne '-1') { 
                   13206:             if ($oldsec ne $sec) {
1.443     albertel 13207:                 $secchange = 1;
1.628     raeburn  13208:                 my $now = time;
1.443     albertel 13209:                 my $uurl='/'.$cid;
                   13210:                 $uurl=~s/\_/\//g;
                   13211:                 if ($oldsec) {
                   13212:                     $uurl.='/'.$oldsec;
                   13213:                 }
1.626     raeburn  13214:                 $oldsecurl = $uurl;
1.628     raeburn  13215:                 $expire_role_result = 
1.652     raeburn  13216:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  13217:                 if ($env{'request.course.sec'} ne '') { 
                   13218:                     if ($expire_role_result eq 'refused') {
                   13219:                         my @roles = ('st');
                   13220:                         my @statuses = ('previous');
                   13221:                         my @roledoms = ($one);
                   13222:                         my $withsec = 1;
                   13223:                         my %roleshash = 
                   13224:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   13225:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   13226:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   13227:                             my ($oldstart,$oldend) = 
                   13228:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   13229:                             if ($oldend > 0 && $oldend <= $now) {
                   13230:                                 $expire_role_result = 'ok';
                   13231:                             }
                   13232:                         }
                   13233:                     }
                   13234:                 }
1.443     albertel 13235:                 $result = $expire_role_result;
                   13236:             }
                   13237:         }
                   13238:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652     raeburn  13239:             $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443     albertel 13240:             if ($modify_section_result =~ /^ok/) {
                   13241:                 if ($secchange == 1) {
1.628     raeburn  13242:                     if ($sec eq '') {
                   13243:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   13244:                     } else {
                   13245:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   13246:                     }
1.443     albertel 13247:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  13248:                     if ($sec eq '') {
                   13249:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   13250:                     } else {
                   13251:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13252:                     }
1.443     albertel 13253:                 } else {
1.628     raeburn  13254:                     if ($sec eq '') {
                   13255:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   13256:                     } else {
                   13257:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13258:                     }
1.443     albertel 13259:                 }
                   13260:             } else {
1.628     raeburn  13261:                 if ($secchange) {       
                   13262:                     $$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;
                   13263:                 } else {
                   13264:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   13265:                 }
1.443     albertel 13266:             }
                   13267:             $result = $modify_section_result;
                   13268:         } elsif ($secchange == 1) {
1.628     raeburn  13269:             if ($oldsec eq '') {
1.1075.2.20  raeburn  13270:                 $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_2] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
1.628     raeburn  13271:             } else {
                   13272:                 $$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;
                   13273:             }
1.626     raeburn  13274:             if ($expire_role_result eq 'refused') {
                   13275:                 my $newsecurl = '/'.$cid;
                   13276:                 $newsecurl =~ s/\_/\//g;
                   13277:                 if ($sec ne '') {
                   13278:                     $newsecurl.='/'.$sec;
                   13279:                 }
                   13280:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   13281:                     if ($sec eq '') {
                   13282:                         $$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;
                   13283:                     } else {
                   13284:                         $$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;
                   13285:                     }
                   13286:                 }
                   13287:             }
1.443     albertel 13288:         }
                   13289:     } else {
1.626     raeburn  13290:         $$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 13291:         $result = "error: incomplete course id\n";
                   13292:     }
                   13293:     return $result;
                   13294: }
                   13295: 
                   13296: ############################################################
                   13297: ############################################################
                   13298: 
1.566     albertel 13299: sub check_clone {
1.578     raeburn  13300:     my ($args,$linefeed) = @_;
1.566     albertel 13301:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   13302:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   13303:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   13304:     my $clonemsg;
                   13305:     my $can_clone = 0;
1.944     raeburn  13306:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  13307:     if ($lctype ne 'community') {
                   13308:         $lctype = 'course';
                   13309:     }
1.566     albertel 13310:     if ($clonehome eq 'no_host') {
1.944     raeburn  13311:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13312:             $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'});
                   13313:         } else {
                   13314:             $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'});
                   13315:         }     
1.566     albertel 13316:     } else {
                   13317: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  13318:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13319:             if ($clonedesc{'type'} ne 'Community') {
                   13320:                  $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'});
                   13321:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13322:             }
                   13323:         }
1.882     raeburn  13324: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   13325:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 13326: 	    $can_clone = 1;
                   13327: 	} else {
                   13328: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   13329: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   13330: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  13331:             if (grep(/^\*$/,@cloners)) {
                   13332:                 $can_clone = 1;
                   13333:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   13334:                 $can_clone = 1;
                   13335:             } else {
1.908     raeburn  13336:                 my $ccrole = 'cc';
1.944     raeburn  13337:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13338:                     $ccrole = 'co';
                   13339:                 }
1.578     raeburn  13340: 	        my %roleshash =
                   13341: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   13342: 					 $args->{'ccdomain'},
1.908     raeburn  13343:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  13344: 					 [$args->{'clonedomain'}]);
1.908     raeburn  13345: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  13346:                     $can_clone = 1;
                   13347:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   13348:                     $can_clone = 1;
                   13349:                 } else {
1.944     raeburn  13350:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13351:                         $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'});
                   13352:                     } else {
                   13353:                         $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'});
                   13354:                     }
1.578     raeburn  13355: 	        }
1.566     albertel 13356: 	    }
1.578     raeburn  13357:         }
1.566     albertel 13358:     }
                   13359:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13360: }
                   13361: 
1.444     albertel 13362: sub construct_course {
1.885     raeburn  13363:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444     albertel 13364:     my $outcome;
1.541     raeburn  13365:     my $linefeed =  '<br />'."\n";
                   13366:     if ($context eq 'auto') {
                   13367:         $linefeed = "\n";
                   13368:     }
1.566     albertel 13369: 
                   13370: #
                   13371: # Are we cloning?
                   13372: #
                   13373:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13374:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  13375: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 13376: 	if ($context ne 'auto') {
1.578     raeburn  13377:             if ($clonemsg ne '') {
                   13378: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   13379:             }
1.566     albertel 13380: 	}
                   13381: 	$outcome .= $clonemsg.$linefeed;
                   13382: 
                   13383:         if (!$can_clone) {
                   13384: 	    return (0,$outcome);
                   13385: 	}
                   13386:     }
                   13387: 
1.444     albertel 13388: #
                   13389: # Open course
                   13390: #
                   13391:     my $crstype = lc($args->{'crstype'});
                   13392:     my %cenv=();
                   13393:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   13394:                                              $args->{'cdescr'},
                   13395:                                              $args->{'curl'},
                   13396:                                              $args->{'course_home'},
                   13397:                                              $args->{'nonstandard'},
                   13398:                                              $args->{'crscode'},
                   13399:                                              $args->{'ccuname'}.':'.
                   13400:                                              $args->{'ccdomain'},
1.882     raeburn  13401:                                              $args->{'crstype'},
1.885     raeburn  13402:                                              $cnum,$context,$category);
1.444     albertel 13403: 
                   13404:     # Note: The testing routines depend on this being output; see 
                   13405:     # Utils::Course. This needs to at least be output as a comment
                   13406:     # if anyone ever decides to not show this, and Utils::Course::new
                   13407:     # will need to be suitably modified.
1.541     raeburn  13408:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  13409:     if ($$courseid =~ /^error:/) {
                   13410:         return (0,$outcome);
                   13411:     }
                   13412: 
1.444     albertel 13413: #
                   13414: # Check if created correctly
                   13415: #
1.479     albertel 13416:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 13417:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  13418:     if ($crsuhome eq 'no_host') {
                   13419:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   13420:         return (0,$outcome);
                   13421:     }
1.541     raeburn  13422:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 13423: 
1.444     albertel 13424: #
1.566     albertel 13425: # Do the cloning
                   13426: #   
                   13427:     if ($can_clone && $cloneid) {
                   13428: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   13429: 	if ($context ne 'auto') {
                   13430: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   13431: 	}
                   13432: 	$outcome .= $clonemsg.$linefeed;
                   13433: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 13434: # Copy all files
1.637     www      13435: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 13436: # Restore URL
1.566     albertel 13437: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 13438: # Restore title
1.566     albertel 13439: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  13440: # Restore creation date, creator and creation context.
                   13441:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   13442:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   13443:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 13444: # Mark as cloned
1.566     albertel 13445: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      13446: # Need to clone grading mode
                   13447:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   13448:         $cenv{'grading'}=$newenv{'grading'};
                   13449: # Do not clone these environment entries
                   13450:         &Apache::lonnet::del('environment',
                   13451:                   ['default_enrollment_start_date',
                   13452:                    'default_enrollment_end_date',
                   13453:                    'question.email',
                   13454:                    'policy.email',
                   13455:                    'comment.email',
                   13456:                    'pch.users.denied',
1.725     raeburn  13457:                    'plc.users.denied',
                   13458:                    'hidefromcat',
                   13459:                    'categories'],
1.638     www      13460:                    $$crsudom,$$crsunum);
1.444     albertel 13461:     }
1.566     albertel 13462: 
1.444     albertel 13463: #
                   13464: # Set environment (will override cloned, if existing)
                   13465: #
                   13466:     my @sections = ();
                   13467:     my @xlists = ();
                   13468:     if ($args->{'crstype'}) {
                   13469:         $cenv{'type'}=$args->{'crstype'};
                   13470:     }
                   13471:     if ($args->{'crsid'}) {
                   13472:         $cenv{'courseid'}=$args->{'crsid'};
                   13473:     }
                   13474:     if ($args->{'crscode'}) {
                   13475:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   13476:     }
                   13477:     if ($args->{'crsquota'} ne '') {
                   13478:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   13479:     } else {
                   13480:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   13481:     }
                   13482:     if ($args->{'ccuname'}) {
                   13483:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   13484:                                         ':'.$args->{'ccdomain'};
                   13485:     } else {
                   13486:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   13487:     }
                   13488:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   13489:     if ($args->{'crssections'}) {
                   13490:         $cenv{'internal.sectionnums'} = '';
                   13491:         if ($args->{'crssections'} =~ m/,/) {
                   13492:             @sections = split/,/,$args->{'crssections'};
                   13493:         } else {
                   13494:             $sections[0] = $args->{'crssections'};
                   13495:         }
                   13496:         if (@sections > 0) {
                   13497:             foreach my $item (@sections) {
                   13498:                 my ($sec,$gp) = split/:/,$item;
                   13499:                 my $class = $args->{'crscode'}.$sec;
                   13500:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   13501:                 $cenv{'internal.sectionnums'} .= $item.',';
                   13502:                 unless ($addcheck eq 'ok') {
                   13503:                     push @badclasses, $class;
                   13504:                 }
                   13505:             }
                   13506:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   13507:         }
                   13508:     }
                   13509: # do not hide course coordinator from staff listing, 
                   13510: # even if privileged
                   13511:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13512: # add crosslistings
                   13513:     if ($args->{'crsxlist'}) {
                   13514:         $cenv{'internal.crosslistings'}='';
                   13515:         if ($args->{'crsxlist'} =~ m/,/) {
                   13516:             @xlists = split/,/,$args->{'crsxlist'};
                   13517:         } else {
                   13518:             $xlists[0] = $args->{'crsxlist'};
                   13519:         }
                   13520:         if (@xlists > 0) {
                   13521:             foreach my $item (@xlists) {
                   13522:                 my ($xl,$gp) = split/:/,$item;
                   13523:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   13524:                 $cenv{'internal.crosslistings'} .= $item.',';
                   13525:                 unless ($addcheck eq 'ok') {
                   13526:                     push @badclasses, $xl;
                   13527:                 }
                   13528:             }
                   13529:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   13530:         }
                   13531:     }
                   13532:     if ($args->{'autoadds'}) {
                   13533:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   13534:     }
                   13535:     if ($args->{'autodrops'}) {
                   13536:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   13537:     }
                   13538: # check for notification of enrollment changes
                   13539:     my @notified = ();
                   13540:     if ($args->{'notify_owner'}) {
                   13541:         if ($args->{'ccuname'} ne '') {
                   13542:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   13543:         }
                   13544:     }
                   13545:     if ($args->{'notify_dc'}) {
                   13546:         if ($uname ne '') { 
1.630     raeburn  13547:             push(@notified,$uname.':'.$udom);
1.444     albertel 13548:         }
                   13549:     }
                   13550:     if (@notified > 0) {
                   13551:         my $notifylist;
                   13552:         if (@notified > 1) {
                   13553:             $notifylist = join(',',@notified);
                   13554:         } else {
                   13555:             $notifylist = $notified[0];
                   13556:         }
                   13557:         $cenv{'internal.notifylist'} = $notifylist;
                   13558:     }
                   13559:     if (@badclasses > 0) {
                   13560:         my %lt=&Apache::lonlocal::texthash(
                   13561:                 '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',
                   13562:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   13563:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   13564:         );
1.541     raeburn  13565:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   13566:                            ' ('.$lt{'adby'}.')';
                   13567:         if ($context eq 'auto') {
                   13568:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 13569:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  13570:             foreach my $item (@badclasses) {
                   13571:                 if ($context eq 'auto') {
                   13572:                     $outcome .= " - $item\n";
                   13573:                 } else {
                   13574:                     $outcome .= "<li>$item</li>\n";
                   13575:                 }
                   13576:             }
                   13577:             if ($context eq 'auto') {
                   13578:                 $outcome .= $linefeed;
                   13579:             } else {
1.566     albertel 13580:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  13581:             }
                   13582:         } 
1.444     albertel 13583:     }
                   13584:     if ($args->{'no_end_date'}) {
                   13585:         $args->{'endaccess'} = 0;
                   13586:     }
                   13587:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   13588:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   13589:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   13590:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   13591:     if ($args->{'showphotos'}) {
                   13592:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   13593:     }
                   13594:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   13595:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   13596:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   13597:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  13598:             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'); 
                   13599:             if ($context eq 'auto') {
                   13600:                 $outcome .= $krb_msg;
                   13601:             } else {
1.566     albertel 13602:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  13603:             }
                   13604:             $outcome .= $linefeed;
1.444     albertel 13605:         }
                   13606:     }
                   13607:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   13608:        if ($args->{'setpolicy'}) {
                   13609:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13610:        }
                   13611:        if ($args->{'setcontent'}) {
                   13612:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13613:        }
                   13614:     }
                   13615:     if ($args->{'reshome'}) {
                   13616: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   13617: 	$cenv{'reshome'}=~s/\/+$/\//;
                   13618:     }
                   13619: #
                   13620: # course has keyed access
                   13621: #
                   13622:     if ($args->{'setkeys'}) {
                   13623:        $cenv{'keyaccess'}='yes';
                   13624:     }
                   13625: # if specified, key authority is not course, but user
                   13626: # only active if keyaccess is yes
                   13627:     if ($args->{'keyauth'}) {
1.487     albertel 13628: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   13629: 	$user = &LONCAPA::clean_username($user);
                   13630: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     13631: 	if ($user ne '' && $domain ne '') {
1.487     albertel 13632: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 13633: 	}
                   13634:     }
                   13635: 
                   13636:     if ($args->{'disresdis'}) {
                   13637:         $cenv{'pch.roles.denied'}='st';
                   13638:     }
                   13639:     if ($args->{'disablechat'}) {
                   13640:         $cenv{'plc.roles.denied'}='st';
                   13641:     }
                   13642: 
                   13643:     # Record we've not yet viewed the Course Initialization Helper for this 
                   13644:     # course
                   13645:     $cenv{'course.helper.not.run'} = 1;
                   13646:     #
                   13647:     # Use new Randomseed
                   13648:     #
                   13649:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   13650:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   13651:     #
                   13652:     # The encryption code and receipt prefix for this course
                   13653:     #
                   13654:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   13655:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   13656:     #
                   13657:     # By default, use standard grading
                   13658:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   13659: 
1.541     raeburn  13660:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   13661:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 13662: #
                   13663: # Open all assignments
                   13664: #
                   13665:     if ($args->{'openall'}) {
                   13666:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   13667:        my %storecontent = ($storeunder         => time,
                   13668:                            $storeunder.'.type' => 'date_start');
                   13669:        
                   13670:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  13671:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 13672:    }
                   13673: #
                   13674: # Set first page
                   13675: #
                   13676:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   13677: 	    || ($cloneid)) {
1.445     albertel 13678: 	use LONCAPA::map;
1.444     albertel 13679: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 13680: 
                   13681: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   13682:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   13683: 
1.444     albertel 13684:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   13685:         my $title; my $url;
                   13686:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   13687: 	    $title=&mt('Syllabus');
1.444     albertel 13688:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   13689:         } else {
1.963     raeburn  13690:             $title=&mt('Table of Contents');
1.444     albertel 13691:             $url='/adm/navmaps';
                   13692:         }
1.445     albertel 13693: 
                   13694:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   13695: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   13696: 
                   13697: 	if ($errtext) { $fatal=2; }
1.541     raeburn  13698:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 13699:     }
1.566     albertel 13700: 
                   13701:     return (1,$outcome);
1.444     albertel 13702: }
                   13703: 
                   13704: ############################################################
                   13705: ############################################################
                   13706: 
1.953     droeschl 13707: #SD
                   13708: # only Community and Course, or anything else?
1.378     raeburn  13709: sub course_type {
                   13710:     my ($cid) = @_;
                   13711:     if (!defined($cid)) {
                   13712:         $cid = $env{'request.course.id'};
                   13713:     }
1.404     albertel 13714:     if (defined($env{'course.'.$cid.'.type'})) {
                   13715:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  13716:     } else {
                   13717:         return 'Course';
1.377     raeburn  13718:     }
                   13719: }
1.156     albertel 13720: 
1.406     raeburn  13721: sub group_term {
                   13722:     my $crstype = &course_type();
                   13723:     my %names = (
                   13724:                   'Course' => 'group',
1.865     raeburn  13725:                   'Community' => 'group',
1.406     raeburn  13726:                 );
                   13727:     return $names{$crstype};
                   13728: }
                   13729: 
1.902     raeburn  13730: sub course_types {
                   13731:     my @types = ('official','unofficial','community');
                   13732:     my %typename = (
                   13733:                          official   => 'Official course',
                   13734:                          unofficial => 'Unofficial course',
                   13735:                          community  => 'Community',
                   13736:                    );
                   13737:     return (\@types,\%typename);
                   13738: }
                   13739: 
1.156     albertel 13740: sub icon {
                   13741:     my ($file)=@_;
1.505     albertel 13742:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 13743:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 13744:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 13745:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   13746: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   13747: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   13748: 	            $curfext.".gif") {
                   13749: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   13750: 		$curfext.".gif";
                   13751: 	}
                   13752:     }
1.249     albertel 13753:     return &lonhttpdurl($iconname);
1.154     albertel 13754: } 
1.84      albertel 13755: 
1.575     albertel 13756: sub lonhttpdurl {
1.692     www      13757: #
                   13758: # Had been used for "small fry" static images on separate port 8080.
                   13759: # Modify here if lightweight http functionality desired again.
                   13760: # Currently eliminated due to increasing firewall issues.
                   13761: #
1.575     albertel 13762:     my ($url)=@_;
1.692     www      13763:     return $url;
1.215     albertel 13764: }
                   13765: 
1.213     albertel 13766: sub connection_aborted {
                   13767:     my ($r)=@_;
                   13768:     $r->print(" ");$r->rflush();
                   13769:     my $c = $r->connection;
                   13770:     return $c->aborted();
                   13771: }
                   13772: 
1.221     foxr     13773: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     13774: #    strings as 'strings'.
                   13775: sub escape_single {
1.221     foxr     13776:     my ($input) = @_;
1.223     albertel 13777:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     13778:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   13779:     return $input;
                   13780: }
1.223     albertel 13781: 
1.222     foxr     13782: #  Same as escape_single, but escape's "'s  This 
                   13783: #  can be used for  "strings"
                   13784: sub escape_double {
                   13785:     my ($input) = @_;
                   13786:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   13787:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   13788:     return $input;
                   13789: }
1.223     albertel 13790:  
1.222     foxr     13791: #   Escapes the last element of a full URL.
                   13792: sub escape_url {
                   13793:     my ($url)   = @_;
1.238     raeburn  13794:     my @urlslices = split(/\//, $url,-1);
1.369     www      13795:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 13796:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     13797: }
1.462     albertel 13798: 
1.820     raeburn  13799: sub compare_arrays {
                   13800:     my ($arrayref1,$arrayref2) = @_;
                   13801:     my (@difference,%count);
                   13802:     @difference = ();
                   13803:     %count = ();
                   13804:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   13805:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   13806:         foreach my $element (keys(%count)) {
                   13807:             if ($count{$element} == 1) {
                   13808:                 push(@difference,$element);
                   13809:             }
                   13810:         }
                   13811:     }
                   13812:     return @difference;
                   13813: }
                   13814: 
1.817     bisitz   13815: # -------------------------------------------------------- Initialize user login
1.462     albertel 13816: sub init_user_environment {
1.463     albertel 13817:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 13818:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   13819: 
                   13820:     my $public=($username eq 'public' && $domain eq 'public');
                   13821: 
                   13822: # See if old ID present, if so, remove
                   13823: 
1.1062    raeburn  13824:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 13825:     my $now=time;
                   13826: 
                   13827:     if ($public) {
                   13828: 	my $max_public=100;
                   13829: 	my $oldest;
                   13830: 	my $oldest_time=0;
                   13831: 	for(my $next=1;$next<=$max_public;$next++) {
                   13832: 	    if (-e $lonids."/publicuser_$next.id") {
                   13833: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   13834: 		if ($mtime<$oldest_time || !$oldest_time) {
                   13835: 		    $oldest_time=$mtime;
                   13836: 		    $oldest=$next;
                   13837: 		}
                   13838: 	    } else {
                   13839: 		$cookie="publicuser_$next";
                   13840: 		last;
                   13841: 	    }
                   13842: 	}
                   13843: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   13844:     } else {
1.463     albertel 13845: 	# if this isn't a robot, kill any existing non-robot sessions
                   13846: 	if (!$args->{'robot'}) {
                   13847: 	    opendir(DIR,$lonids);
                   13848: 	    while ($filename=readdir(DIR)) {
                   13849: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   13850: 		    unlink($lonids.'/'.$filename);
                   13851: 		}
1.462     albertel 13852: 	    }
1.463     albertel 13853: 	    closedir(DIR);
1.462     albertel 13854: 	}
                   13855: # Give them a new cookie
1.463     albertel 13856: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      13857: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 13858: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 13859:     
                   13860: # Initialize roles
                   13861: 
1.1062    raeburn  13862: 	($userroles,$firstaccenv,$timerintenv) = 
                   13863:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 13864:     }
                   13865: # ------------------------------------ Check browser type and MathML capability
                   13866: 
                   13867:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   13868:         $clientunicode,$clientos) = &decode_user_agent($r);
                   13869: 
                   13870: # ------------------------------------------------------------- Get environment
                   13871: 
                   13872:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   13873:     my ($tmp) = keys(%userenv);
                   13874:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   13875:     } else {
                   13876: 	undef(%userenv);
                   13877:     }
                   13878:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   13879: 	$form->{'interface'}=$userenv{'interface'};
                   13880:     }
                   13881:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   13882: 
                   13883: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   13884:     foreach my $option ('interface','localpath','localres') {
                   13885:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 13886:     }
                   13887: # --------------------------------------------------------- Write first profile
                   13888: 
                   13889:     {
                   13890: 	my %initial_env = 
                   13891: 	    ("user.name"          => $username,
                   13892: 	     "user.domain"        => $domain,
                   13893: 	     "user.home"          => $authhost,
                   13894: 	     "browser.type"       => $clientbrowser,
                   13895: 	     "browser.version"    => $clientversion,
                   13896: 	     "browser.mathml"     => $clientmathml,
                   13897: 	     "browser.unicode"    => $clientunicode,
                   13898: 	     "browser.os"         => $clientos,
                   13899: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   13900: 	     "request.course.fn"  => '',
                   13901: 	     "request.course.uri" => '',
                   13902: 	     "request.course.sec" => '',
                   13903: 	     "request.role"       => 'cm',
                   13904: 	     "request.role.adv"   => $env{'user.adv'},
                   13905: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   13906: 
                   13907:         if ($form->{'localpath'}) {
                   13908: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   13909: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   13910:         }
                   13911: 	
                   13912: 	if ($form->{'interface'}) {
                   13913: 	    $form->{'interface'}=~s/\W//gs;
                   13914: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   13915: 	    $env{'browser.interface'}=$form->{'interface'};
                   13916: 	}
                   13917: 
1.981     raeburn  13918:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  13919:         my %domdef;
                   13920:         unless ($domain eq 'public') {
                   13921:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   13922:         }
1.980     raeburn  13923: 
1.1075.2.7  raeburn  13924:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  13925:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  13926:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   13927:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  13928:         }
                   13929: 
1.864     raeburn  13930:         foreach my $crstype ('official','unofficial','community') {
1.765     raeburn  13931:             $userenv{'canrequest.'.$crstype} =
                   13932:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  13933:                                                   'reload','requestcourses',
                   13934:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  13935:         }
                   13936: 
1.1075.2.14  raeburn  13937:         $userenv{'canrequest.author'} =
                   13938:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   13939:                                         'reload','requestauthor',
                   13940:                                         \%userenv,\%domdef,\%is_adv);
                   13941:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   13942:                                              $domain,$username);
                   13943:         my $reqstatus = $reqauthor{'author_status'};
                   13944:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
                   13945:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   13946:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   13947:                                                   $reqauthor{'author'}{'timestamp'};
                   13948:             }
                   13949:         }
                   13950: 
1.462     albertel 13951: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  13952: 
1.462     albertel 13953: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   13954: 		 &GDBM_WRCREAT(),0640)) {
                   13955: 	    &_add_to_env(\%disk_env,\%initial_env);
                   13956: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   13957: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  13958:             if (ref($firstaccenv) eq 'HASH') {
                   13959:                 &_add_to_env(\%disk_env,$firstaccenv);
                   13960:             }
                   13961:             if (ref($timerintenv) eq 'HASH') {
                   13962:                 &_add_to_env(\%disk_env,$timerintenv);
                   13963:             }
1.463     albertel 13964: 	    if (ref($args->{'extra_env'})) {
                   13965: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   13966: 	    }
1.462     albertel 13967: 	    untie(%disk_env);
                   13968: 	} else {
1.705     tempelho 13969: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   13970: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 13971: 	    return 'error: '.$!;
                   13972: 	}
                   13973:     }
                   13974:     $env{'request.role'}='cm';
                   13975:     $env{'request.role.adv'}=$env{'user.adv'};
                   13976:     $env{'browser.type'}=$clientbrowser;
                   13977: 
                   13978:     return $cookie;
                   13979: 
                   13980: }
                   13981: 
                   13982: sub _add_to_env {
                   13983:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  13984:     if (ref($env_data) eq 'HASH') {
                   13985:         while (my ($key,$value) = each(%$env_data)) {
                   13986: 	    $idf->{$prefix.$key} = $value;
                   13987: 	    $env{$prefix.$key}   = $value;
                   13988:         }
1.462     albertel 13989:     }
                   13990: }
                   13991: 
1.685     tempelho 13992: # --- Get the symbolic name of a problem and the url
                   13993: sub get_symb {
                   13994:     my ($request,$silent) = @_;
1.726     raeburn  13995:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 13996:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   13997:     if ($symb eq '') {
                   13998:         if (!$silent) {
1.1071    raeburn  13999:             if (ref($request)) { 
                   14000:                 $request->print("Unable to handle ambiguous references:$url:.");
                   14001:             }
1.685     tempelho 14002:             return ();
                   14003:         }
                   14004:     }
                   14005:     &Apache::lonenc::check_decrypt(\$symb);
                   14006:     return ($symb);
                   14007: }
                   14008: 
                   14009: # --------------------------------------------------------------Get annotation
                   14010: 
                   14011: sub get_annotation {
                   14012:     my ($symb,$enc) = @_;
                   14013: 
                   14014:     my $key = $symb;
                   14015:     if (!$enc) {
                   14016:         $key =
                   14017:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   14018:     }
                   14019:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   14020:     return $annotation{$key};
                   14021: }
                   14022: 
                   14023: sub clean_symb {
1.731     raeburn  14024:     my ($symb,$delete_enc) = @_;
1.685     tempelho 14025: 
                   14026:     &Apache::lonenc::check_decrypt(\$symb);
                   14027:     my $enc = $env{'request.enc'};
1.731     raeburn  14028:     if ($delete_enc) {
1.730     raeburn  14029:         delete($env{'request.enc'});
                   14030:     }
1.685     tempelho 14031: 
                   14032:     return ($symb,$enc);
                   14033: }
1.462     albertel 14034: 
1.990     raeburn  14035: sub build_release_hashes {
                   14036:     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
                   14037:     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
                   14038:                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                   14039:                   (ref($randomizetry) eq 'HASH'));
                   14040:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   14041:         my ($item,$name,$value) = split(/:/,$key);
                   14042:         if ($item eq 'parameter') {
                   14043:             if (ref($checkparms->{$name}) eq 'ARRAY') {
                   14044:                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
                   14045:                     push(@{$checkparms->{$name}},$value);
                   14046:                 }
                   14047:             } else {
                   14048:                 push(@{$checkparms->{$name}},$value);
                   14049:             }
                   14050:         } elsif ($item eq 'resourcetag') {
                   14051:             if ($name eq 'responsetype') {
                   14052:                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
                   14053:             }
                   14054:         } elsif ($item eq 'course') {
                   14055:             if ($name eq 'crstype') {
                   14056:                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
                   14057:             }
                   14058:         }
                   14059:     }
                   14060:     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
                   14061:     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
                   14062:     return;
                   14063: }
                   14064: 
1.1075.2.11  raeburn  14065: sub update_content_constraints {
                   14066:     my ($cdom,$cnum,$chome,$cid) = @_;
                   14067:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   14068:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   14069:     my %checkresponsetypes;
                   14070:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   14071:         my ($item,$name,$value) = split(/:/,$key);
                   14072:         if ($item eq 'resourcetag') {
                   14073:             if ($name eq 'responsetype') {
                   14074:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   14075:             }
                   14076:         }
                   14077:     }
                   14078:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14079:     if (defined($navmap)) {
                   14080:         my %allresponses;
                   14081:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   14082:             my %responses = $res->responseTypes();
                   14083:             foreach my $key (keys(%responses)) {
                   14084:                 next unless(exists($checkresponsetypes{$key}));
                   14085:                 $allresponses{$key} += $responses{$key};
                   14086:             }
                   14087:         }
                   14088:         foreach my $key (keys(%allresponses)) {
                   14089:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   14090:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   14091:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   14092:             }
                   14093:         }
                   14094:         undef($navmap);
                   14095:     }
                   14096:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   14097:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   14098:     }
                   14099:     return;
                   14100: }
                   14101: 
                   14102: sub parse_supplemental_title {
                   14103:     my ($title) = @_;
                   14104: 
                   14105:     my ($foldertitle,$renametitle);
                   14106:     if ($title =~ /&amp;&amp;&amp;/) {
                   14107:         $title = &HTML::Entites::decode($title);
                   14108:     }
                   14109:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   14110:         $renametitle=$4;
                   14111:         my ($time,$uname,$udom) = ($1,$2,$3);
                   14112:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   14113:         my $name =  &plainname($uname,$udom);
                   14114:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   14115:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   14116:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   14117:             $name.': <br />'.$foldertitle;
                   14118:     }
                   14119:     if (wantarray) {
                   14120:         return ($title,$foldertitle,$renametitle);
                   14121:     }
                   14122:     return $title;
                   14123: }
                   14124: 
1.1075.2.18  raeburn  14125: sub symb_to_docspath {
                   14126:     my ($symb) = @_;
                   14127:     return unless ($symb);
                   14128:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   14129:     if ($resurl=~/\.(sequence|page)$/) {
                   14130:         $mapurl=$resurl;
                   14131:     } elsif ($resurl eq 'adm/navmaps') {
                   14132:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   14133:     }
                   14134:     my $mapresobj;
                   14135:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14136:     if (ref($navmap)) {
                   14137:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   14138:     }
                   14139:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   14140:     my $type=$2;
                   14141:     my $path;
                   14142:     if (ref($mapresobj)) {
                   14143:         my $pcslist = $mapresobj->map_hierarchy();
                   14144:         if ($pcslist ne '') {
                   14145:             foreach my $pc (split(/,/,$pcslist)) {
                   14146:                 next if ($pc <= 1);
                   14147:                 my $res = $navmap->getByMapPc($pc);
                   14148:                 if (ref($res)) {
                   14149:                     my $thisurl = $res->src();
                   14150:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   14151:                     my $thistitle = $res->title();
                   14152:                     $path .= '&'.
                   14153:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
                   14154:                              &Apache::lonhtmlcommon::entity_encode($thistitle).
                   14155:                              ':'.$res->randompick().
                   14156:                              ':'.$res->randomout().
                   14157:                              ':'.$res->encrypted().
                   14158:                              ':'.$res->randomorder().
                   14159:                              ':'.$res->is_page();
                   14160:                 }
                   14161:             }
                   14162:         }
                   14163:         $path =~ s/^\&//;
                   14164:         my $maptitle = $mapresobj->title();
                   14165:         if ($mapurl eq 'default') {
                   14166:             $maptitle = 'Main Course Documents';
                   14167:         }
                   14168:         $path .= (($path ne '')? '&' : '').
                   14169:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
                   14170:                  &Apache::lonhtmlcommon::entity_encode($maptitle).
                   14171:                  ':'.$mapresobj->randompick().
                   14172:                  ':'.$mapresobj->randomout().
                   14173:                  ':'.$mapresobj->encrypted().
                   14174:                  ':'.$mapresobj->randomorder().
                   14175:                  ':'.$mapresobj->is_page();
                   14176:     } else {
                   14177:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   14178:         my $ispage = (($type eq 'page')? 1 : '');
                   14179:         if ($mapurl eq 'default') {
                   14180:             $maptitle = 'Main Course Documents';
                   14181:         }
                   14182:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
                   14183:                 &Apache::lonhtmlcommon::entity_encode($maptitle).':::::'.$ispage;
                   14184:     }
                   14185:     unless ($mapurl eq 'default') {
                   14186:         $path = 'default&'.
                   14187:                 &Apache::lonhtmlcommon::entity_encode('Main Course Documents').
                   14188:                 ':::::&'.$path;
                   14189:     }
                   14190:     return $path;
                   14191: }
                   14192: 
1.1075.2.14  raeburn  14193: sub captcha_display {
                   14194:     my ($context,$lonhost) = @_;
                   14195:     my ($output,$error);
                   14196:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   14197:     if ($captcha eq 'original') {
                   14198:         $output = &create_captcha();
                   14199:         unless ($output) {
                   14200:             $error = 'captcha';
                   14201:         }
                   14202:     } elsif ($captcha eq 'recaptcha') {
                   14203:         $output = &create_recaptcha($pubkey);
                   14204:         unless ($output) {
                   14205:             $error = 'recaptcha';
                   14206:         }
                   14207:     }
                   14208:     return ($output,$error);
                   14209: }
                   14210: 
                   14211: sub captcha_response {
                   14212:     my ($context,$lonhost) = @_;
                   14213:     my ($captcha_chk,$captcha_error);
                   14214:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   14215:     if ($captcha eq 'original') {
                   14216:         ($captcha_chk,$captcha_error) = &check_captcha();
                   14217:     } elsif ($captcha eq 'recaptcha') {
                   14218:         $captcha_chk = &check_recaptcha($privkey);
                   14219:     } else {
                   14220:         $captcha_chk = 1;
                   14221:     }
                   14222:     return ($captcha_chk,$captcha_error);
                   14223: }
                   14224: 
                   14225: sub get_captcha_config {
                   14226:     my ($context,$lonhost) = @_;
                   14227:     my ($captcha,$pubkey,$privkey,$hashtocheck);
                   14228:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   14229:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   14230:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   14231:     if ($context eq 'usercreation') {
                   14232:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   14233:         if (ref($domconfig{$context}) eq 'HASH') {
                   14234:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   14235:             if (ref($hashtocheck) eq 'HASH') {
                   14236:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   14237:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   14238:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   14239:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   14240:                     }
                   14241:                     if ($privkey && $pubkey) {
                   14242:                         $captcha = 'recaptcha';
                   14243:                     } else {
                   14244:                         $captcha = 'original';
                   14245:                     }
                   14246:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   14247:                     $captcha = 'original';
                   14248:                 }
                   14249:             }
                   14250:         } else {
                   14251:             $captcha = 'captcha';
                   14252:         }
                   14253:     } elsif ($context eq 'login') {
                   14254:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   14255:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   14256:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   14257:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
                   14258:             if ($privkey && $pubkey) {
                   14259:                 $captcha = 'recaptcha';
                   14260:             } else {
                   14261:                 $captcha = 'original';
                   14262:             }
                   14263:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   14264:             $captcha = 'original';
                   14265:         }
                   14266:     }
                   14267:     return ($captcha,$pubkey,$privkey);
                   14268: }
                   14269: 
                   14270: sub create_captcha {
                   14271:     my %captcha_params = &captcha_settings();
                   14272:     my ($output,$maxtries,$tries) = ('',10,0);
                   14273:     while ($tries < $maxtries) {
                   14274:         $tries ++;
                   14275:         my $captcha = Authen::Captcha->new (
                   14276:                                            output_folder => $captcha_params{'output_dir'},
                   14277:                                            data_folder   => $captcha_params{'db_dir'},
                   14278:                                           );
                   14279:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   14280: 
                   14281:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   14282:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   14283:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
                   14284:                      '<input type="text" size="5" name="code" value="" /><br />'.
                   14285:                      '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" />';
                   14286:             last;
                   14287:         }
                   14288:     }
                   14289:     return $output;
                   14290: }
                   14291: 
                   14292: sub captcha_settings {
                   14293:     my %captcha_params = (
                   14294:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   14295:                            www_output_dir => "/captchaspool",
                   14296:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   14297:                            numchars       => '5',
                   14298:                          );
                   14299:     return %captcha_params;
                   14300: }
                   14301: 
                   14302: sub check_captcha {
                   14303:     my ($captcha_chk,$captcha_error);
                   14304:     my $code = $env{'form.code'};
                   14305:     my $md5sum = $env{'form.crypt'};
                   14306:     my %captcha_params = &captcha_settings();
                   14307:     my $captcha = Authen::Captcha->new(
                   14308:                       output_folder => $captcha_params{'output_dir'},
                   14309:                       data_folder   => $captcha_params{'db_dir'},
                   14310:                   );
                   14311:     my $captcha_chk = $captcha->check_code($code,$md5sum);
                   14312:     my %captcha_hash = (
                   14313:                         0       => 'Code not checked (file error)',
                   14314:                        -1      => 'Failed: code expired',
                   14315:                        -2      => 'Failed: invalid code (not in database)',
                   14316:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   14317:     );
                   14318:     if ($captcha_chk != 1) {
                   14319:         $captcha_error = $captcha_hash{$captcha_chk}
                   14320:     }
                   14321:     return ($captcha_chk,$captcha_error);
                   14322: }
                   14323: 
                   14324: sub create_recaptcha {
                   14325:     my ($pubkey) = @_;
                   14326:     my $captcha = Captcha::reCAPTCHA->new;
                   14327:     return $captcha->get_options_setter({theme => 'white'})."\n".
                   14328:            $captcha->get_html($pubkey).
                   14329:            &mt('If either word is hard to read, [_1] will replace them.',
                   14330:                '<image src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
                   14331:            '<br /><br />';
                   14332: }
                   14333: 
                   14334: sub check_recaptcha {
                   14335:     my ($privkey) = @_;
                   14336:     my $captcha_chk;
                   14337:     my $captcha = Captcha::reCAPTCHA->new;
                   14338:     my $captcha_result =
                   14339:         $captcha->check_answer(
                   14340:                                 $privkey,
                   14341:                                 $ENV{'REMOTE_ADDR'},
                   14342:                                 $env{'form.recaptcha_challenge_field'},
                   14343:                                 $env{'form.recaptcha_response_field'},
                   14344:                               );
                   14345:     if ($captcha_result->{is_valid}) {
                   14346:         $captcha_chk = 1;
                   14347:     }
                   14348:     return $captcha_chk;
                   14349: }
                   14350: 
1.41      ng       14351: =pod
                   14352: 
                   14353: =back
                   14354: 
1.112     bowersj2 14355: =cut
1.41      ng       14356: 
1.112     bowersj2 14357: 1;
                   14358: __END__;
1.41      ng       14359: 

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