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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1183  ! raeburn     4: # $Id: loncommon.pm,v 1.1182 2014/03/17 02:45:25 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.1108    raeburn    70: use Apache::lonuserutils();
1.1110    raeburn    71: use Apache::lonuserstate();
1.1182    raeburn    72: use Apache::courseclassifier();
1.479     albertel   73: use LONCAPA qw(:DEFAULT :match);
1.657     raeburn    74: use DateTime::TimeZone;
1.687     raeburn    75: use DateTime::Locale::Catalog;
1.1091    foxr       76: use Text::Aspell;
1.1094    raeburn    77: use Authen::Captcha;
                     78: use Captcha::reCAPTCHA;
1.1174    raeburn    79: use Crypt::DES;
                     80: use DynaLoader; # for Crypt::DES version
1.117     www        81: 
1.517     raeburn    82: # ---------------------------------------------- Designs
                     83: use vars qw(%defaultdesign);
                     84: 
1.22      www        85: my $readit;
                     86: 
1.517     raeburn    87: 
1.157     matthew    88: ##
                     89: ## Global Variables
                     90: ##
1.46      matthew    91: 
1.643     foxr       92: 
                     93: # ----------------------------------------------- SSI with retries:
                     94: #
                     95: 
                     96: =pod
                     97: 
1.648     raeburn    98: =head1 Server Side include with retries:
1.643     foxr       99: 
                    100: =over 4
                    101: 
1.648     raeburn   102: =item * &ssi_with_retries(resource,retries form)
1.643     foxr      103: 
                    104: Performs an ssi with some number of retries.  Retries continue either
                    105: until the result is ok or until the retry count supplied by the
                    106: caller is exhausted.  
                    107: 
                    108: Inputs:
1.648     raeburn   109: 
                    110: =over 4
                    111: 
1.643     foxr      112: resource   - Identifies the resource to insert.
1.648     raeburn   113: 
1.643     foxr      114: retries    - Count of the number of retries allowed.
1.648     raeburn   115: 
1.643     foxr      116: form       - Hash that identifies the rendering options.
                    117: 
1.648     raeburn   118: =back
                    119: 
                    120: Returns:
                    121: 
                    122: =over 4
                    123: 
1.643     foxr      124: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   125: 
1.643     foxr      126: response   - The response from the last attempt (which may or may not have been successful.
                    127: 
1.648     raeburn   128: =back
                    129: 
                    130: =back
                    131: 
1.643     foxr      132: =cut
                    133: 
                    134: sub ssi_with_retries {
                    135:     my ($resource, $retries, %form) = @_;
                    136: 
                    137: 
                    138:     my $ok = 0;			# True if we got a good response.
                    139:     my $content;
                    140:     my $response;
                    141: 
                    142:     # Try to get the ssi done. within the retries count:
                    143: 
                    144:     do {
                    145: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    146: 	$ok      = $response->is_success;
1.650     www       147:         if (!$ok) {
                    148:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    149:         }
1.643     foxr      150: 	$retries--;
                    151:     } while (!$ok && ($retries > 0));
                    152: 
                    153:     if (!$ok) {
                    154: 	$content = '';		# On error return an empty content.
                    155:     }
                    156:     return ($content, $response);
                    157: 
                    158: }
                    159: 
                    160: 
                    161: 
1.20      www       162: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  163: my %language;
1.124     www       164: my %supported_language;
1.1088    foxr      165: my %supported_codes;
1.1048    foxr      166: my %latex_language;		# For choosing hyphenation in <transl..>
                    167: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  168: my %cprtag;
1.192     taceyjo1  169: my %scprtag;
1.351     www       170: my %fe; my %fd; my %fm;
1.41      ng        171: my %category_extensions;
1.12      harris41  172: 
1.46      matthew   173: # ---------------------------------------------- Thesaurus variables
1.144     matthew   174: #
                    175: # %Keywords:
                    176: #      A hash used by &keyword to determine if a word is considered a keyword.
                    177: # $thesaurus_db_file 
                    178: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   179: 
                    180: my %Keywords;
                    181: my $thesaurus_db_file;
                    182: 
1.144     matthew   183: #
                    184: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    185: # thesaurus.tab, and filecategories.tab.
                    186: #
1.18      www       187: BEGIN {
1.46      matthew   188:     # Variable initialization
                    189:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    190:     #
1.22      www       191:     unless ($readit) {
1.12      harris41  192: # ------------------------------------------------------------------- languages
                    193:     {
1.158     raeburn   194:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    195:                                    '/language.tab';
                    196:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  197:             while (my $line = <$fh>) {
                    198:                 next if ($line=~/^\#/);
                    199:                 chomp($line);
1.1088    foxr      200:                 my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   201:                 $language{$key}=$val.' - '.$enc;
                    202:                 if ($sup) {
                    203:                     $supported_language{$key}=$sup;
1.1088    foxr      204: 		    $supported_codes{$key}   = $code;
1.158     raeburn   205:                 }
1.1048    foxr      206: 		if ($latex) {
                    207: 		    $latex_language_bykey{$key} = $latex;
1.1088    foxr      208: 		    $latex_language{$code} = $latex;
1.1048    foxr      209: 		}
1.158     raeburn   210:             }
                    211:             close($fh);
                    212:         }
1.12      harris41  213:     }
                    214: # ------------------------------------------------------------------ copyrights
                    215:     {
1.158     raeburn   216:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    217:                                   '/copyright.tab';
                    218:         if ( open (my $fh,"<$copyrightfile") ) {
1.356     albertel  219:             while (my $line = <$fh>) {
                    220:                 next if ($line=~/^\#/);
                    221:                 chomp($line);
                    222:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   223:                 $cprtag{$key}=$val;
                    224:             }
                    225:             close($fh);
                    226:         }
1.12      harris41  227:     }
1.351     www       228: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  229:     {
                    230:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    231:                                   '/source_copyright.tab';
                    232:         if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356     albertel  233:             while (my $line = <$fh>) {
                    234:                 next if ($line =~ /^\#/);
                    235:                 chomp($line);
                    236:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  237:                 $scprtag{$key}=$val;
                    238:             }
                    239:             close($fh);
                    240:         }
                    241:     }
1.63      www       242: 
1.517     raeburn   243: # -------------------------------------------------------------- default domain designs
1.63      www       244:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   245:     my $designfile = $designdir.'/default.tab';
                    246:     if ( open (my $fh,"<$designfile") ) {
                    247:         while (my $line = <$fh>) {
                    248:             next if ($line =~ /^\#/);
                    249:             chomp($line);
                    250:             my ($key,$val)=(split(/\=/,$line));
                    251:             if ($val) { $defaultdesign{$key}=$val; }
                    252:         }
                    253:         close($fh);
1.63      www       254:     }
                    255: 
1.15      harris41  256: # ------------------------------------------------------------- file categories
                    257:     {
1.158     raeburn   258:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    259:                                   '/filecategories.tab';
                    260:         if ( open (my $fh,"<$categoryfile") ) {
1.356     albertel  261: 	    while (my $line = <$fh>) {
                    262: 		next if ($line =~ /^\#/);
                    263: 		chomp($line);
                    264:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.158     raeburn   265:                 push @{$category_extensions{lc($category)}},$extension;
                    266:             }
                    267:             close($fh);
                    268:         }
                    269: 
1.15      harris41  270:     }
1.12      harris41  271: # ------------------------------------------------------------------ file types
                    272:     {
1.158     raeburn   273:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    274:                '/filetypes.tab';
                    275:         if ( open (my $fh,"<$typesfile") ) {
1.356     albertel  276:             while (my $line = <$fh>) {
                    277: 		next if ($line =~ /^\#/);
                    278: 		chomp($line);
                    279:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   280:                 if ($descr ne '') {
                    281:                     $fe{$ending}=lc($emb);
                    282:                     $fd{$ending}=$descr;
1.351     www       283:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   284:                 }
                    285:             }
                    286:             close($fh);
                    287:         }
1.12      harris41  288:     }
1.22      www       289:     &Apache::lonnet::logthis(
1.705     tempelho  290:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       291:     $readit=1;
1.46      matthew   292:     }  # end of unless($readit) 
1.32      matthew   293:     
                    294: }
1.112     bowersj2  295: 
1.42      matthew   296: ###############################################################
                    297: ##           HTML and Javascript Helper Functions            ##
                    298: ###############################################################
                    299: 
                    300: =pod 
                    301: 
1.112     bowersj2  302: =head1 HTML and Javascript Functions
1.42      matthew   303: 
1.112     bowersj2  304: =over 4
                    305: 
1.648     raeburn   306: =item * &browser_and_searcher_javascript()
1.112     bowersj2  307: 
                    308: X<browsing, javascript>X<searching, javascript>Returns a string
                    309: containing javascript with two functions, C<openbrowser> and
                    310: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    311: tags.
1.42      matthew   312: 
1.648     raeburn   313: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   314: 
                    315: inputs: formname, elementname, only, omit
                    316: 
                    317: formname and elementname indicate the name of the html form and name of
                    318: the element that the results of the browsing selection are to be placed in. 
                    319: 
                    320: Specifying 'only' will restrict the browser to displaying only files
1.185     www       321: with the given extension.  Can be a comma separated list.
1.42      matthew   322: 
                    323: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       324: with the given extension.  Can be a comma separated list.
1.42      matthew   325: 
1.648     raeburn   326: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   327: 
                    328: Inputs: formname, elementname
                    329: 
                    330: formname and elementname specify the name of the html form and the name
                    331: of the element the selection from the search results will be placed in.
1.542     raeburn   332: 
1.42      matthew   333: =cut
                    334: 
                    335: sub browser_and_searcher_javascript {
1.199     albertel  336:     my ($mode)=@_;
                    337:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  338:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   339:     return <<END;
1.219     albertel  340: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   341:     var editbrowser = null;
1.135     albertel  342:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       343:         var url = '$resurl/?';
1.42      matthew   344:         if (editbrowser == null) {
                    345:             url += 'launch=1&';
                    346:         }
                    347:         url += 'catalogmode=interactive&';
1.199     albertel  348:         url += 'mode=$mode&';
1.611     albertel  349:         url += 'inhibitmenu=yes&';
1.42      matthew   350:         url += 'form=' + formname + '&';
                    351:         if (only != null) {
                    352:             url += 'only=' + only + '&';
1.217     albertel  353:         } else {
                    354:             url += 'only=&';
                    355: 	}
1.42      matthew   356:         if (omit != null) {
                    357:             url += 'omit=' + omit + '&';
1.217     albertel  358:         } else {
                    359:             url += 'omit=&';
                    360: 	}
1.135     albertel  361:         if (titleelement != null) {
                    362:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  363:         } else {
                    364: 	    url += 'titleelement=&';
                    365: 	}
1.42      matthew   366:         url += 'element=' + elementname + '';
                    367:         var title = 'Browser';
1.435     albertel  368:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   369:         options += ',width=700,height=600';
                    370:         editbrowser = open(url,title,options,'1');
                    371:         editbrowser.focus();
                    372:     }
                    373:     var editsearcher;
1.135     albertel  374:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   375:         var url = '/adm/searchcat?';
                    376:         if (editsearcher == null) {
                    377:             url += 'launch=1&';
                    378:         }
                    379:         url += 'catalogmode=interactive&';
1.199     albertel  380:         url += 'mode=$mode&';
1.42      matthew   381:         url += 'form=' + formname + '&';
1.135     albertel  382:         if (titleelement != null) {
                    383:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  384:         } else {
                    385: 	    url += 'titleelement=&';
                    386: 	}
1.42      matthew   387:         url += 'element=' + elementname + '';
                    388:         var title = 'Search';
1.435     albertel  389:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   390:         options += ',width=700,height=600';
                    391:         editsearcher = open(url,title,options,'1');
                    392:         editsearcher.focus();
                    393:     }
1.219     albertel  394: // END LON-CAPA Internal -->
1.42      matthew   395: END
1.170     www       396: }
                    397: 
                    398: sub lastresurl {
1.258     albertel  399:     if ($env{'environment.lastresurl'}) {
                    400: 	return $env{'environment.lastresurl'}
1.170     www       401:     } else {
                    402: 	return '/res';
                    403:     }
                    404: }
                    405: 
                    406: sub storeresurl {
                    407:     my $resurl=&Apache::lonnet::clutter(shift);
                    408:     unless ($resurl=~/^\/res/) { return 0; }
                    409:     $resurl=~s/\/$//;
                    410:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   411:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       412:     return 1;
1.42      matthew   413: }
                    414: 
1.74      www       415: sub studentbrowser_javascript {
1.111     www       416:    unless (
1.258     albertel  417:             (($env{'request.course.id'}) && 
1.302     albertel  418:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    419: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    420: 					  '/'.$env{'request.course.sec'})
                    421: 	      ))
1.258     albertel  422:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       423:           ) { return ''; }  
1.74      www       424:    return (<<'ENDSTDBRW');
1.776     bisitz    425: <script type="text/javascript" language="Javascript">
1.824     bisitz    426: // <![CDATA[
1.74      www       427:     var stdeditbrowser;
1.999     www       428:     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74      www       429:         var url = '/adm/pickstudent?';
                    430:         var filter;
1.558     albertel  431: 	if (!ignorefilter) {
                    432: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    433: 	}
1.74      www       434:         if (filter != null) {
                    435:            if (filter != '') {
                    436:                url += 'filter='+filter+'&';
                    437: 	   }
                    438:         }
                    439:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       440:                                     '&udomelement='+udom+
                    441:                                     '&clicker='+clicker;
1.111     www       442: 	if (roleflag) { url+="&roles=1"; }
1.793     raeburn   443:         if (courseadvonly) { url+="&courseadvonly=1"; }
1.102     www       444:         var title = 'Student_Browser';
1.74      www       445:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    446:         options += ',width=700,height=600';
                    447:         stdeditbrowser = open(url,title,options,'1');
                    448:         stdeditbrowser.focus();
                    449:     }
1.824     bisitz    450: // ]]>
1.74      www       451: </script>
                    452: ENDSTDBRW
                    453: }
1.42      matthew   454: 
1.1003    www       455: sub resourcebrowser_javascript {
                    456:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       457:    return (<<'ENDRESBRW');
1.1003    www       458: <script type="text/javascript" language="Javascript">
                    459: // <![CDATA[
                    460:     var reseditbrowser;
1.1004    www       461:     function openresbrowser(formname,reslink) {
1.1005    www       462:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       463:         var title = 'Resource_Browser';
                    464:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       465:         options += ',width=700,height=500';
1.1004    www       466:         reseditbrowser = open(url,title,options,'1');
                    467:         reseditbrowser.focus();
1.1003    www       468:     }
                    469: // ]]>
                    470: </script>
1.1004    www       471: ENDRESBRW
1.1003    www       472: }
                    473: 
1.74      www       474: sub selectstudent_link {
1.999     www       475:    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
                    476:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    477:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    478:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  479:    if ($env{'request.course.id'}) {  
1.302     albertel  480:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    481: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    482: 					'/'.$env{'request.course.sec'})) {
1.111     www       483: 	   return '';
                    484:        }
1.999     www       485:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793     raeburn   486:        if ($courseadvonly)  {
                    487:            $callargs .= ",'',1,1";
                    488:        }
                    489:        return '<span class="LC_nobreak">'.
                    490:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    491:               &mt('Select User').'</a></span>';
1.74      www       492:    }
1.258     albertel  493:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       494:        $callargs .= ",'',1"; 
1.793     raeburn   495:        return '<span class="LC_nobreak">'.
                    496:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    497:               &mt('Select User').'</a></span>';
1.111     www       498:    }
                    499:    return '';
1.91      www       500: }
                    501: 
1.1004    www       502: sub selectresource_link {
                    503:    my ($form,$reslink,$arg)=@_;
                    504:    
                    505:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    506:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    507:    unless ($env{'request.course.id'}) { return $arg; }
                    508:    return '<span class="LC_nobreak">'.
                    509:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    510:               $arg.'</a></span>';
                    511: }
                    512: 
                    513: 
                    514: 
1.653     raeburn   515: sub authorbrowser_javascript {
                    516:     return <<"ENDAUTHORBRW";
1.776     bisitz    517: <script type="text/javascript" language="JavaScript">
1.824     bisitz    518: // <![CDATA[
1.653     raeburn   519: var stdeditbrowser;
                    520: 
                    521: function openauthorbrowser(formname,udom) {
                    522:     var url = '/adm/pickauthor?';
                    523:     url += 'form='+formname+'&roledom='+udom;
                    524:     var title = 'Author_Browser';
                    525:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    526:     options += ',width=700,height=600';
                    527:     stdeditbrowser = open(url,title,options,'1');
                    528:     stdeditbrowser.focus();
                    529: }
                    530: 
1.824     bisitz    531: // ]]>
1.653     raeburn   532: </script>
                    533: ENDAUTHORBRW
                    534: }
                    535: 
1.91      www       536: sub coursebrowser_javascript {
1.1116    raeburn   537:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
                    538:         $credits_element) = @_;
1.932     raeburn   539:     my $wintitle = 'Course_Browser';
1.931     raeburn   540:     if ($crstype eq 'Community') {
1.932     raeburn   541:         $wintitle = 'Community_Browser';
1.909     raeburn   542:     }
1.876     raeburn   543:     my $id_functions = &javascript_index_functions();
                    544:     my $output = '
1.776     bisitz    545: <script type="text/javascript" language="JavaScript">
1.824     bisitz    546: // <![CDATA[
1.468     raeburn   547:     var stdeditbrowser;'."\n";
1.876     raeburn   548: 
                    549:     $output .= <<"ENDSTDBRW";
1.909     raeburn   550:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       551:         var url = '/adm/pickcourse?';
1.895     raeburn   552:         var formid = getFormIdByName(formname);
1.876     raeburn   553:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  554:         if (domainfilter != null) {
                    555:            if (domainfilter != '') {
                    556:                url += 'domainfilter='+domainfilter+'&';
                    557: 	   }
                    558:         }
1.91      www       559:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  560: 	                            '&cdomelement='+udom+
                    561:                                     '&cnameelement='+desc;
1.468     raeburn   562:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   563:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   564:                 url += '&roleelement='+extra_element;
                    565:                 if (domainfilter == null || domainfilter == '') {
                    566:                     url += '&domainfilter='+extra_element;
                    567:                 }
1.234     raeburn   568:             }
1.468     raeburn   569:             else {
                    570:                 if (formname == 'portform') {
                    571:                     url += '&setroles='+extra_element;
1.800     raeburn   572:                 } else {
                    573:                     if (formname == 'rules') {
                    574:                         url += '&fixeddom='+extra_element; 
                    575:                     }
1.468     raeburn   576:                 }
                    577:             }     
1.230     raeburn   578:         }
1.909     raeburn   579:         if (type != null && type != '') {
                    580:             url += '&type='+type;
                    581:         }
                    582:         if (type_elem != null && type_elem != '') {
                    583:             url += '&typeelement='+type_elem;
                    584:         }
1.872     raeburn   585:         if (formname == 'ccrs') {
                    586:             var ownername = document.forms[formid].ccuname.value;
                    587:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
                    588:             url += '&cloner='+ownername+':'+ownerdom;
                    589:         }
1.293     raeburn   590:         if (multflag !=null && multflag != '') {
                    591:             url += '&multiple='+multflag;
                    592:         }
1.909     raeburn   593:         var title = '$wintitle';
1.91      www       594:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    595:         options += ',width=700,height=600';
                    596:         stdeditbrowser = open(url,title,options,'1');
                    597:         stdeditbrowser.focus();
                    598:     }
1.876     raeburn   599: $id_functions
                    600: ENDSTDBRW
1.1116    raeburn   601:     if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
                    602:         $output .= &setsec_javascript($sec_element,$formname,$role_element,
                    603:                                       $credits_element);
1.876     raeburn   604:     }
                    605:     $output .= '
                    606: // ]]>
                    607: </script>';
                    608:     return $output;
                    609: }
                    610: 
                    611: sub javascript_index_functions {
                    612:     return <<"ENDJS";
                    613: 
                    614: function getFormIdByName(formname) {
                    615:     for (var i=0;i<document.forms.length;i++) {
                    616:         if (document.forms[i].name == formname) {
                    617:             return i;
                    618:         }
                    619:     }
                    620:     return -1;
                    621: }
                    622: 
                    623: function getIndexByName(formid,item) {
                    624:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    625:         if (document.forms[formid].elements[i].name == item) {
                    626:             return i;
                    627:         }
                    628:     }
                    629:     return -1;
                    630: }
1.468     raeburn   631: 
1.876     raeburn   632: function getDomainFromSelectbox(formname,udom) {
                    633:     var userdom;
                    634:     var formid = getFormIdByName(formname);
                    635:     if (formid > -1) {
                    636:         var domid = getIndexByName(formid,udom);
                    637:         if (domid > -1) {
                    638:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    639:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    640:             }
                    641:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    642:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   643:             }
                    644:         }
                    645:     }
1.876     raeburn   646:     return userdom;
                    647: }
                    648: 
                    649: ENDJS
1.468     raeburn   650: 
1.876     raeburn   651: }
                    652: 
1.1017    raeburn   653: sub javascript_array_indexof {
1.1018    raeburn   654:     return <<ENDJS;
1.1017    raeburn   655: <script type="text/javascript" language="JavaScript">
                    656: // <![CDATA[
                    657: 
                    658: if (!Array.prototype.indexOf) {
                    659:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    660:         "use strict";
                    661:         if (this === void 0 || this === null) {
                    662:             throw new TypeError();
                    663:         }
                    664:         var t = Object(this);
                    665:         var len = t.length >>> 0;
                    666:         if (len === 0) {
                    667:             return -1;
                    668:         }
                    669:         var n = 0;
                    670:         if (arguments.length > 0) {
                    671:             n = Number(arguments[1]);
1.1088    foxr      672:             if (n !== n) { // shortcut for verifying if it is NaN
1.1017    raeburn   673:                 n = 0;
                    674:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    675:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    676:             }
                    677:         }
                    678:         if (n >= len) {
                    679:             return -1;
                    680:         }
                    681:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    682:         for (; k < len; k++) {
                    683:             if (k in t && t[k] === searchElement) {
                    684:                 return k;
                    685:             }
                    686:         }
                    687:         return -1;
                    688:     }
                    689: }
                    690: 
                    691: // ]]>
                    692: </script>
                    693: 
                    694: ENDJS
                    695: 
                    696: }
                    697: 
1.876     raeburn   698: sub userbrowser_javascript {
                    699:     my $id_functions = &javascript_index_functions();
                    700:     return <<"ENDUSERBRW";
                    701: 
1.888     raeburn   702: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   703:     var url = '/adm/pickuser?';
                    704:     var userdom = getDomainFromSelectbox(formname,udom);
                    705:     if (userdom != null) {
                    706:        if (userdom != '') {
                    707:            url += 'srchdom='+userdom+'&';
                    708:        }
                    709:     }
                    710:     url += 'form=' + formname + '&unameelement='+uname+
                    711:                                 '&udomelement='+udom+
                    712:                                 '&ulastelement='+ulast+
                    713:                                 '&ufirstelement='+ufirst+
                    714:                                 '&uemailelement='+uemail+
1.881     raeburn   715:                                 '&hideudomelement='+hideudom+
                    716:                                 '&coursedom='+crsdom;
1.888     raeburn   717:     if ((caller != null) && (caller != undefined)) {
                    718:         url += '&caller='+caller;
                    719:     }
1.876     raeburn   720:     var title = 'User_Browser';
                    721:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    722:     options += ',width=700,height=600';
                    723:     var stdeditbrowser = open(url,title,options,'1');
                    724:     stdeditbrowser.focus();
                    725: }
                    726: 
1.888     raeburn   727: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   728:     var formid = getFormIdByName(formname);
                    729:     if (formid > -1) {
1.888     raeburn   730:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   731:         var domid = getIndexByName(formid,udom);
                    732:         var hidedomid = getIndexByName(formid,origdom);
                    733:         if (hidedomid > -1) {
                    734:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   735:             var unameval = document.forms[formid].elements[unameid].value;
                    736:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    737:                 if (domid > -1) {
                    738:                     var slct = document.forms[formid].elements[domid];
                    739:                     if (slct.type == 'select-one') {
                    740:                         var i;
                    741:                         for (i=0;i<slct.length;i++) {
                    742:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    743:                         }
                    744:                     }
                    745:                     if (slct.type == 'hidden') {
                    746:                         slct.value = fixeddom;
1.876     raeburn   747:                     }
                    748:                 }
1.468     raeburn   749:             }
                    750:         }
                    751:     }
1.876     raeburn   752:     return;
                    753: }
                    754: 
                    755: $id_functions
                    756: ENDUSERBRW
1.468     raeburn   757: }
                    758: 
                    759: sub setsec_javascript {
1.1116    raeburn   760:     my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905     raeburn   761:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    762:         $communityrolestr);
                    763:     if ($role_element ne '') {
                    764:         my @allroles = ('st','ta','ep','in','ad');
                    765:         foreach my $crstype ('Course','Community') {
                    766:             if ($crstype eq 'Community') {
                    767:                 foreach my $role (@allroles) {
                    768:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    769:                 }
                    770:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    771:             } else {
                    772:                 foreach my $role (@allroles) {
                    773:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    774:                 }
                    775:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    776:             }
                    777:         }
                    778:         $rolestr = '"'.join('","',@allroles).'"';
                    779:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    780:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    781:     }
1.468     raeburn   782:     my $setsections = qq|
                    783: function setSect(sectionlist) {
1.629     raeburn   784:     var sectionsArray = new Array();
                    785:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    786:         sectionsArray = sectionlist.split(",");
                    787:     }
1.468     raeburn   788:     var numSections = sectionsArray.length;
                    789:     document.$formname.$sec_element.length = 0;
                    790:     if (numSections == 0) {
                    791:         document.$formname.$sec_element.multiple=false;
                    792:         document.$formname.$sec_element.size=1;
                    793:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    794:     } else {
                    795:         if (numSections == 1) {
                    796:             document.$formname.$sec_element.multiple=false;
                    797:             document.$formname.$sec_element.size=1;
                    798:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    799:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    800:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    801:         } else {
                    802:             for (var i=0; i<numSections; i++) {
                    803:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    804:             }
                    805:             document.$formname.$sec_element.multiple=true
                    806:             if (numSections < 3) {
                    807:                 document.$formname.$sec_element.size=numSections;
                    808:             } else {
                    809:                 document.$formname.$sec_element.size=3;
                    810:             }
                    811:             document.$formname.$sec_element.options[0].selected = false
                    812:         }
                    813:     }
1.91      www       814: }
1.905     raeburn   815: 
                    816: function setRole(crstype) {
1.468     raeburn   817: |;
1.905     raeburn   818:     if ($role_element eq '') {
                    819:         $setsections .= '    return;
                    820: }
                    821: ';
                    822:     } else {
                    823:         $setsections .= qq|
                    824:     var elementLength = document.$formname.$role_element.length;
                    825:     var allroles = Array($rolestr);
                    826:     var courserolenames = Array($courserolestr);
                    827:     var communityrolenames = Array($communityrolestr);
                    828:     if (elementLength != undefined) {
                    829:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    830:             if (crstype == 'Course') {
                    831:                 return;
                    832:             } else {
                    833:                 allroles[5] = 'co';
                    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 = communityrolenames[i];
                    837:                 }
                    838:             }
                    839:         } else {
                    840:             if (crstype == 'Community') {
                    841:                 return;
                    842:             } else {
                    843:                 allroles[5] = 'cc';
                    844:                 for (var i=0; i<6; i++) {
                    845:                     document.$formname.$role_element.options[i].value = allroles[i];
                    846:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    847:                 }
                    848:             }
                    849:         }
                    850:     }
                    851:     return;
                    852: }
                    853: |;
                    854:     }
1.1116    raeburn   855:     if ($credits_element) {
                    856:         $setsections .= qq|
                    857: function setCredits(defaultcredits) {
                    858:     document.$formname.$credits_element.value = defaultcredits;
                    859:     return;
                    860: }
                    861: |;
                    862:     }
1.468     raeburn   863:     return $setsections;
                    864: }
                    865: 
1.91      www       866: sub selectcourse_link {
1.909     raeburn   867:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    868:        $typeelement) = @_;
                    869:    my $type = $selecttype;
1.871     raeburn   870:    my $linktext = &mt('Select Course');
                    871:    if ($selecttype eq 'Community') {
1.909     raeburn   872:        $linktext = &mt('Select Community');
1.906     raeburn   873:    } elsif ($selecttype eq 'Course/Community') {
                    874:        $linktext = &mt('Select Course/Community');
1.909     raeburn   875:        $type = '';
1.1019    raeburn   876:    } elsif ($selecttype eq 'Select') {
                    877:        $linktext = &mt('Select');
                    878:        $type = '';
1.871     raeburn   879:    }
1.787     bisitz    880:    return '<span class="LC_nobreak">'
                    881:          ."<a href='"
                    882:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    883:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   884:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   885:          ."'>".$linktext.'</a>'
1.787     bisitz    886:          .'</span>';
1.74      www       887: }
1.42      matthew   888: 
1.653     raeburn   889: sub selectauthor_link {
                    890:    my ($form,$udom)=@_;
                    891:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    892:           &mt('Select Author').'</a>';
                    893: }
                    894: 
1.876     raeburn   895: sub selectuser_link {
1.881     raeburn   896:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   897:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   898:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   899:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   900:            ');">'.$linktext.'</a>';
1.876     raeburn   901: }
                    902: 
1.273     raeburn   903: sub check_uncheck_jscript {
                    904:     my $jscript = <<"ENDSCRT";
                    905: function checkAll(field) {
                    906:     if (field.length > 0) {
                    907:         for (i = 0; i < field.length; i++) {
1.1093    raeburn   908:             if (!field[i].disabled) { 
                    909:                 field[i].checked = true;
                    910:             }
1.273     raeburn   911:         }
                    912:     } else {
1.1093    raeburn   913:         if (!field.disabled) { 
                    914:             field.checked = true;
                    915:         }
1.273     raeburn   916:     }
                    917: }
                    918:  
                    919: function uncheckAll(field) {
                    920:     if (field.length > 0) {
                    921:         for (i = 0; i < field.length; i++) {
                    922:             field[i].checked = false ;
1.543     albertel  923:         }
                    924:     } else {
1.273     raeburn   925:         field.checked = false ;
                    926:     }
                    927: }
                    928: ENDSCRT
                    929:     return $jscript;
                    930: }
                    931: 
1.656     www       932: sub select_timezone {
1.659     raeburn   933:    my ($name,$selected,$onchange,$includeempty)=@_;
                    934:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    935:    if ($includeempty) {
                    936:        $output .= '<option value=""';
                    937:        if (($selected eq '') || ($selected eq 'local')) {
                    938:            $output .= ' selected="selected" ';
                    939:        }
                    940:        $output .= '> </option>';
                    941:    }
1.657     raeburn   942:    my @timezones = DateTime::TimeZone->all_names;
                    943:    foreach my $tzone (@timezones) {
                    944:        $output.= '<option value="'.$tzone.'"';
                    945:        if ($tzone eq $selected) {
                    946:            $output.=' selected="selected"';
                    947:        }
                    948:        $output.=">$tzone</option>\n";
1.656     www       949:    }
                    950:    $output.="</select>";
                    951:    return $output;
                    952: }
1.273     raeburn   953: 
1.687     raeburn   954: sub select_datelocale {
                    955:     my ($name,$selected,$onchange,$includeempty)=@_;
                    956:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    957:     if ($includeempty) {
                    958:         $output .= '<option value=""';
                    959:         if ($selected eq '') {
                    960:             $output .= ' selected="selected" ';
                    961:         }
                    962:         $output .= '> </option>';
                    963:     }
                    964:     my (@possibles,%locale_names);
                    965:     my @locales = DateTime::Locale::Catalog::Locales;
                    966:     foreach my $locale (@locales) {
                    967:         if (ref($locale) eq 'HASH') {
                    968:             my $id = $locale->{'id'};
                    969:             if ($id ne '') {
                    970:                 my $en_terr = $locale->{'en_territory'};
                    971:                 my $native_terr = $locale->{'native_territory'};
1.695     raeburn   972:                 my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   973:                 if (grep(/^en$/,@languages) || !@languages) {
                    974:                     if ($en_terr ne '') {
                    975:                         $locale_names{$id} = '('.$en_terr.')';
                    976:                     } elsif ($native_terr ne '') {
                    977:                         $locale_names{$id} = $native_terr;
                    978:                     }
                    979:                 } else {
                    980:                     if ($native_terr ne '') {
                    981:                         $locale_names{$id} = $native_terr.' ';
                    982:                     } elsif ($en_terr ne '') {
                    983:                         $locale_names{$id} = '('.$en_terr.')';
                    984:                     }
                    985:                 }
                    986:                 push (@possibles,$id);
                    987:             }
                    988:         }
                    989:     }
                    990:     foreach my $item (sort(@possibles)) {
                    991:         $output.= '<option value="'.$item.'"';
                    992:         if ($item eq $selected) {
                    993:             $output.=' selected="selected"';
                    994:         }
                    995:         $output.=">$item";
                    996:         if ($locale_names{$item} ne '') {
                    997:             $output.="  $locale_names{$item}</option>\n";
                    998:         }
                    999:         $output.="</option>\n";
                   1000:     }
                   1001:     $output.="</select>";
                   1002:     return $output;
                   1003: }
                   1004: 
1.792     raeburn  1005: sub select_language {
                   1006:     my ($name,$selected,$includeempty) = @_;
                   1007:     my %langchoices;
                   1008:     if ($includeempty) {
1.1117    raeburn  1009:         %langchoices = ('' => 'No language preference');
1.792     raeburn  1010:     }
                   1011:     foreach my $id (&languageids()) {
                   1012:         my $code = &supportedlanguagecode($id);
                   1013:         if ($code) {
                   1014:             $langchoices{$code} = &plainlanguagedescription($id);
                   1015:         }
                   1016:     }
1.1117    raeburn  1017:     %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970     raeburn  1018:     return &select_form($selected,$name,\%langchoices);
1.792     raeburn  1019: }
                   1020: 
1.42      matthew  1021: =pod
1.36      matthew  1022: 
1.1088    foxr     1023: 
                   1024: =item * &list_languages()
                   1025: 
                   1026: Returns an array reference that is suitable for use in language prompters.
                   1027: Each array element is itself a two element array.  The first element
                   1028: is the language code.  The second element a descsriptiuon of the 
                   1029: language itself.  This is suitable for use in e.g.
                   1030: &Apache::edit::select_arg (once dereferenced that is).
                   1031: 
                   1032: =cut 
                   1033: 
                   1034: sub list_languages {
                   1035:     my @lang_choices;
                   1036: 
                   1037:     foreach my $id (&languageids()) {
                   1038: 	my $code = &supportedlanguagecode($id);
                   1039: 	if ($code) {
                   1040: 	    my $selector    = $supported_codes{$id};
                   1041: 	    my $description = &plainlanguagedescription($id);
                   1042: 	    push (@lang_choices, [$selector, $description]);
                   1043: 	}
                   1044:     }
                   1045:     return \@lang_choices;
                   1046: }
                   1047: 
                   1048: =pod
                   1049: 
1.648     raeburn  1050: =item * &linked_select_forms(...)
1.36      matthew  1051: 
                   1052: linked_select_forms returns a string containing a <script></script> block
                   1053: and html for two <select> menus.  The select menus will be linked in that
                   1054: changing the value of the first menu will result in new values being placed
                   1055: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1056: order unless a defined order is provided.
1.36      matthew  1057: 
                   1058: linked_select_forms takes the following ordered inputs:
                   1059: 
                   1060: =over 4
                   1061: 
1.112     bowersj2 1062: =item * $formname, the name of the <form> tag
1.36      matthew  1063: 
1.112     bowersj2 1064: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1065: 
1.112     bowersj2 1066: =item * $firstdefault, the default value for the first menu
1.36      matthew  1067: 
1.112     bowersj2 1068: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1069: 
1.112     bowersj2 1070: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1071: 
1.112     bowersj2 1072: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1073: 
1.609     raeburn  1074: =item * $menuorder, the order of values in the first menu
                   1075: 
1.1115    raeburn  1076: =item * $onchangefirst, additional javascript call to execute for an onchange
                   1077:         event for the first <select> tag
                   1078: 
                   1079: =item * $onchangesecond, additional javascript call to execute for an onchange
                   1080:         event for the second <select> tag
                   1081: 
1.41      ng       1082: =back 
                   1083: 
1.36      matthew  1084: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1085: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1086: values for the first select menu.  The text that coincides with the 
1.41      ng       1087: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1088: and text for the second menu are given in the hash pointed to by 
                   1089: $menu{$choice1}->{'select2'}.  
                   1090: 
1.112     bowersj2 1091:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1092:                        default => "B3",
                   1093:                        select2 => { 
                   1094:                            B1 => "Choice B1",
                   1095:                            B2 => "Choice B2",
                   1096:                            B3 => "Choice B3",
                   1097:                            B4 => "Choice B4"
1.609     raeburn  1098:                            },
                   1099:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1100:                    },
                   1101:                A2 => { text =>"Choice A2" ,
                   1102:                        default => "C2",
                   1103:                        select2 => { 
                   1104:                            C1 => "Choice C1",
                   1105:                            C2 => "Choice C2",
                   1106:                            C3 => "Choice C3"
1.609     raeburn  1107:                            },
                   1108:                        order => ['C2','C1','C3'],
1.112     bowersj2 1109:                    },
                   1110:                A3 => { text =>"Choice A3" ,
                   1111:                        default => "D6",
                   1112:                        select2 => { 
                   1113:                            D1 => "Choice D1",
                   1114:                            D2 => "Choice D2",
                   1115:                            D3 => "Choice D3",
                   1116:                            D4 => "Choice D4",
                   1117:                            D5 => "Choice D5",
                   1118:                            D6 => "Choice D6",
                   1119:                            D7 => "Choice D7"
1.609     raeburn  1120:                            },
                   1121:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1122:                    }
                   1123:                );
1.36      matthew  1124: 
                   1125: =cut
                   1126: 
                   1127: sub linked_select_forms {
                   1128:     my ($formname,
                   1129:         $middletext,
                   1130:         $firstdefault,
                   1131:         $firstselectname,
                   1132:         $secondselectname, 
1.609     raeburn  1133:         $hashref,
                   1134:         $menuorder,
1.1115    raeburn  1135:         $onchangefirst,
                   1136:         $onchangesecond
1.36      matthew  1137:         ) = @_;
                   1138:     my $second = "document.$formname.$secondselectname";
                   1139:     my $first = "document.$formname.$firstselectname";
                   1140:     # output the javascript to do the changing
                   1141:     my $result = '';
1.776     bisitz   1142:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1143:     $result.="// <![CDATA[\n";
1.36      matthew  1144:     $result.="var select2data = new Object();\n";
                   1145:     $" = '","';
                   1146:     my $debug = '';
                   1147:     foreach my $s1 (sort(keys(%$hashref))) {
                   1148:         $result.="select2data.d_$s1 = new Object();\n";        
                   1149:         $result.="select2data.d_$s1.def = new String('".
                   1150:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1151:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1152:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1153:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1154:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1155:         }
1.36      matthew  1156:         $result.="\"@s2values\");\n";
                   1157:         $result.="select2data.d_$s1.texts = new Array(";        
                   1158:         my @s2texts;
                   1159:         foreach my $value (@s2values) {
                   1160:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1161:         }
                   1162:         $result.="\"@s2texts\");\n";
                   1163:     }
                   1164:     $"=' ';
                   1165:     $result.= <<"END";
                   1166: 
                   1167: function select1_changed() {
                   1168:     // Determine new choice
                   1169:     var newvalue = "d_" + $first.value;
                   1170:     // update select2
                   1171:     var values     = select2data[newvalue].values;
                   1172:     var texts      = select2data[newvalue].texts;
                   1173:     var select2def = select2data[newvalue].def;
                   1174:     var i;
                   1175:     // out with the old
                   1176:     for (i = 0; i < $second.options.length; i++) {
                   1177:         $second.options[i] = null;
                   1178:     }
                   1179:     // in with the nuclear
                   1180:     for (i=0;i<values.length; i++) {
                   1181:         $second.options[i] = new Option(values[i]);
1.143     matthew  1182:         $second.options[i].value = values[i];
1.36      matthew  1183:         $second.options[i].text = texts[i];
                   1184:         if (values[i] == select2def) {
                   1185:             $second.options[i].selected = true;
                   1186:         }
                   1187:     }
                   1188: }
1.824     bisitz   1189: // ]]>
1.36      matthew  1190: </script>
                   1191: END
                   1192:     # output the initial values for the selection lists
1.1115    raeburn  1193:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609     raeburn  1194:     my @order = sort(keys(%{$hashref}));
                   1195:     if (ref($menuorder) eq 'ARRAY') {
                   1196:         @order = @{$menuorder};
                   1197:     }
                   1198:     foreach my $value (@order) {
1.36      matthew  1199:         $result.="    <option value=\"$value\" ";
1.253     albertel 1200:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1201:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1202:     }
                   1203:     $result .= "</select>\n";
                   1204:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1205:     $result .= $middletext;
1.1115    raeburn  1206:     $result .= "<select size=\"1\" name=\"$secondselectname\"";
                   1207:     if ($onchangesecond) {
                   1208:         $result .= ' onchange="'.$onchangesecond.'"';
                   1209:     }
                   1210:     $result .= ">\n";
1.36      matthew  1211:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1212:     
                   1213:     my @secondorder = sort(keys(%select2));
                   1214:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1215:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1216:     }
                   1217:     foreach my $value (@secondorder) {
1.36      matthew  1218:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1219:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1220:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1221:     }
                   1222:     $result .= "</select>\n";
                   1223:     #    return $debug;
                   1224:     return $result;
                   1225: }   #  end of sub linked_select_forms {
                   1226: 
1.45      matthew  1227: =pod
1.44      bowersj2 1228: 
1.973     raeburn  1229: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1230: 
1.112     bowersj2 1231: Returns a string corresponding to an HTML link to the given help
                   1232: $topic, where $topic corresponds to the name of a .tex file in
                   1233: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1234: spaces. 
                   1235: 
                   1236: $text will optionally be linked to the same topic, allowing you to
                   1237: link text in addition to the graphic. If you do not want to link
                   1238: text, but wish to specify one of the later parameters, pass an
                   1239: empty string. 
                   1240: 
                   1241: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1242: the link will not open a new window. If false, the link will open
                   1243: a new window using Javascript. (Default is false.) 
                   1244: 
                   1245: $width and $height are optional numerical parameters that will
                   1246: override the width and height of the popped up window, which may
1.973     raeburn  1247: be useful for certain help topics with big pictures included.
                   1248: 
                   1249: $imgid is the id of the img tag used for the help icon. This may be
                   1250: used in a javascript call to switch the image src.  See 
                   1251: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1252: 
                   1253: =cut
                   1254: 
                   1255: sub help_open_topic {
1.973     raeburn  1256:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1257:     $text = "" if (not defined $text);
1.44      bowersj2 1258:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1259:     $width = 500 if (not defined $width);
1.44      bowersj2 1260:     $height = 400 if (not defined $height);
                   1261:     my $filename = $topic;
                   1262:     $filename =~ s/ /_/g;
                   1263: 
1.48      bowersj2 1264:     my $template = "";
                   1265:     my $link;
1.572     banghart 1266:     
1.159     www      1267:     $topic=~s/\W/\_/g;
1.44      bowersj2 1268: 
1.572     banghart 1269:     if (!$stayOnPage) {
1.1033    www      1270: 	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037    www      1271:     } elsif ($stayOnPage eq 'popup') {
                   1272:         $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 1273:     } else {
1.48      bowersj2 1274: 	$link = "/adm/help/${filename}.hlp";
                   1275:     }
                   1276: 
                   1277:     # Add the text
1.755     neumanie 1278:     if ($text ne "") {	
1.763     bisitz   1279: 	$template.='<span class="LC_help_open_topic">'
                   1280:                   .'<a target="_top" href="'.$link.'">'
                   1281:                   .$text.'</a>';
1.48      bowersj2 1282:     }
                   1283: 
1.763     bisitz   1284:     # (Always) Add the graphic
1.179     matthew  1285:     my $title = &mt('Online Help');
1.667     raeburn  1286:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1287:     if ($imgid ne '') {
                   1288:         $imgid = ' id="'.$imgid.'"';
                   1289:     }
1.763     bisitz   1290:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1291:               .'<img src="'.$helpicon.'" border="0"'
                   1292:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1293:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1294:               .' /></a>';
                   1295:     if ($text ne "") {	
                   1296:         $template.='</span>';
                   1297:     }
1.44      bowersj2 1298:     return $template;
                   1299: 
1.106     bowersj2 1300: }
                   1301: 
                   1302: # This is a quicky function for Latex cheatsheet editing, since it 
                   1303: # appears in at least four places
                   1304: sub helpLatexCheatsheet {
1.1037    www      1305:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1306:     my $out;
1.106     bowersj2 1307:     my $addOther = '';
1.732     raeburn  1308:     if ($topic) {
1.1037    www      1309: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1310:     }
                   1311:     $out = '<span>' # Start cheatsheet
                   1312: 	  .$addOther
                   1313:           .'<span>'
1.1037    www      1314: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1315: 	  .'</span> <span>'
1.1037    www      1316: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1317: 	  .'</span>';
1.732     raeburn  1318:     unless ($not_author) {
1.763     bisitz   1319:         $out .= ' <span>'
1.1037    www      1320: 	       .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.763     bisitz   1321: 	       .'</span>';
1.732     raeburn  1322:     }
1.763     bisitz   1323:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1324:     return $out;
1.172     www      1325: }
                   1326: 
1.430     albertel 1327: sub general_help {
                   1328:     my $helptopic='Student_Intro';
                   1329:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1330: 	$helptopic='Authoring_Intro';
1.907     raeburn  1331:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1332: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1333:     } elsif ($env{'request.role'}=~/^dc/) {
                   1334:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1335:     }
                   1336:     return $helptopic;
                   1337: }
                   1338: 
                   1339: sub update_help_link {
                   1340:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1341:     my $origurl = $ENV{'REQUEST_URI'};
                   1342:     $origurl=~s|^/~|/priv/|;
                   1343:     my $timestamp = time;
                   1344:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1345:         $$datum = &escape($$datum);
                   1346:     }
                   1347: 
                   1348:     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";
                   1349:     my $output .= <<"ENDOUTPUT";
                   1350: <script type="text/javascript">
1.824     bisitz   1351: // <![CDATA[
1.430     albertel 1352: banner_link = '$banner_link';
1.824     bisitz   1353: // ]]>
1.430     albertel 1354: </script>
                   1355: ENDOUTPUT
                   1356:     return $output;
                   1357: }
                   1358: 
                   1359: # now just updates the help link and generates a blue icon
1.193     raeburn  1360: sub help_open_menu {
1.430     albertel 1361:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1362: 	= @_;    
1.949     droeschl 1363:     $stayOnPage = 1;
1.430     albertel 1364:     my $output;
                   1365:     if ($component_help) {
                   1366: 	if (!$text) {
                   1367: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1368: 				       $width,$height);
                   1369: 	} else {
                   1370: 	    my $help_text;
                   1371: 	    $help_text=&unescape($topic);
                   1372: 	    $output='<table><tr><td>'.
                   1373: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1374: 				 $width,$height).'</td></tr></table>';
                   1375: 	}
                   1376:     }
                   1377:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1378:     return $output.$banner_link;
                   1379: }
                   1380: 
                   1381: sub top_nav_help {
                   1382:     my ($text) = @_;
1.436     albertel 1383:     $text = &mt($text);
1.949     droeschl 1384:     my $stay_on_page = 1;
                   1385: 
1.1168    raeburn  1386:     my ($link,$banner_link);
                   1387:     unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
                   1388:         $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                   1389: 	                         : "javascript:helpMenu('open')";
                   1390:         $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
                   1391:     }
1.201     raeburn  1392:     my $title = &mt('Get help');
1.1168    raeburn  1393:     if ($link) {
                   1394:         return <<"END";
1.436     albertel 1395: $banner_link
1.1159    raeburn  1396: <a href="$link" title="$title">$text</a>
1.436     albertel 1397: END
1.1168    raeburn  1398:     } else {
                   1399:         return '&nbsp;'.$text.'&nbsp;';
                   1400:     }
1.436     albertel 1401: }
                   1402: 
                   1403: sub help_menu_js {
1.1154    raeburn  1404:     my ($httphost) = @_;
1.949     droeschl 1405:     my $stayOnPage = 1;
1.436     albertel 1406:     my $width = 620;
                   1407:     my $height = 600;
1.430     albertel 1408:     my $helptopic=&general_help();
1.1154    raeburn  1409:     my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1410:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1411:     my $start_page =
                   1412:         &Apache::loncommon::start_page('Help Menu', undef,
                   1413: 				       {'frameset'    => 1,
                   1414: 					'js_ready'    => 1,
1.1154    raeburn  1415:                                         'use_absolute' => $httphost,
1.331     albertel 1416: 					'add_entries' => {
1.1168    raeburn  1417: 					    'border' => '0', 
1.579     raeburn  1418: 					    'rows'   => "110,*",},});
1.331     albertel 1419:     my $end_page =
                   1420:         &Apache::loncommon::end_page({'frameset' => 1,
                   1421: 				      'js_ready' => 1,});
                   1422: 
1.436     albertel 1423:     my $template .= <<"ENDTEMPLATE";
                   1424: <script type="text/javascript">
1.877     bisitz   1425: // <![CDATA[
1.253     albertel 1426: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1427: var banner_link = '';
1.243     raeburn  1428: function helpMenu(target) {
                   1429:     var caller = this;
                   1430:     if (target == 'open') {
                   1431:         var newWindow = null;
                   1432:         try {
1.262     albertel 1433:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1434:         }
                   1435:         catch(error) {
                   1436:             writeHelp(caller);
                   1437:             return;
                   1438:         }
                   1439:         if (newWindow) {
                   1440:             caller = newWindow;
                   1441:         }
1.193     raeburn  1442:     }
1.243     raeburn  1443:     writeHelp(caller);
                   1444:     return;
                   1445: }
                   1446: function writeHelp(caller) {
1.1168    raeburn  1447:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
                   1448:     caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
                   1449:     caller.document.close();
                   1450:     caller.focus();
1.193     raeburn  1451: }
1.877     bisitz   1452: // END LON-CAPA Internal -->
1.253     albertel 1453: // ]]>
1.436     albertel 1454: </script>
1.193     raeburn  1455: ENDTEMPLATE
                   1456:     return $template;
                   1457: }
                   1458: 
1.172     www      1459: sub help_open_bug {
                   1460:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1461:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1462:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1463:     $text = "" if (not defined $text);
                   1464: 	$stayOnPage=1;
1.184     albertel 1465:     $width = 600 if (not defined $width);
                   1466:     $height = 600 if (not defined $height);
1.172     www      1467: 
                   1468:     $topic=~s/\W+/\+/g;
                   1469:     my $link='';
                   1470:     my $template='';
1.379     albertel 1471:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1472: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1473:     if (!$stayOnPage)
                   1474:     {
                   1475: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1476:     }
                   1477:     else
                   1478:     {
                   1479: 	$link = $url;
                   1480:     }
                   1481:     # Add the text
                   1482:     if ($text ne "")
                   1483:     {
                   1484: 	$template .= 
                   1485:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1486:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1487:     }
                   1488: 
                   1489:     # Add the graphic
1.179     matthew  1490:     my $title = &mt('Report a Bug');
1.215     albertel 1491:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1492:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1493:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1494: ENDTEMPLATE
                   1495:     if ($text ne '') { $template.='</td></tr></table>' };
                   1496:     return $template;
                   1497: 
                   1498: }
                   1499: 
                   1500: sub help_open_faq {
                   1501:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1502:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1503:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1504:     $text = "" if (not defined $text);
                   1505: 	$stayOnPage=1;
                   1506:     $width = 350 if (not defined $width);
                   1507:     $height = 400 if (not defined $height);
                   1508: 
                   1509:     $topic=~s/\W+/\+/g;
                   1510:     my $link='';
                   1511:     my $template='';
                   1512:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1513:     if (!$stayOnPage)
                   1514:     {
                   1515: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1516:     }
                   1517:     else
                   1518:     {
                   1519: 	$link = $url;
                   1520:     }
                   1521: 
                   1522:     # Add the text
                   1523:     if ($text ne "")
                   1524:     {
                   1525: 	$template .= 
1.173     www      1526:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1527:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1528:     }
                   1529: 
                   1530:     # Add the graphic
1.179     matthew  1531:     my $title = &mt('View the FAQ');
1.215     albertel 1532:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1533:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1534:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1535: ENDTEMPLATE
                   1536:     if ($text ne '') { $template.='</td></tr></table>' };
                   1537:     return $template;
                   1538: 
1.44      bowersj2 1539: }
1.37      matthew  1540: 
1.180     matthew  1541: ###############################################################
                   1542: ###############################################################
                   1543: 
1.45      matthew  1544: =pod
                   1545: 
1.648     raeburn  1546: =item * &change_content_javascript():
1.256     matthew  1547: 
                   1548: This and the next function allow you to create small sections of an
                   1549: otherwise static HTML page that you can update on the fly with
                   1550: Javascript, even in Netscape 4.
                   1551: 
                   1552: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1553: must be written to the HTML page once. It will prove the Javascript
                   1554: function "change(name, content)". Calling the change function with the
                   1555: name of the section 
                   1556: you want to update, matching the name passed to C<changable_area>, and
                   1557: the new content you want to put in there, will put the content into
                   1558: that area.
                   1559: 
                   1560: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1561: to contain room for the original contents. You need to "make space"
                   1562: for whatever changes you wish to make, and be B<sure> to check your
                   1563: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1564: it's adequate for updating a one-line status display, but little more.
                   1565: This script will set the space to 100% width, so you only need to
                   1566: worry about height in Netscape 4.
                   1567: 
                   1568: Modern browsers are much less limiting, and if you can commit to the
                   1569: user not using Netscape 4, this feature may be used freely with
                   1570: pretty much any HTML.
                   1571: 
                   1572: =cut
                   1573: 
                   1574: sub change_content_javascript {
                   1575:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1576:     if ($env{'browser.type'} eq 'netscape' &&
                   1577: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1578: 	return (<<NETSCAPE4);
                   1579: 	function change(name, content) {
                   1580: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1581: 	    doc.open();
                   1582: 	    doc.write(content);
                   1583: 	    doc.close();
                   1584: 	}
                   1585: NETSCAPE4
                   1586:     } else {
                   1587: 	# Otherwise, we need to use semi-standards-compliant code
                   1588: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1589: 	# is really scary, and every useful browser supports it
                   1590: 	return (<<DOMBASED);
                   1591: 	function change(name, content) {
                   1592: 	    element = document.getElementById(name);
                   1593: 	    element.innerHTML = content;
                   1594: 	}
                   1595: DOMBASED
                   1596:     }
                   1597: }
                   1598: 
                   1599: =pod
                   1600: 
1.648     raeburn  1601: =item * &changable_area($name,$origContent):
1.256     matthew  1602: 
                   1603: This provides a "changable area" that can be modified on the fly via
                   1604: the Javascript code provided in C<change_content_javascript>. $name is
                   1605: the name you will use to reference the area later; do not repeat the
                   1606: same name on a given HTML page more then once. $origContent is what
                   1607: the area will originally contain, which can be left blank.
                   1608: 
                   1609: =cut
                   1610: 
                   1611: sub changable_area {
                   1612:     my ($name, $origContent) = @_;
                   1613: 
1.258     albertel 1614:     if ($env{'browser.type'} eq 'netscape' &&
                   1615: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1616: 	# If this is netscape 4, we need to use the Layer tag
                   1617: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1618:     } else {
                   1619: 	return "<span id='$name'>$origContent</span>";
                   1620:     }
                   1621: }
                   1622: 
                   1623: =pod
                   1624: 
1.648     raeburn  1625: =item * &viewport_geometry_js 
1.590     raeburn  1626: 
                   1627: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1628: 
                   1629: =cut
                   1630: 
                   1631: 
                   1632: sub viewport_geometry_js { 
                   1633:     return <<"GEOMETRY";
                   1634: var Geometry = {};
                   1635: function init_geometry() {
                   1636:     if (Geometry.init) { return };
                   1637:     Geometry.init=1;
                   1638:     if (window.innerHeight) {
                   1639:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1640:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1641:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1642:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1643:     }
                   1644:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1645:         Geometry.getViewportHeight =
                   1646:             function() { return document.documentElement.clientHeight; };
                   1647:         Geometry.getViewportWidth =
                   1648:             function() { return document.documentElement.clientWidth; };
                   1649: 
                   1650:         Geometry.getHorizontalScroll =
                   1651:             function() { return document.documentElement.scrollLeft; };
                   1652:         Geometry.getVerticalScroll =
                   1653:             function() { return document.documentElement.scrollTop; };
                   1654:     }
                   1655:     else if (document.body.clientHeight) {
                   1656:         Geometry.getViewportHeight =
                   1657:             function() { return document.body.clientHeight; };
                   1658:         Geometry.getViewportWidth =
                   1659:             function() { return document.body.clientWidth; };
                   1660:         Geometry.getHorizontalScroll =
                   1661:             function() { return document.body.scrollLeft; };
                   1662:         Geometry.getVerticalScroll =
                   1663:             function() { return document.body.scrollTop; };
                   1664:     }
                   1665: }
                   1666: 
                   1667: GEOMETRY
                   1668: }
                   1669: 
                   1670: =pod
                   1671: 
1.648     raeburn  1672: =item * &viewport_size_js()
1.590     raeburn  1673: 
                   1674: 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. 
                   1675: 
                   1676: =cut
                   1677: 
                   1678: sub viewport_size_js {
                   1679:     my $geometry = &viewport_geometry_js();
                   1680:     return <<"DIMS";
                   1681: 
                   1682: $geometry
                   1683: 
                   1684: function getViewportDims(width,height) {
                   1685:     init_geometry();
                   1686:     width.value = Geometry.getViewportWidth();
                   1687:     height.value = Geometry.getViewportHeight();
                   1688:     return;
                   1689: }
                   1690: 
                   1691: DIMS
                   1692: }
                   1693: 
                   1694: =pod
                   1695: 
1.648     raeburn  1696: =item * &resize_textarea_js()
1.565     albertel 1697: 
                   1698: emits the needed javascript to resize a textarea to be as big as possible
                   1699: 
                   1700: creates a function resize_textrea that takes two IDs first should be
                   1701: the id of the element to resize, second should be the id of a div that
                   1702: surrounds everything that comes after the textarea, this routine needs
                   1703: to be attached to the <body> for the onload and onresize events.
                   1704: 
1.648     raeburn  1705: =back
1.565     albertel 1706: 
                   1707: =cut
                   1708: 
                   1709: sub resize_textarea_js {
1.590     raeburn  1710:     my $geometry = &viewport_geometry_js();
1.565     albertel 1711:     return <<"RESIZE";
                   1712:     <script type="text/javascript">
1.824     bisitz   1713: // <![CDATA[
1.590     raeburn  1714: $geometry
1.565     albertel 1715: 
1.588     albertel 1716: function getX(element) {
                   1717:     var x = 0;
                   1718:     while (element) {
                   1719: 	x += element.offsetLeft;
                   1720: 	element = element.offsetParent;
                   1721:     }
                   1722:     return x;
                   1723: }
                   1724: function getY(element) {
                   1725:     var y = 0;
                   1726:     while (element) {
                   1727: 	y += element.offsetTop;
                   1728: 	element = element.offsetParent;
                   1729:     }
                   1730:     return y;
                   1731: }
                   1732: 
                   1733: 
1.565     albertel 1734: function resize_textarea(textarea_id,bottom_id) {
                   1735:     init_geometry();
                   1736:     var textarea        = document.getElementById(textarea_id);
                   1737:     //alert(textarea);
                   1738: 
1.588     albertel 1739:     var textarea_top    = getY(textarea);
1.565     albertel 1740:     var textarea_height = textarea.offsetHeight;
                   1741:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1742:     var bottom_top      = getY(bottom);
1.565     albertel 1743:     var bottom_height   = bottom.offsetHeight;
                   1744:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1745:     var fudge           = 23;
1.565     albertel 1746:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1747:     if (new_height < 300) {
                   1748: 	new_height = 300;
                   1749:     }
                   1750:     textarea.style.height=new_height+'px';
                   1751: }
1.824     bisitz   1752: // ]]>
1.565     albertel 1753: </script>
                   1754: RESIZE
                   1755: 
                   1756: }
                   1757: 
                   1758: =pod
                   1759: 
1.256     matthew  1760: =head1 Excel and CSV file utility routines
                   1761: 
                   1762: =cut
                   1763: 
                   1764: ###############################################################
                   1765: ###############################################################
                   1766: 
                   1767: =pod
                   1768: 
1.1162    raeburn  1769: =over 4
                   1770: 
1.648     raeburn  1771: =item * &csv_translate($text) 
1.37      matthew  1772: 
1.185     www      1773: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1774: format.
                   1775: 
                   1776: =cut
                   1777: 
1.180     matthew  1778: ###############################################################
                   1779: ###############################################################
1.37      matthew  1780: sub csv_translate {
                   1781:     my $text = shift;
                   1782:     $text =~ s/\"/\"\"/g;
1.209     albertel 1783:     $text =~ s/\n/ /g;
1.37      matthew  1784:     return $text;
                   1785: }
1.180     matthew  1786: 
                   1787: ###############################################################
                   1788: ###############################################################
                   1789: 
                   1790: =pod
                   1791: 
1.648     raeburn  1792: =item * &define_excel_formats()
1.180     matthew  1793: 
                   1794: Define some commonly used Excel cell formats.
                   1795: 
                   1796: Currently supported formats:
                   1797: 
                   1798: =over 4
                   1799: 
                   1800: =item header
                   1801: 
                   1802: =item bold
                   1803: 
                   1804: =item h1
                   1805: 
                   1806: =item h2
                   1807: 
                   1808: =item h3
                   1809: 
1.256     matthew  1810: =item h4
                   1811: 
                   1812: =item i
                   1813: 
1.180     matthew  1814: =item date
                   1815: 
                   1816: =back
                   1817: 
                   1818: Inputs: $workbook
                   1819: 
                   1820: Returns: $format, a hash reference.
                   1821: 
1.1057    foxr     1822: 
1.180     matthew  1823: =cut
                   1824: 
                   1825: ###############################################################
                   1826: ###############################################################
                   1827: sub define_excel_formats {
                   1828:     my ($workbook) = @_;
                   1829:     my $format;
                   1830:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1831:                                                 bottom    => 1,
                   1832:                                                 align     => 'center');
                   1833:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1834:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1835:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1836:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1837:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1838:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1839:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1840:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1841:     return $format;
                   1842: }
                   1843: 
                   1844: ###############################################################
                   1845: ###############################################################
1.113     bowersj2 1846: 
                   1847: =pod
                   1848: 
1.648     raeburn  1849: =item * &create_workbook()
1.255     matthew  1850: 
                   1851: Create an Excel worksheet.  If it fails, output message on the
                   1852: request object and return undefs.
                   1853: 
                   1854: Inputs: Apache request object
                   1855: 
                   1856: Returns (undef) on failure, 
                   1857:     Excel worksheet object, scalar with filename, and formats 
                   1858:     from &Apache::loncommon::define_excel_formats on success
                   1859: 
                   1860: =cut
                   1861: 
                   1862: ###############################################################
                   1863: ###############################################################
                   1864: sub create_workbook {
                   1865:     my ($r) = @_;
                   1866:         #
                   1867:     # Create the excel spreadsheet
                   1868:     my $filename = '/prtspool/'.
1.258     albertel 1869:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1870:         time.'_'.rand(1000000000).'.xls';
                   1871:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1872:     if (! defined($workbook)) {
                   1873:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1874:         $r->print(
                   1875:             '<p class="LC_error">'
                   1876:            .&mt('Problems occurred in creating the new Excel file.')
                   1877:            .' '.&mt('This error has been logged.')
                   1878:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1879:            .'</p>'
                   1880:         );
1.255     matthew  1881:         return (undef);
                   1882:     }
                   1883:     #
1.1014    foxr     1884:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  1885:     #
                   1886:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1887:     return ($workbook,$filename,$format);
                   1888: }
                   1889: 
                   1890: ###############################################################
                   1891: ###############################################################
                   1892: 
                   1893: =pod
                   1894: 
1.648     raeburn  1895: =item * &create_text_file()
1.113     bowersj2 1896: 
1.542     raeburn  1897: Create a file to write to and eventually make available to the user.
1.256     matthew  1898: If file creation fails, outputs an error message on the request object and 
                   1899: return undefs.
1.113     bowersj2 1900: 
1.256     matthew  1901: Inputs: Apache request object, and file suffix
1.113     bowersj2 1902: 
1.256     matthew  1903: Returns (undef) on failure, 
                   1904:     Filehandle and filename on success.
1.113     bowersj2 1905: 
                   1906: =cut
                   1907: 
1.256     matthew  1908: ###############################################################
                   1909: ###############################################################
                   1910: sub create_text_file {
                   1911:     my ($r,$suffix) = @_;
                   1912:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1913:     my $fh;
                   1914:     my $filename = '/prtspool/'.
1.258     albertel 1915:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1916:         time.'_'.rand(1000000000).'.'.$suffix;
                   1917:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1918:     if (! defined($fh)) {
                   1919:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1920:         $r->print(
                   1921:             '<p class="LC_error">'
                   1922:            .&mt('Problems occurred in creating the output file.')
                   1923:            .' '.&mt('This error has been logged.')
                   1924:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1925:            .'</p>'
                   1926:         );
1.113     bowersj2 1927:     }
1.256     matthew  1928:     return ($fh,$filename)
1.113     bowersj2 1929: }
                   1930: 
                   1931: 
1.256     matthew  1932: =pod 
1.113     bowersj2 1933: 
                   1934: =back
                   1935: 
                   1936: =cut
1.37      matthew  1937: 
                   1938: ###############################################################
1.33      matthew  1939: ##        Home server <option> list generating code          ##
                   1940: ###############################################################
1.35      matthew  1941: 
1.169     www      1942: # ------------------------------------------
                   1943: 
                   1944: sub domain_select {
                   1945:     my ($name,$value,$multiple)=@_;
                   1946:     my %domains=map { 
1.514     albertel 1947: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1948:     } &Apache::lonnet::all_domains();
1.169     www      1949:     if ($multiple) {
                   1950: 	$domains{''}=&mt('Any domain');
1.550     albertel 1951: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1952: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1953:     } else {
1.550     albertel 1954: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1955: 	return &select_form($name,$value,\%domains);
1.169     www      1956:     }
                   1957: }
                   1958: 
1.282     albertel 1959: #-------------------------------------------
                   1960: 
                   1961: =pod
                   1962: 
1.519     raeburn  1963: =head1 Routines for form select boxes
                   1964: 
                   1965: =over 4
                   1966: 
1.648     raeburn  1967: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1968: 
                   1969: Returns a string containing a <select> element int multiple mode
                   1970: 
                   1971: 
                   1972: Args:
                   1973:   $name - name of the <select> element
1.506     raeburn  1974:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1975:   $size - number of rows long the select element is
1.283     albertel 1976:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1977:           (shown text should already have been &mt())
1.506     raeburn  1978:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1979: 
1.282     albertel 1980: =cut
                   1981: 
                   1982: #-------------------------------------------
1.169     www      1983: sub multiple_select_form {
1.284     albertel 1984:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1985:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1986:     my $output='';
1.191     matthew  1987:     if (! defined($size)) {
                   1988:         $size = 4;
1.283     albertel 1989:         if (scalar(keys(%$hash))<4) {
                   1990:             $size = scalar(keys(%$hash));
1.191     matthew  1991:         }
                   1992:     }
1.734     bisitz   1993:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1994:     my @order;
1.506     raeburn  1995:     if (ref($order) eq 'ARRAY')  {
                   1996:         @order = @{$order};
                   1997:     } else {
                   1998:         @order = sort(keys(%$hash));
1.501     banghart 1999:     }
                   2000:     if (exists($$hash{'select_form_order'})) {
                   2001:         @order = @{$$hash{'select_form_order'}};
                   2002:     }
                   2003:         
1.284     albertel 2004:     foreach my $key (@order) {
1.356     albertel 2005:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 2006:         $output.='selected="selected" ' if ($selected{$key});
                   2007:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      2008:     }
                   2009:     $output.="</select>\n";
                   2010:     return $output;
                   2011: }
                   2012: 
1.88      www      2013: #-------------------------------------------
                   2014: 
                   2015: =pod
                   2016: 
1.970     raeburn  2017: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      2018: 
                   2019: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  2020: allow a user to select options from a ref to a hash containing:
                   2021: option_name => displayed text. An optional $onchange can include
                   2022: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   2023: 
1.88      www      2024: See lonrights.pm for an example invocation and use.
                   2025: 
                   2026: =cut
                   2027: 
                   2028: #-------------------------------------------
                   2029: sub select_form {
1.970     raeburn  2030:     my ($def,$name,$hashref,$onchange) = @_;
                   2031:     return unless (ref($hashref) eq 'HASH');
                   2032:     if ($onchange) {
                   2033:         $onchange = ' onchange="'.$onchange.'"';
                   2034:     }
                   2035:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 2036:     my @keys;
1.970     raeburn  2037:     if (exists($hashref->{'select_form_order'})) {
                   2038: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2039:     } else {
1.970     raeburn  2040: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2041:     }
1.356     albertel 2042:     foreach my $key (@keys) {
                   2043:         $selectform.=
                   2044: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2045:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2046:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2047:     }
                   2048:     $selectform.="</select>";
                   2049:     return $selectform;
                   2050: }
                   2051: 
1.475     www      2052: # For display filters
                   2053: 
                   2054: sub display_filter {
1.1074    raeburn  2055:     my ($context) = @_;
1.475     www      2056:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2057:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2058:     my $phraseinput = 'hidden';
                   2059:     my $includeinput = 'hidden';
                   2060:     my ($checked,$includetypestext);
                   2061:     if ($env{'form.displayfilter'} eq 'containing') {
                   2062:         $phraseinput = 'text'; 
                   2063:         if ($context eq 'parmslog') {
                   2064:             $includeinput = 'checkbox';
                   2065:             if ($env{'form.includetypes'}) {
                   2066:                 $checked = ' checked="checked"';
                   2067:             }
                   2068:             $includetypestext = &mt('Include parameter types');
                   2069:         }
                   2070:     } else {
                   2071:         $includetypestext = '&nbsp;';
                   2072:     }
                   2073:     my ($additional,$secondid,$thirdid);
                   2074:     if ($context eq 'parmslog') {
                   2075:         $additional = 
                   2076:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2077:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2078:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2079:             '</label>';
                   2080:         $secondid = 'includetypes';
                   2081:         $thirdid = 'includetypestext';
                   2082:     }
                   2083:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2084:                                                     '$secondid','$thirdid')";
                   2085:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2086: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2087: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2088: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2089:            &mt('Filter: [_1]',
1.477     www      2090: 	   &select_form($env{'form.displayfilter'},
                   2091: 			'displayfilter',
1.970     raeburn  2092: 			{'currentfolder' => 'Current folder/page',
1.477     www      2093: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2094: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2095: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2096:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2097:                          '" />'.$additional;
                   2098: }
                   2099: 
                   2100: sub display_filter_js {
                   2101:     my $includetext = &mt('Include parameter types');
                   2102:     return <<"ENDJS";
                   2103:   
                   2104: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2105:     var firstType = 'hidden';
                   2106:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2107:         firstType = 'text';
                   2108:     }
                   2109:     firstObject = document.getElementById(firstid);
                   2110:     if (typeof(firstObject) == 'object') {
                   2111:         if (firstObject.type != firstType) {
                   2112:             changeInputType(firstObject,firstType);
                   2113:         }
                   2114:     }
                   2115:     if (context == 'parmslog') {
                   2116:         var secondType = 'hidden';
                   2117:         if (firstType == 'text') {
                   2118:             secondType = 'checkbox';
                   2119:         }
                   2120:         secondObject = document.getElementById(secondid);  
                   2121:         if (typeof(secondObject) == 'object') {
                   2122:             if (secondObject.type != secondType) {
                   2123:                 changeInputType(secondObject,secondType);
                   2124:             }
                   2125:         }
                   2126:         var textItem = document.getElementById(thirdid);
                   2127:         var currtext = textItem.innerHTML;
                   2128:         var newtext;
                   2129:         if (firstType == 'text') {
                   2130:             newtext = '$includetext';
                   2131:         } else {
                   2132:             newtext = '&nbsp;';
                   2133:         }
                   2134:         if (currtext != newtext) {
                   2135:             textItem.innerHTML = newtext;
                   2136:         }
                   2137:     }
                   2138:     return;
                   2139: }
                   2140: 
                   2141: function changeInputType(oldObject,newType) {
                   2142:     var newObject = document.createElement('input');
                   2143:     newObject.type = newType;
                   2144:     if (oldObject.size) {
                   2145:         newObject.size = oldObject.size;
                   2146:     }
                   2147:     if (oldObject.value) {
                   2148:         newObject.value = oldObject.value;
                   2149:     }
                   2150:     if (oldObject.name) {
                   2151:         newObject.name = oldObject.name;
                   2152:     }
                   2153:     if (oldObject.id) {
                   2154:         newObject.id = oldObject.id;
                   2155:     }
                   2156:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2157:     return;
                   2158: }
                   2159: 
                   2160: ENDJS
1.475     www      2161: }
                   2162: 
1.167     www      2163: sub gradeleveldescription {
                   2164:     my $gradelevel=shift;
                   2165:     my %gradelevels=(0 => 'Not specified',
                   2166: 		     1 => 'Grade 1',
                   2167: 		     2 => 'Grade 2',
                   2168: 		     3 => 'Grade 3',
                   2169: 		     4 => 'Grade 4',
                   2170: 		     5 => 'Grade 5',
                   2171: 		     6 => 'Grade 6',
                   2172: 		     7 => 'Grade 7',
                   2173: 		     8 => 'Grade 8',
                   2174: 		     9 => 'Grade 9',
                   2175: 		     10 => 'Grade 10',
                   2176: 		     11 => 'Grade 11',
                   2177: 		     12 => 'Grade 12',
                   2178: 		     13 => 'Grade 13',
                   2179: 		     14 => '100 Level',
                   2180: 		     15 => '200 Level',
                   2181: 		     16 => '300 Level',
                   2182: 		     17 => '400 Level',
                   2183: 		     18 => 'Graduate Level');
                   2184:     return &mt($gradelevels{$gradelevel});
                   2185: }
                   2186: 
1.163     www      2187: sub select_level_form {
                   2188:     my ($deflevel,$name)=@_;
                   2189:     unless ($deflevel) { $deflevel=0; }
1.167     www      2190:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2191:     for (my $i=0; $i<=18; $i++) {
                   2192:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2193:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2194:                 ">".&gradeleveldescription($i)."</option>\n";
                   2195:     }
                   2196:     $selectform.="</select>";
                   2197:     return $selectform;
1.163     www      2198: }
1.167     www      2199: 
1.35      matthew  2200: #-------------------------------------------
                   2201: 
1.45      matthew  2202: =pod
                   2203: 
1.1121    raeburn  2204: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35      matthew  2205: 
                   2206: Returns a string containing a <select name='$name' size='1'> form to 
                   2207: allow a user to select the domain to preform an operation in.  
                   2208: See loncreateuser.pm for an example invocation and use.
                   2209: 
1.90      www      2210: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2211: selected");
                   2212: 
1.743     raeburn  2213: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2214: 
1.910     raeburn  2215: 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.
                   2216: 
1.1121    raeburn  2217: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2218: 
                   2219: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563     raeburn  2220: 
1.35      matthew  2221: =cut
                   2222: 
                   2223: #-------------------------------------------
1.34      matthew  2224: sub select_dom_form {
1.1121    raeburn  2225:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872     raeburn  2226:     if ($onchange) {
1.874     raeburn  2227:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2228:     }
1.1121    raeburn  2229:     my (@domains,%exclude);
1.910     raeburn  2230:     if (ref($incdoms) eq 'ARRAY') {
                   2231:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2232:     } else {
                   2233:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2234:     }
1.90      www      2235:     if ($includeempty) { @domains=('',@domains); }
1.1121    raeburn  2236:     if (ref($excdoms) eq 'ARRAY') {
                   2237:         map { $exclude{$_} = 1; } @{$excdoms}; 
                   2238:     }
1.743     raeburn  2239:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2240:     foreach my $dom (@domains) {
1.1121    raeburn  2241:         next if ($exclude{$dom});
1.356     albertel 2242:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2243:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2244:         if ($showdomdesc) {
                   2245:             if ($dom ne '') {
                   2246:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2247:                 if ($domdesc ne '') {
                   2248:                     $selectdomain .= ' ('.$domdesc.')';
                   2249:                 }
                   2250:             } 
                   2251:         }
                   2252:         $selectdomain .= "</option>\n";
1.34      matthew  2253:     }
                   2254:     $selectdomain.="</select>";
                   2255:     return $selectdomain;
                   2256: }
                   2257: 
1.35      matthew  2258: #-------------------------------------------
                   2259: 
1.45      matthew  2260: =pod
                   2261: 
1.648     raeburn  2262: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2263: 
1.586     raeburn  2264: input: 4 arguments (two required, two optional) - 
                   2265:     $domain - domain of new user
                   2266:     $name - name of form element
                   2267:     $default - Value of 'default' causes a default item to be first 
                   2268:                             option, and selected by default. 
                   2269:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2270:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2271: output: returns 2 items: 
1.586     raeburn  2272: (a) form element which contains either:
                   2273:    (i) <select name="$name">
                   2274:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2275:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2276:        </select>
                   2277:        form item if there are multiple library servers in $domain, or
                   2278:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2279:        if there is only one library server in $domain.
                   2280: 
                   2281: (b) number of library servers found.
                   2282: 
                   2283: See loncreateuser.pm for example of use.
1.35      matthew  2284: 
                   2285: =cut
                   2286: 
                   2287: #-------------------------------------------
1.586     raeburn  2288: sub home_server_form_item {
                   2289:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2290:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2291:     my $result;
                   2292:     my $numlib = keys(%servers);
                   2293:     if ($numlib > 1) {
                   2294:         $result .= '<select name="'.$name.'" />'."\n";
                   2295:         if ($default) {
1.804     bisitz   2296:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2297:                        '</option>'."\n";
                   2298:         }
                   2299:         foreach my $hostid (sort(keys(%servers))) {
                   2300:             $result.= '<option value="'.$hostid.'">'.
                   2301: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2302:         }
                   2303:         $result .= '</select>'."\n";
                   2304:     } elsif ($numlib == 1) {
                   2305:         my $hostid;
                   2306:         foreach my $item (keys(%servers)) {
                   2307:             $hostid = $item;
                   2308:         }
                   2309:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2310:                    $hostid.'" />';
                   2311:                    if (!$hide) {
                   2312:                        $result .= $hostid.' '.$servers{$hostid};
                   2313:                    }
                   2314:                    $result .= "\n";
                   2315:     } elsif ($default) {
                   2316:         $result .= '<input type="hidden" name="'.$name.
                   2317:                    '" value="default" />';
                   2318:                    if (!$hide) {
                   2319:                        $result .= &mt('default');
                   2320:                    }
                   2321:                    $result .= "\n";
1.33      matthew  2322:     }
1.586     raeburn  2323:     return ($result,$numlib);
1.33      matthew  2324: }
1.112     bowersj2 2325: 
                   2326: =pod
                   2327: 
1.534     albertel 2328: =back 
                   2329: 
1.112     bowersj2 2330: =cut
1.87      matthew  2331: 
                   2332: ###############################################################
1.112     bowersj2 2333: ##                  Decoding User Agent                      ##
1.87      matthew  2334: ###############################################################
                   2335: 
                   2336: =pod
                   2337: 
1.112     bowersj2 2338: =head1 Decoding the User Agent
                   2339: 
                   2340: =over 4
                   2341: 
                   2342: =item * &decode_user_agent()
1.87      matthew  2343: 
                   2344: Inputs: $r
                   2345: 
                   2346: Outputs:
                   2347: 
                   2348: =over 4
                   2349: 
1.112     bowersj2 2350: =item * $httpbrowser
1.87      matthew  2351: 
1.112     bowersj2 2352: =item * $clientbrowser
1.87      matthew  2353: 
1.112     bowersj2 2354: =item * $clientversion
1.87      matthew  2355: 
1.112     bowersj2 2356: =item * $clientmathml
1.87      matthew  2357: 
1.112     bowersj2 2358: =item * $clientunicode
1.87      matthew  2359: 
1.112     bowersj2 2360: =item * $clientos
1.87      matthew  2361: 
1.1137    raeburn  2362: =item * $clientmobile
                   2363: 
1.1141    raeburn  2364: =item * $clientinfo
                   2365: 
1.87      matthew  2366: =back
                   2367: 
1.157     matthew  2368: =back 
                   2369: 
1.87      matthew  2370: =cut
                   2371: 
                   2372: ###############################################################
                   2373: ###############################################################
                   2374: sub decode_user_agent {
1.247     albertel 2375:     my ($r)=@_;
1.87      matthew  2376:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2377:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2378:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2379:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2380:     my $clientbrowser='unknown';
                   2381:     my $clientversion='0';
                   2382:     my $clientmathml='';
                   2383:     my $clientunicode='0';
1.1137    raeburn  2384:     my $clientmobile=0;
1.87      matthew  2385:     for (my $i=0;$i<=$#browsertype;$i++) {
                   2386:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   2387: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2388: 	    $clientbrowser=$bname;
                   2389:             $httpbrowser=~/$vreg/i;
                   2390: 	    $clientversion=$1;
                   2391:             $clientmathml=($clientversion>=$minv);
                   2392:             $clientunicode=($clientversion>=$univ);
                   2393: 	}
                   2394:     }
                   2395:     my $clientos='unknown';
1.1141    raeburn  2396:     my $clientinfo;
1.87      matthew  2397:     if (($httpbrowser=~/linux/i) ||
                   2398:         ($httpbrowser=~/unix/i) ||
                   2399:         ($httpbrowser=~/ux/i) ||
                   2400:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2401:     if (($httpbrowser=~/vax/i) ||
                   2402:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2403:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2404:     if (($httpbrowser=~/mac/i) ||
                   2405:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   2406:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   2407:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137    raeburn  2408:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2409:         $clientmobile=lc($1);
                   2410:     }
1.1141    raeburn  2411:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2412:         $clientinfo = 'firefox-'.$1;
                   2413:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2414:         $clientinfo = 'chromeframe-'.$1;
                   2415:     }
1.87      matthew  2416:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1141    raeburn  2417:             $clientunicode,$clientos,$clientmobile,$clientinfo);
1.87      matthew  2418: }
                   2419: 
1.32      matthew  2420: ###############################################################
                   2421: ##    Authentication changing form generation subroutines    ##
                   2422: ###############################################################
                   2423: ##
                   2424: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2425: ## hash, and have reasonable default values.
                   2426: ##
                   2427: ##    formname = the name given in the <form> tag.
1.35      matthew  2428: #-------------------------------------------
                   2429: 
1.45      matthew  2430: =pod
                   2431: 
1.112     bowersj2 2432: =head1 Authentication Routines
                   2433: 
                   2434: =over 4
                   2435: 
1.648     raeburn  2436: =item * &authform_xxxxxx()
1.35      matthew  2437: 
                   2438: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2439: handle some of the conveniences required for authentication forms.  
                   2440: This is not an optimal method, but it works.  
                   2441: 
                   2442: =over 4
                   2443: 
1.112     bowersj2 2444: =item * authform_header
1.35      matthew  2445: 
1.112     bowersj2 2446: =item * authform_authorwarning
1.35      matthew  2447: 
1.112     bowersj2 2448: =item * authform_nochange
1.35      matthew  2449: 
1.112     bowersj2 2450: =item * authform_kerberos
1.35      matthew  2451: 
1.112     bowersj2 2452: =item * authform_internal
1.35      matthew  2453: 
1.112     bowersj2 2454: =item * authform_filesystem
1.35      matthew  2455: 
                   2456: =back
                   2457: 
1.648     raeburn  2458: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2459: 
1.35      matthew  2460: =cut
                   2461: 
                   2462: #-------------------------------------------
1.32      matthew  2463: sub authform_header{  
                   2464:     my %in = (
                   2465:         formname => 'cu',
1.80      albertel 2466:         kerb_def_dom => '',
1.32      matthew  2467:         @_,
                   2468:     );
                   2469:     $in{'formname'} = 'document.' . $in{'formname'};
                   2470:     my $result='';
1.80      albertel 2471: 
                   2472: #---------------------------------------------- Code for upper case translation
                   2473:     my $Javascript_toUpperCase;
                   2474:     unless ($in{kerb_def_dom}) {
                   2475:         $Javascript_toUpperCase =<<"END";
                   2476:         switch (choice) {
                   2477:            case 'krb': currentform.elements[choicearg].value =
                   2478:                currentform.elements[choicearg].value.toUpperCase();
                   2479:                break;
                   2480:            default:
                   2481:         }
                   2482: END
                   2483:     } else {
                   2484:         $Javascript_toUpperCase = "";
                   2485:     }
                   2486: 
1.165     raeburn  2487:     my $radioval = "'nochange'";
1.591     raeburn  2488:     if (defined($in{'curr_authtype'})) {
                   2489:         if ($in{'curr_authtype'} ne '') {
                   2490:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2491:         }
1.174     matthew  2492:     }
1.165     raeburn  2493:     my $argfield = 'null';
1.591     raeburn  2494:     if (defined($in{'mode'})) {
1.165     raeburn  2495:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2496:             if (defined($in{'curr_autharg'})) {
                   2497:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2498:                     $argfield = "'$in{'curr_autharg'}'";
                   2499:                 }
                   2500:             }
                   2501:         }
                   2502:     }
                   2503: 
1.32      matthew  2504:     $result.=<<"END";
                   2505: var current = new Object();
1.165     raeburn  2506: current.radiovalue = $radioval;
                   2507: current.argfield = $argfield;
1.32      matthew  2508: 
                   2509: function changed_radio(choice,currentform) {
                   2510:     var choicearg = choice + 'arg';
                   2511:     // If a radio button in changed, we need to change the argfield
                   2512:     if (current.radiovalue != choice) {
                   2513:         current.radiovalue = choice;
                   2514:         if (current.argfield != null) {
                   2515:             currentform.elements[current.argfield].value = '';
                   2516:         }
                   2517:         if (choice == 'nochange') {
                   2518:             current.argfield = null;
                   2519:         } else {
                   2520:             current.argfield = choicearg;
                   2521:             switch(choice) {
                   2522:                 case 'krb': 
                   2523:                     currentform.elements[current.argfield].value = 
                   2524:                         "$in{'kerb_def_dom'}";
                   2525:                 break;
                   2526:               default:
                   2527:                 break;
                   2528:             }
                   2529:         }
                   2530:     }
                   2531:     return;
                   2532: }
1.22      www      2533: 
1.32      matthew  2534: function changed_text(choice,currentform) {
                   2535:     var choicearg = choice + 'arg';
                   2536:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2537:         $Javascript_toUpperCase
1.32      matthew  2538:         // clear old field
                   2539:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2540:             currentform.elements[current.argfield].value = '';
                   2541:         }
                   2542:         current.argfield = choicearg;
                   2543:     }
                   2544:     set_auth_radio_buttons(choice,currentform);
                   2545:     return;
1.20      www      2546: }
1.32      matthew  2547: 
                   2548: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2549:     var numauthchoices = currentform.login.length;
                   2550:     if (typeof numauthchoices  == "undefined") {
                   2551:         return;
                   2552:     } 
1.32      matthew  2553:     var i=0;
1.986     raeburn  2554:     while (i < numauthchoices) {
1.32      matthew  2555:         if (currentform.login[i].value == newvalue) { break; }
                   2556:         i++;
                   2557:     }
1.986     raeburn  2558:     if (i == numauthchoices) {
1.32      matthew  2559:         return;
                   2560:     }
                   2561:     current.radiovalue = newvalue;
                   2562:     currentform.login[i].checked = true;
                   2563:     return;
                   2564: }
                   2565: END
                   2566:     return $result;
                   2567: }
                   2568: 
1.1106    raeburn  2569: sub authform_authorwarning {
1.32      matthew  2570:     my $result='';
1.144     matthew  2571:     $result='<i>'.
                   2572:         &mt('As a general rule, only authors or co-authors should be '.
                   2573:             'filesystem authenticated '.
                   2574:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2575:     return $result;
                   2576: }
                   2577: 
1.1106    raeburn  2578: sub authform_nochange {
1.32      matthew  2579:     my %in = (
                   2580:               formname => 'document.cu',
                   2581:               kerb_def_dom => 'MSU.EDU',
                   2582:               @_,
                   2583:           );
1.1106    raeburn  2584:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586     raeburn  2585:     my $result;
1.1104    raeburn  2586:     if (!$authnum) {
1.1105    raeburn  2587:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2588:     } else {
                   2589:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2590:                   '<input type="radio" name="login" value="nochange" '.
                   2591:                   'checked="checked" onclick="'.
1.281     albertel 2592:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2593: 	    '</label>';
1.586     raeburn  2594:     }
1.32      matthew  2595:     return $result;
                   2596: }
                   2597: 
1.591     raeburn  2598: sub authform_kerberos {
1.32      matthew  2599:     my %in = (
                   2600:               formname => 'document.cu',
                   2601:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2602:               kerb_def_auth => 'krb4',
1.32      matthew  2603:               @_,
                   2604:               );
1.586     raeburn  2605:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2606:         $autharg,$jscall);
1.1106    raeburn  2607:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2608:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2609:        $check5 = ' checked="checked"';
1.80      albertel 2610:     } else {
1.772     bisitz   2611:        $check4 = ' checked="checked"';
1.80      albertel 2612:     }
1.165     raeburn  2613:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2614:     if (defined($in{'curr_authtype'})) {
                   2615:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2616:             $krbcheck = ' checked="checked"';
1.623     raeburn  2617:             if (defined($in{'mode'})) {
                   2618:                 if ($in{'mode'} eq 'modifyuser') {
                   2619:                     $krbcheck = '';
                   2620:                 }
                   2621:             }
1.591     raeburn  2622:             if (defined($in{'curr_kerb_ver'})) {
                   2623:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2624:                     $check5 = ' checked="checked"';
1.591     raeburn  2625:                     $check4 = '';
                   2626:                 } else {
1.772     bisitz   2627:                     $check4 = ' checked="checked"';
1.591     raeburn  2628:                     $check5 = '';
                   2629:                 }
1.586     raeburn  2630:             }
1.591     raeburn  2631:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2632:                 $krbarg = $in{'curr_autharg'};
                   2633:             }
1.586     raeburn  2634:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2635:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2636:                     $result = 
                   2637:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2638:         $in{'curr_autharg'},$krbver);
                   2639:                 } else {
                   2640:                     $result =
                   2641:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2642:                 }
                   2643:                 return $result; 
                   2644:             }
                   2645:         }
                   2646:     } else {
                   2647:         if ($authnum == 1) {
1.784     bisitz   2648:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2649:         }
                   2650:     }
1.586     raeburn  2651:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2652:         return;
1.587     raeburn  2653:     } elsif ($authtype eq '') {
1.591     raeburn  2654:         if (defined($in{'mode'})) {
1.587     raeburn  2655:             if ($in{'mode'} eq 'modifycourse') {
                   2656:                 if ($authnum == 1) {
1.1104    raeburn  2657:                     $authtype = '<input type="radio" name="login" value="krb" />';
1.587     raeburn  2658:                 }
                   2659:             }
                   2660:         }
1.586     raeburn  2661:     }
                   2662:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2663:     if ($authtype eq '') {
                   2664:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2665:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2666:                     $krbcheck.' />';
                   2667:     }
                   2668:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106    raeburn  2669:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2670:          $in{'curr_authtype'} eq 'krb5') ||
1.1106    raeburn  2671:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2672:          $in{'curr_authtype'} eq 'krb4')) {
                   2673:         $result .= &mt
1.144     matthew  2674:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2675:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2676:          '<label>'.$authtype,
1.281     albertel 2677:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2678:              'value="'.$krbarg.'" '.
1.144     matthew  2679:              'onchange="'.$jscall.'" />',
1.281     albertel 2680:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2681:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2682: 	 '</label>');
1.586     raeburn  2683:     } elsif ($can_assign{'krb4'}) {
                   2684:         $result .= &mt
                   2685:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2686:          '[_3] Version 4 [_4]',
                   2687:          '<label>'.$authtype,
                   2688:          '</label><input type="text" size="10" name="krbarg" '.
                   2689:              'value="'.$krbarg.'" '.
                   2690:              'onchange="'.$jscall.'" />',
                   2691:          '<label><input type="hidden" name="krbver" value="4" />',
                   2692:          '</label>');
                   2693:     } elsif ($can_assign{'krb5'}) {
                   2694:         $result .= &mt
                   2695:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2696:          '[_3] Version 5 [_4]',
                   2697:          '<label>'.$authtype,
                   2698:          '</label><input type="text" size="10" name="krbarg" '.
                   2699:              'value="'.$krbarg.'" '.
                   2700:              'onchange="'.$jscall.'" />',
                   2701:          '<label><input type="hidden" name="krbver" value="5" />',
                   2702:          '</label>');
                   2703:     }
1.32      matthew  2704:     return $result;
                   2705: }
                   2706: 
1.1106    raeburn  2707: sub authform_internal {
1.586     raeburn  2708:     my %in = (
1.32      matthew  2709:                 formname => 'document.cu',
                   2710:                 kerb_def_dom => 'MSU.EDU',
                   2711:                 @_,
                   2712:                 );
1.586     raeburn  2713:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  2714:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2715:     if (defined($in{'curr_authtype'})) {
                   2716:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2717:             if ($can_assign{'int'}) {
1.772     bisitz   2718:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2719:                 if (defined($in{'mode'})) {
                   2720:                     if ($in{'mode'} eq 'modifyuser') {
                   2721:                         $intcheck = '';
                   2722:                     }
                   2723:                 }
1.591     raeburn  2724:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2725:                     $intarg = $in{'curr_autharg'};
                   2726:                 }
                   2727:             } else {
                   2728:                 $result = &mt('Currently internally authenticated.');
                   2729:                 return $result;
1.165     raeburn  2730:             }
                   2731:         }
1.586     raeburn  2732:     } else {
                   2733:         if ($authnum == 1) {
1.784     bisitz   2734:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2735:         }
                   2736:     }
                   2737:     if (!$can_assign{'int'}) {
                   2738:         return;
1.587     raeburn  2739:     } elsif ($authtype eq '') {
1.591     raeburn  2740:         if (defined($in{'mode'})) {
1.587     raeburn  2741:             if ($in{'mode'} eq 'modifycourse') {
                   2742:                 if ($authnum == 1) {
1.1104    raeburn  2743:                     $authtype = '<input type="radio" name="login" value="int" />';
1.587     raeburn  2744:                 }
                   2745:             }
                   2746:         }
1.165     raeburn  2747:     }
1.586     raeburn  2748:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2749:     if ($authtype eq '') {
                   2750:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2751:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2752:     }
1.605     bisitz   2753:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2754:                $intarg.'" onchange="'.$jscall.'" />';
                   2755:     $result = &mt
1.144     matthew  2756:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2757:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2758:     $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  2759:     return $result;
                   2760: }
                   2761: 
1.1104    raeburn  2762: sub authform_local {
1.32      matthew  2763:     my %in = (
                   2764:               formname => 'document.cu',
                   2765:               kerb_def_dom => 'MSU.EDU',
                   2766:               @_,
                   2767:               );
1.586     raeburn  2768:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  2769:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2770:     if (defined($in{'curr_authtype'})) {
                   2771:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2772:             if ($can_assign{'loc'}) {
1.772     bisitz   2773:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2774:                 if (defined($in{'mode'})) {
                   2775:                     if ($in{'mode'} eq 'modifyuser') {
                   2776:                         $loccheck = '';
                   2777:                     }
                   2778:                 }
1.591     raeburn  2779:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2780:                     $locarg = $in{'curr_autharg'};
                   2781:                 }
                   2782:             } else {
                   2783:                 $result = &mt('Currently using local (institutional) authentication.');
                   2784:                 return $result;
1.165     raeburn  2785:             }
                   2786:         }
1.586     raeburn  2787:     } else {
                   2788:         if ($authnum == 1) {
1.784     bisitz   2789:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2790:         }
                   2791:     }
                   2792:     if (!$can_assign{'loc'}) {
                   2793:         return;
1.587     raeburn  2794:     } elsif ($authtype eq '') {
1.591     raeburn  2795:         if (defined($in{'mode'})) {
1.587     raeburn  2796:             if ($in{'mode'} eq 'modifycourse') {
                   2797:                 if ($authnum == 1) {
1.1104    raeburn  2798:                     $authtype = '<input type="radio" name="login" value="loc" />';
1.587     raeburn  2799:                 }
                   2800:             }
                   2801:         }
1.165     raeburn  2802:     }
1.586     raeburn  2803:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2804:     if ($authtype eq '') {
                   2805:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2806:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2807:                     $jscall.'" />';
                   2808:     }
                   2809:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2810:                $locarg.'" onchange="'.$jscall.'" />';
                   2811:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2812:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2813:     return $result;
                   2814: }
                   2815: 
1.1106    raeburn  2816: sub authform_filesystem {
1.32      matthew  2817:     my %in = (
                   2818:               formname => 'document.cu',
                   2819:               kerb_def_dom => 'MSU.EDU',
                   2820:               @_,
                   2821:               );
1.586     raeburn  2822:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  2823:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2824:     if (defined($in{'curr_authtype'})) {
                   2825:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2826:             if ($can_assign{'fsys'}) {
1.772     bisitz   2827:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2828:                 if (defined($in{'mode'})) {
                   2829:                     if ($in{'mode'} eq 'modifyuser') {
                   2830:                         $fsyscheck = '';
                   2831:                     }
                   2832:                 }
1.586     raeburn  2833:             } else {
                   2834:                 $result = &mt('Currently Filesystem Authenticated.');
                   2835:                 return $result;
                   2836:             }           
                   2837:         }
                   2838:     } else {
                   2839:         if ($authnum == 1) {
1.784     bisitz   2840:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2841:         }
                   2842:     }
                   2843:     if (!$can_assign{'fsys'}) {
                   2844:         return;
1.587     raeburn  2845:     } elsif ($authtype eq '') {
1.591     raeburn  2846:         if (defined($in{'mode'})) {
1.587     raeburn  2847:             if ($in{'mode'} eq 'modifycourse') {
                   2848:                 if ($authnum == 1) {
1.1104    raeburn  2849:                     $authtype = '<input type="radio" name="login" value="fsys" />';
1.587     raeburn  2850:                 }
                   2851:             }
                   2852:         }
1.586     raeburn  2853:     }
                   2854:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2855:     if ($authtype eq '') {
                   2856:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2857:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2858:                     $jscall.'" />';
                   2859:     }
                   2860:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2861:                ' onchange="'.$jscall.'" />';
                   2862:     $result = &mt
1.144     matthew  2863:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2864:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2865:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2866:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2867:                   'onchange="'.$jscall.'" />');
1.32      matthew  2868:     return $result;
                   2869: }
                   2870: 
1.586     raeburn  2871: sub get_assignable_auth {
                   2872:     my ($dom) = @_;
                   2873:     if ($dom eq '') {
                   2874:         $dom = $env{'request.role.domain'};
                   2875:     }
                   2876:     my %can_assign = (
                   2877:                           krb4 => 1,
                   2878:                           krb5 => 1,
                   2879:                           int  => 1,
                   2880:                           loc  => 1,
                   2881:                      );
                   2882:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2883:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2884:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2885:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2886:             my $context;
                   2887:             if ($env{'request.role'} =~ /^au/) {
                   2888:                 $context = 'author';
                   2889:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2890:                 $context = 'domain';
                   2891:             } elsif ($env{'request.course.id'}) {
                   2892:                 $context = 'course';
                   2893:             }
                   2894:             if ($context) {
                   2895:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2896:                    %can_assign = %{$authhash->{$context}}; 
                   2897:                 }
                   2898:             }
                   2899:         }
                   2900:     }
                   2901:     my $authnum = 0;
                   2902:     foreach my $key (keys(%can_assign)) {
                   2903:         if ($can_assign{$key}) {
                   2904:             $authnum ++;
                   2905:         }
                   2906:     }
                   2907:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2908:         $authnum --;
                   2909:     }
                   2910:     return ($authnum,%can_assign);
                   2911: }
                   2912: 
1.80      albertel 2913: ###############################################################
                   2914: ##    Get Kerberos Defaults for Domain                 ##
                   2915: ###############################################################
                   2916: ##
                   2917: ## Returns default kerberos version and an associated argument
                   2918: ## as listed in file domain.tab. If not listed, provides
                   2919: ## appropriate default domain and kerberos version.
                   2920: ##
                   2921: #-------------------------------------------
                   2922: 
                   2923: =pod
                   2924: 
1.648     raeburn  2925: =item * &get_kerberos_defaults()
1.80      albertel 2926: 
                   2927: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2928: version and domain. If not found, it defaults to version 4 and the 
                   2929: domain of the server.
1.80      albertel 2930: 
1.648     raeburn  2931: =over 4
                   2932: 
1.80      albertel 2933: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2934: 
1.648     raeburn  2935: =back
                   2936: 
                   2937: =back
                   2938: 
1.80      albertel 2939: =cut
                   2940: 
                   2941: #-------------------------------------------
                   2942: sub get_kerberos_defaults {
                   2943:     my $domain=shift;
1.641     raeburn  2944:     my ($krbdef,$krbdefdom);
                   2945:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2946:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2947:         $krbdef = $domdefaults{'auth_def'};
                   2948:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2949:     } else {
1.80      albertel 2950:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2951:         my $krbdefdom=$1;
                   2952:         $krbdefdom=~tr/a-z/A-Z/;
                   2953:         $krbdef = "krb4";
                   2954:     }
                   2955:     return ($krbdef,$krbdefdom);
                   2956: }
1.112     bowersj2 2957: 
1.32      matthew  2958: 
1.46      matthew  2959: ###############################################################
                   2960: ##                Thesaurus Functions                        ##
                   2961: ###############################################################
1.20      www      2962: 
1.46      matthew  2963: =pod
1.20      www      2964: 
1.112     bowersj2 2965: =head1 Thesaurus Functions
                   2966: 
                   2967: =over 4
                   2968: 
1.648     raeburn  2969: =item * &initialize_keywords()
1.46      matthew  2970: 
                   2971: Initializes the package variable %Keywords if it is empty.  Uses the
                   2972: package variable $thesaurus_db_file.
                   2973: 
                   2974: =cut
                   2975: 
                   2976: ###################################################
                   2977: 
                   2978: sub initialize_keywords {
                   2979:     return 1 if (scalar keys(%Keywords));
                   2980:     # If we are here, %Keywords is empty, so fill it up
                   2981:     #   Make sure the file we need exists...
                   2982:     if (! -e $thesaurus_db_file) {
                   2983:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2984:                                  " failed because it does not exist");
                   2985:         return 0;
                   2986:     }
                   2987:     #   Set up the hash as a database
                   2988:     my %thesaurus_db;
                   2989:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2990:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2991:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2992:                                  $thesaurus_db_file);
                   2993:         return 0;
                   2994:     } 
                   2995:     #  Get the average number of appearances of a word.
                   2996:     my $avecount = $thesaurus_db{'average.count'};
                   2997:     #  Put keywords (those that appear > average) into %Keywords
                   2998:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2999:         my ($count,undef) = split /:/,$data;
                   3000:         $Keywords{$word}++ if ($count > $avecount);
                   3001:     }
                   3002:     untie %thesaurus_db;
                   3003:     # Remove special values from %Keywords.
1.356     albertel 3004:     foreach my $value ('total.count','average.count') {
                   3005:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  3006:   }
1.46      matthew  3007:     return 1;
                   3008: }
                   3009: 
                   3010: ###################################################
                   3011: 
                   3012: =pod
                   3013: 
1.648     raeburn  3014: =item * &keyword($word)
1.46      matthew  3015: 
                   3016: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   3017: than the average number of times in the thesaurus database.  Calls 
                   3018: &initialize_keywords
                   3019: 
                   3020: =cut
                   3021: 
                   3022: ###################################################
1.20      www      3023: 
                   3024: sub keyword {
1.46      matthew  3025:     return if (!&initialize_keywords());
                   3026:     my $word=lc(shift());
                   3027:     $word=~s/\W//g;
                   3028:     return exists($Keywords{$word});
1.20      www      3029: }
1.46      matthew  3030: 
                   3031: ###############################################################
                   3032: 
                   3033: =pod 
1.20      www      3034: 
1.648     raeburn  3035: =item * &get_related_words()
1.46      matthew  3036: 
1.160     matthew  3037: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  3038: an array of words.  If the keyword is not in the thesaurus, an empty array
                   3039: will be returned.  The order of the words returned is determined by the
                   3040: database which holds them.
                   3041: 
                   3042: Uses global $thesaurus_db_file.
                   3043: 
1.1057    foxr     3044: 
1.46      matthew  3045: =cut
                   3046: 
                   3047: ###############################################################
                   3048: sub get_related_words {
                   3049:     my $keyword = shift;
                   3050:     my %thesaurus_db;
                   3051:     if (! -e $thesaurus_db_file) {
                   3052:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3053:                                  "failed because the file does not exist");
                   3054:         return ();
                   3055:     }
                   3056:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3057:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3058:         return ();
                   3059:     } 
                   3060:     my @Words=();
1.429     www      3061:     my $count=0;
1.46      matthew  3062:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3063: 	# The first element is the number of times
                   3064: 	# the word appears.  We do not need it now.
1.429     www      3065: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3066: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3067: 	my $threshold=$mostfrequentcount/10;
                   3068:         foreach my $possibleword (@RelatedWords) {
                   3069:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3070:             if ($wordcount>$threshold) {
                   3071: 		push(@Words,$word);
                   3072:                 $count++;
                   3073:                 if ($count>10) { last; }
                   3074: 	    }
1.20      www      3075:         }
                   3076:     }
1.46      matthew  3077:     untie %thesaurus_db;
                   3078:     return @Words;
1.14      harris41 3079: }
1.1090    foxr     3080: ###############################################################
                   3081: #
                   3082: #  Spell checking
                   3083: #
                   3084: 
                   3085: =pod
                   3086: 
1.1142    raeburn  3087: =back
                   3088: 
1.1090    foxr     3089: =head1 Spell checking
                   3090: 
                   3091: =over 4
                   3092: 
                   3093: =item * &check_spelling($wordlist $language)
                   3094: 
                   3095: Takes a string containing words and feeds it to an external
                   3096: spellcheck program via a pipeline. Returns a string containing
                   3097: them mis-spelled words.
                   3098: 
                   3099: Parameters:
                   3100: 
                   3101: =over 4
                   3102: 
                   3103: =item - $wordlist
                   3104: 
                   3105: String that will be fed into the spellcheck program.
                   3106: 
                   3107: =item - $language
                   3108: 
                   3109: Language string that specifies the language for which the spell
                   3110: check will be performed.
                   3111: 
                   3112: =back
                   3113: 
                   3114: =back
                   3115: 
                   3116: Note: This sub assumes that aspell is installed.
                   3117: 
                   3118: 
                   3119: =cut
                   3120: 
1.46      matthew  3121: 
1.1090    foxr     3122: sub check_spelling {
                   3123:     my ($wordlist, $language) = @_;
1.1091    foxr     3124:     my @misspellings;
                   3125:     
                   3126:     # Generate the speller and set the langauge.
                   3127:     # if explicitly selected:
1.1090    foxr     3128: 
1.1091    foxr     3129:     my $speller = Text::Aspell->new;
1.1090    foxr     3130:     if ($language) {
1.1091    foxr     3131: 	$speller->set_option('lang', $language);
1.1090    foxr     3132:     }
                   3133: 
1.1091    foxr     3134:     # Turn the word list into an array of words by splittingon whitespace
1.1090    foxr     3135: 
1.1091    foxr     3136:     my @words = split(/\s+/, $wordlist);
1.1090    foxr     3137: 
1.1091    foxr     3138:     foreach my $word (@words) {
                   3139: 	if(! $speller->check($word)) {
                   3140: 	    push(@misspellings, $word);
1.1090    foxr     3141: 	}
                   3142:     }
1.1091    foxr     3143:     return join(' ', @misspellings);
                   3144:     
1.1090    foxr     3145: }
                   3146: 
1.61      www      3147: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3148: =pod
                   3149: 
1.112     bowersj2 3150: =head1 User Name Functions
                   3151: 
                   3152: =over 4
                   3153: 
1.648     raeburn  3154: =item * &plainname($uname,$udom,$first)
1.81      albertel 3155: 
1.112     bowersj2 3156: Takes a users logon name and returns it as a string in
1.226     albertel 3157: "first middle last generation" form 
                   3158: if $first is set to 'lastname' then it returns it as
                   3159: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3160: 
                   3161: =cut
1.61      www      3162: 
1.295     www      3163: 
1.81      albertel 3164: ###############################################################
1.61      www      3165: sub plainname {
1.226     albertel 3166:     my ($uname,$udom,$first)=@_;
1.537     albertel 3167:     return if (!defined($uname) || !defined($udom));
1.295     www      3168:     my %names=&getnames($uname,$udom);
1.226     albertel 3169:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3170: 					  $names{'middlename'},
                   3171: 					  $names{'lastname'},
                   3172: 					  $names{'generation'},$first);
                   3173:     $name=~s/^\s+//;
1.62      www      3174:     $name=~s/\s+$//;
                   3175:     $name=~s/\s+/ /g;
1.353     albertel 3176:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3177:     return $name;
1.61      www      3178: }
1.66      www      3179: 
                   3180: # -------------------------------------------------------------------- Nickname
1.81      albertel 3181: =pod
                   3182: 
1.648     raeburn  3183: =item * &nickname($uname,$udom)
1.81      albertel 3184: 
                   3185: Gets a users name and returns it as a string as
                   3186: 
                   3187: "&quot;nickname&quot;"
1.66      www      3188: 
1.81      albertel 3189: if the user has a nickname or
                   3190: 
                   3191: "first middle last generation"
                   3192: 
                   3193: if the user does not
                   3194: 
                   3195: =cut
1.66      www      3196: 
                   3197: sub nickname {
                   3198:     my ($uname,$udom)=@_;
1.537     albertel 3199:     return if (!defined($uname) || !defined($udom));
1.295     www      3200:     my %names=&getnames($uname,$udom);
1.68      albertel 3201:     my $name=$names{'nickname'};
1.66      www      3202:     if ($name) {
                   3203:        $name='&quot;'.$name.'&quot;'; 
                   3204:     } else {
                   3205:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3206: 	     $names{'lastname'}.' '.$names{'generation'};
                   3207:        $name=~s/\s+$//;
                   3208:        $name=~s/\s+/ /g;
                   3209:     }
                   3210:     return $name;
                   3211: }
                   3212: 
1.295     www      3213: sub getnames {
                   3214:     my ($uname,$udom)=@_;
1.537     albertel 3215:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3216:     if ($udom eq 'public' && $uname eq 'public') {
                   3217: 	return ('lastname' => &mt('Public'));
                   3218:     }
1.295     www      3219:     my $id=$uname.':'.$udom;
                   3220:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3221:     if ($cached) {
                   3222: 	return %{$names};
                   3223:     } else {
                   3224: 	my %loadnames=&Apache::lonnet::get('environment',
                   3225:                     ['firstname','middlename','lastname','generation','nickname'],
                   3226: 					 $udom,$uname);
                   3227: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3228: 	return %loadnames;
                   3229:     }
                   3230: }
1.61      www      3231: 
1.542     raeburn  3232: # -------------------------------------------------------------------- getemails
1.648     raeburn  3233: 
1.542     raeburn  3234: =pod
                   3235: 
1.648     raeburn  3236: =item * &getemails($uname,$udom)
1.542     raeburn  3237: 
                   3238: Gets a user's email information and returns it as a hash with keys:
                   3239: notification, critnotification, permanentemail
                   3240: 
                   3241: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3242: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3243:  
1.648     raeburn  3244: 
1.542     raeburn  3245: =cut
                   3246: 
1.648     raeburn  3247: 
1.466     albertel 3248: sub getemails {
                   3249:     my ($uname,$udom)=@_;
                   3250:     if ($udom eq 'public' && $uname eq 'public') {
                   3251: 	return;
                   3252:     }
1.467     www      3253:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3254:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3255:     my $id=$uname.':'.$udom;
                   3256:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3257:     if ($cached) {
                   3258: 	return %{$names};
                   3259:     } else {
                   3260: 	my %loadnames=&Apache::lonnet::get('environment',
                   3261:                     			   ['notification','critnotification',
                   3262: 					    'permanentemail'],
                   3263: 					   $udom,$uname);
                   3264: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3265: 	return %loadnames;
                   3266:     }
                   3267: }
                   3268: 
1.551     albertel 3269: sub flush_email_cache {
                   3270:     my ($uname,$udom)=@_;
                   3271:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3272:     if (!$uname) { $uname=$env{'user.name'};   }
                   3273:     return if ($udom eq 'public' && $uname eq 'public');
                   3274:     my $id=$uname.':'.$udom;
                   3275:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3276: }
                   3277: 
1.728     raeburn  3278: # -------------------------------------------------------------------- getlangs
                   3279: 
                   3280: =pod
                   3281: 
                   3282: =item * &getlangs($uname,$udom)
                   3283: 
                   3284: Gets a user's language preference and returns it as a hash with key:
                   3285: language.
                   3286: 
                   3287: =cut
                   3288: 
                   3289: 
                   3290: sub getlangs {
                   3291:     my ($uname,$udom) = @_;
                   3292:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3293:     if (!$uname) { $uname=$env{'user.name'};   }
                   3294:     my $id=$uname.':'.$udom;
                   3295:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3296:     if ($cached) {
                   3297:         return %{$langs};
                   3298:     } else {
                   3299:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3300:                                            $udom,$uname);
                   3301:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3302:         return %loadlangs;
                   3303:     }
                   3304: }
                   3305: 
                   3306: sub flush_langs_cache {
                   3307:     my ($uname,$udom)=@_;
                   3308:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3309:     if (!$uname) { $uname=$env{'user.name'};   }
                   3310:     return if ($udom eq 'public' && $uname eq 'public');
                   3311:     my $id=$uname.':'.$udom;
                   3312:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3313: }
                   3314: 
1.61      www      3315: # ------------------------------------------------------------------ Screenname
1.81      albertel 3316: 
                   3317: =pod
                   3318: 
1.648     raeburn  3319: =item * &screenname($uname,$udom)
1.81      albertel 3320: 
                   3321: Gets a users screenname and returns it as a string
                   3322: 
                   3323: =cut
1.61      www      3324: 
                   3325: sub screenname {
                   3326:     my ($uname,$udom)=@_;
1.258     albertel 3327:     if ($uname eq $env{'user.name'} &&
                   3328: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3329:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3330:     return $names{'screenname'};
1.62      www      3331: }
                   3332: 
1.212     albertel 3333: 
1.802     bisitz   3334: # ------------------------------------------------------------- Confirm Wrapper
                   3335: =pod
                   3336: 
1.1142    raeburn  3337: =item * &confirmwrapper($message)
1.802     bisitz   3338: 
                   3339: Wrap messages about completion of operation in box
                   3340: 
                   3341: =cut
                   3342: 
                   3343: sub confirmwrapper {
                   3344:     my ($message)=@_;
                   3345:     if ($message) {
                   3346:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3347:                .$message."\n"
                   3348:                .'</div>'."\n";
                   3349:     } else {
                   3350:         return $message;
                   3351:     }
                   3352: }
                   3353: 
1.62      www      3354: # ------------------------------------------------------------- Message Wrapper
                   3355: 
                   3356: sub messagewrapper {
1.369     www      3357:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3358:     return 
1.441     albertel 3359:         '<a href="/adm/email?compose=individual&amp;'.
                   3360:         'recname='.$username.'&amp;recdom='.$domain.
                   3361: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3362:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3363: }
1.802     bisitz   3364: 
1.74      www      3365: # --------------------------------------------------------------- Notes Wrapper
                   3366: 
                   3367: sub noteswrapper {
                   3368:     my ($link,$un,$do)=@_;
                   3369:     return 
1.896     amueller 3370: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3371: }
1.802     bisitz   3372: 
1.62      www      3373: # ------------------------------------------------------------- Aboutme Wrapper
                   3374: 
                   3375: sub aboutmewrapper {
1.1070    raeburn  3376:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3377:     if (!defined($username)  && !defined($domain)) {
                   3378:         return;
                   3379:     }
1.1096    raeburn  3380:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3381: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3382: }
                   3383: 
                   3384: # ------------------------------------------------------------ Syllabus Wrapper
                   3385: 
                   3386: sub syllabuswrapper {
1.707     bisitz   3387:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3388:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3389: }
1.14      harris41 3390: 
1.802     bisitz   3391: # -----------------------------------------------------------------------------
                   3392: 
1.208     matthew  3393: sub track_student_link {
1.887     raeburn  3394:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3395:     my $link ="/adm/trackstudent?";
1.208     matthew  3396:     my $title = 'View recent activity';
                   3397:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3398:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3399:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3400:         $title .= ' of this student';
1.268     albertel 3401:     } 
1.208     matthew  3402:     if (defined($target) && $target !~ /^\s*$/) {
                   3403:         $target = qq{target="$target"};
                   3404:     } else {
                   3405:         $target = '';
                   3406:     }
1.268     albertel 3407:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3408:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3409:     $title = &mt($title);
                   3410:     $linktext = &mt($linktext);
1.448     albertel 3411:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3412: 	&help_open_topic('View_recent_activity');
1.208     matthew  3413: }
                   3414: 
1.781     raeburn  3415: sub slot_reservations_link {
                   3416:     my ($linktext,$sname,$sdom,$target) = @_;
                   3417:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3418:     my $title = 'View slot reservation history';
                   3419:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3420:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3421:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3422:         $title .= ' of this student';
                   3423:     }
                   3424:     if (defined($target) && $target !~ /^\s*$/) {
                   3425:         $target = qq{target="$target"};
                   3426:     } else {
                   3427:         $target = '';
                   3428:     }
                   3429:     $title = &mt($title);
                   3430:     $linktext = &mt($linktext);
                   3431:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3432: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3433: 
                   3434: }
                   3435: 
1.508     www      3436: # ===================================================== Display a student photo
                   3437: 
                   3438: 
1.509     albertel 3439: sub student_image_tag {
1.508     www      3440:     my ($domain,$user)=@_;
                   3441:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3442:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3443: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3444:     } else {
                   3445: 	return '';
                   3446:     }
                   3447: }
                   3448: 
1.112     bowersj2 3449: =pod
                   3450: 
                   3451: =back
                   3452: 
                   3453: =head1 Access .tab File Data
                   3454: 
                   3455: =over 4
                   3456: 
1.648     raeburn  3457: =item * &languageids() 
1.112     bowersj2 3458: 
                   3459: returns list of all language ids
                   3460: 
                   3461: =cut
                   3462: 
1.14      harris41 3463: sub languageids {
1.16      harris41 3464:     return sort(keys(%language));
1.14      harris41 3465: }
                   3466: 
1.112     bowersj2 3467: =pod
                   3468: 
1.648     raeburn  3469: =item * &languagedescription() 
1.112     bowersj2 3470: 
                   3471: returns description of a specified language id
                   3472: 
                   3473: =cut
                   3474: 
1.14      harris41 3475: sub languagedescription {
1.125     www      3476:     my $code=shift;
                   3477:     return  ($supported_language{$code}?'* ':'').
                   3478:             $language{$code}.
1.126     www      3479: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3480: }
                   3481: 
1.1048    foxr     3482: =pod
                   3483: 
                   3484: =item * &plainlanguagedescription
                   3485: 
                   3486: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3487: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3488: 
                   3489: =cut
                   3490: 
1.145     www      3491: sub plainlanguagedescription {
                   3492:     my $code=shift;
                   3493:     return $language{$code};
                   3494: }
                   3495: 
1.1048    foxr     3496: =pod
                   3497: 
                   3498: =item * &supportedlanguagecode
                   3499: 
                   3500: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3501: code.
                   3502: 
                   3503: =cut
                   3504: 
1.145     www      3505: sub supportedlanguagecode {
                   3506:     my $code=shift;
                   3507:     return $supported_language{$code};
1.97      www      3508: }
                   3509: 
1.112     bowersj2 3510: =pod
                   3511: 
1.1048    foxr     3512: =item * &latexlanguage()
                   3513: 
                   3514: Given a language key code returns the correspondnig language to use
                   3515: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3516: is no supported hyphenation for the language code.
                   3517: 
                   3518: =cut
                   3519: 
                   3520: sub latexlanguage {
                   3521:     my $code = shift;
                   3522:     return $latex_language{$code};
                   3523: }
                   3524: 
                   3525: =pod
                   3526: 
                   3527: =item * &latexhyphenation()
                   3528: 
                   3529: Same as above but what's supplied is the language as it might be stored
                   3530: in the metadata.
                   3531: 
                   3532: =cut
                   3533: 
                   3534: sub latexhyphenation {
                   3535:     my $key = shift;
                   3536:     return $latex_language_bykey{$key};
                   3537: }
                   3538: 
                   3539: =pod
                   3540: 
1.648     raeburn  3541: =item * &copyrightids() 
1.112     bowersj2 3542: 
                   3543: returns list of all copyrights
                   3544: 
                   3545: =cut
                   3546: 
                   3547: sub copyrightids {
                   3548:     return sort(keys(%cprtag));
                   3549: }
                   3550: 
                   3551: =pod
                   3552: 
1.648     raeburn  3553: =item * &copyrightdescription() 
1.112     bowersj2 3554: 
                   3555: returns description of a specified copyright id
                   3556: 
                   3557: =cut
                   3558: 
                   3559: sub copyrightdescription {
1.166     www      3560:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3561: }
1.197     matthew  3562: 
                   3563: =pod
                   3564: 
1.648     raeburn  3565: =item * &source_copyrightids() 
1.192     taceyjo1 3566: 
                   3567: returns list of all source copyrights
                   3568: 
                   3569: =cut
                   3570: 
                   3571: sub source_copyrightids {
                   3572:     return sort(keys(%scprtag));
                   3573: }
                   3574: 
                   3575: =pod
                   3576: 
1.648     raeburn  3577: =item * &source_copyrightdescription() 
1.192     taceyjo1 3578: 
                   3579: returns description of a specified source copyright id
                   3580: 
                   3581: =cut
                   3582: 
                   3583: sub source_copyrightdescription {
                   3584:     return &mt($scprtag{shift(@_)});
                   3585: }
1.112     bowersj2 3586: 
                   3587: =pod
                   3588: 
1.648     raeburn  3589: =item * &filecategories() 
1.112     bowersj2 3590: 
                   3591: returns list of all file categories
                   3592: 
                   3593: =cut
                   3594: 
                   3595: sub filecategories {
                   3596:     return sort(keys(%category_extensions));
                   3597: }
                   3598: 
                   3599: =pod
                   3600: 
1.648     raeburn  3601: =item * &filecategorytypes() 
1.112     bowersj2 3602: 
                   3603: returns list of file types belonging to a given file
                   3604: category
                   3605: 
                   3606: =cut
                   3607: 
                   3608: sub filecategorytypes {
1.356     albertel 3609:     my ($cat) = @_;
                   3610:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3611: }
                   3612: 
                   3613: =pod
                   3614: 
1.648     raeburn  3615: =item * &fileembstyle() 
1.112     bowersj2 3616: 
                   3617: returns embedding style for a specified file type
                   3618: 
                   3619: =cut
                   3620: 
                   3621: sub fileembstyle {
                   3622:     return $fe{lc(shift(@_))};
1.169     www      3623: }
                   3624: 
1.351     www      3625: sub filemimetype {
                   3626:     return $fm{lc(shift(@_))};
                   3627: }
                   3628: 
1.169     www      3629: 
                   3630: sub filecategoryselect {
                   3631:     my ($name,$value)=@_;
1.189     matthew  3632:     return &select_form($value,$name,
1.970     raeburn  3633:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3634: }
                   3635: 
                   3636: =pod
                   3637: 
1.648     raeburn  3638: =item * &filedescription() 
1.112     bowersj2 3639: 
                   3640: returns description for a specified file type
                   3641: 
                   3642: =cut
                   3643: 
                   3644: sub filedescription {
1.188     matthew  3645:     my $file_description = $fd{lc(shift())};
                   3646:     $file_description =~ s:([\[\]]):~$1:g;
                   3647:     return &mt($file_description);
1.112     bowersj2 3648: }
                   3649: 
                   3650: =pod
                   3651: 
1.648     raeburn  3652: =item * &filedescriptionex() 
1.112     bowersj2 3653: 
                   3654: returns description for a specified file type with
                   3655: extra formatting
                   3656: 
                   3657: =cut
                   3658: 
                   3659: sub filedescriptionex {
                   3660:     my $ex=shift;
1.188     matthew  3661:     my $file_description = $fd{lc($ex)};
                   3662:     $file_description =~ s:([\[\]]):~$1:g;
                   3663:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3664: }
                   3665: 
                   3666: # End of .tab access
                   3667: =pod
                   3668: 
                   3669: =back
                   3670: 
                   3671: =cut
                   3672: 
                   3673: # ------------------------------------------------------------------ File Types
                   3674: sub fileextensions {
                   3675:     return sort(keys(%fe));
                   3676: }
                   3677: 
1.97      www      3678: # ----------------------------------------------------------- Display Languages
                   3679: # returns a hash with all desired display languages
                   3680: #
                   3681: 
                   3682: sub display_languages {
                   3683:     my %languages=();
1.695     raeburn  3684:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3685: 	$languages{$lang}=1;
1.97      www      3686:     }
                   3687:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3688:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3689: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3690: 	    $languages{$lang}=1;
1.97      www      3691:         }
                   3692:     }
                   3693:     return %languages;
1.14      harris41 3694: }
                   3695: 
1.582     albertel 3696: sub languages {
                   3697:     my ($possible_langs) = @_;
1.695     raeburn  3698:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3699:     if (!ref($possible_langs)) {
                   3700: 	if( wantarray ) {
                   3701: 	    return @preferred_langs;
                   3702: 	} else {
                   3703: 	    return $preferred_langs[0];
                   3704: 	}
                   3705:     }
                   3706:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3707:     my @preferred_possibilities;
                   3708:     foreach my $preferred_lang (@preferred_langs) {
                   3709: 	if (exists($possibilities{$preferred_lang})) {
                   3710: 	    push(@preferred_possibilities, $preferred_lang);
                   3711: 	}
                   3712:     }
                   3713:     if( wantarray ) {
                   3714: 	return @preferred_possibilities;
                   3715:     }
                   3716:     return $preferred_possibilities[0];
                   3717: }
                   3718: 
1.742     raeburn  3719: sub user_lang {
                   3720:     my ($touname,$toudom,$fromcid) = @_;
                   3721:     my @userlangs;
                   3722:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3723:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3724:                     $env{'course.'.$fromcid.'.languages'}));
                   3725:     } else {
                   3726:         my %langhash = &getlangs($touname,$toudom);
                   3727:         if ($langhash{'languages'} ne '') {
                   3728:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3729:         } else {
                   3730:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3731:             if ($domdefs{'lang_def'} ne '') {
                   3732:                 @userlangs = ($domdefs{'lang_def'});
                   3733:             }
                   3734:         }
                   3735:     }
                   3736:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3737:     my $user_lh = Apache::localize->get_handle(@languages);
                   3738:     return $user_lh;
                   3739: }
                   3740: 
                   3741: 
1.112     bowersj2 3742: ###############################################################
                   3743: ##               Student Answer Attempts                     ##
                   3744: ###############################################################
                   3745: 
                   3746: =pod
                   3747: 
                   3748: =head1 Alternate Problem Views
                   3749: 
                   3750: =over 4
                   3751: 
1.648     raeburn  3752: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3753:     $getattempt, $regexp, $gradesub)
                   3754: 
                   3755: Return string with previous attempt on problem. Arguments:
                   3756: 
                   3757: =over 4
                   3758: 
                   3759: =item * $symb: Problem, including path
                   3760: 
                   3761: =item * $username: username of the desired student
                   3762: 
                   3763: =item * $domain: domain of the desired student
1.14      harris41 3764: 
1.112     bowersj2 3765: =item * $course: Course ID
1.14      harris41 3766: 
1.112     bowersj2 3767: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3768:     something
1.14      harris41 3769: 
1.112     bowersj2 3770: =item * $regexp: if string matches this regexp, the string will be
                   3771:     sent to $gradesub
1.14      harris41 3772: 
1.112     bowersj2 3773: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3774: 
1.112     bowersj2 3775: =back
1.14      harris41 3776: 
1.112     bowersj2 3777: The output string is a table containing all desired attempts, if any.
1.16      harris41 3778: 
1.112     bowersj2 3779: =cut
1.1       albertel 3780: 
                   3781: sub get_previous_attempt {
1.43      ng       3782:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3783:   my $prevattempts='';
1.43      ng       3784:   no strict 'refs';
1.1       albertel 3785:   if ($symb) {
1.3       albertel 3786:     my (%returnhash)=
                   3787:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3788:     if ($returnhash{'version'}) {
                   3789:       my %lasthash=();
                   3790:       my $version;
                   3791:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3792:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3793: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3794:         }
1.1       albertel 3795:       }
1.596     albertel 3796:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3797:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3798:       my (%typeparts,%lasthidden);
1.945     raeburn  3799:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3800:       foreach my $key (sort(keys(%lasthash))) {
                   3801: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3802: 	if ($#parts > 0) {
1.31      albertel 3803: 	  my $data=$parts[-1];
1.989     raeburn  3804:           next if ($data eq 'foilorder');
1.31      albertel 3805: 	  pop(@parts);
1.1010    www      3806:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3807:           if ($data eq 'type') {
                   3808:               unless ($showsurv) {
                   3809:                   my $id = join(',',@parts);
                   3810:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3811:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3812:                       $lasthidden{$ign.'.'.$id} = 1;
                   3813:                   }
1.945     raeburn  3814:               }
1.1010    www      3815:           } 
1.31      albertel 3816: 	} else {
1.41      ng       3817: 	  if ($#parts == 0) {
                   3818: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3819: 	  } else {
                   3820: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3821: 	  }
1.31      albertel 3822: 	}
1.16      harris41 3823:       }
1.596     albertel 3824:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3825:       if ($getattempt eq '') {
                   3826: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3827:             my @hidden;
                   3828:             if (%typeparts) {
                   3829:                 foreach my $id (keys(%typeparts)) {
                   3830:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3831:                         push(@hidden,$id);
                   3832:                     }
                   3833:                 }
                   3834:             }
                   3835:             $prevattempts.=&start_data_table_row().
                   3836:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3837:             if (@hidden) {
                   3838:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3839:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3840:                     my $hide;
                   3841:                     foreach my $id (@hidden) {
                   3842:                         if ($key =~ /^\Q$id\E/) {
                   3843:                             $hide = 1;
                   3844:                             last;
                   3845:                         }
                   3846:                     }
                   3847:                     if ($hide) {
                   3848:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3849:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3850:                             my $value = &format_previous_attempt_value($key,
                   3851:                                              $returnhash{$version.':'.$key});
1.1173    kruse    3852:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  3853:                         } else {
                   3854:                             $prevattempts.='<td>&nbsp;</td>';
                   3855:                         }
                   3856:                     } else {
                   3857:                         if ($key =~ /\./) {
                   3858:                             my $value = &format_previous_attempt_value($key,
                   3859:                                               $returnhash{$version.':'.$key});
1.1173    kruse    3860:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  3861:                         } else {
                   3862:                             $prevattempts.='<td>&nbsp;</td>';
                   3863:                         }
                   3864:                     }
                   3865:                 }
                   3866:             } else {
                   3867: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3868:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3869: 		    my $value = &format_previous_attempt_value($key,
                   3870: 			            $returnhash{$version.':'.$key});
1.1173    kruse    3871: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  3872: 	        }
                   3873:             }
                   3874: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3875: 	 }
1.1       albertel 3876:       }
1.945     raeburn  3877:       my @currhidden = keys(%lasthidden);
1.596     albertel 3878:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3879:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3880:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3881:           if (%typeparts) {
                   3882:               my $hidden;
                   3883:               foreach my $id (@currhidden) {
                   3884:                   if ($key =~ /^\Q$id\E/) {
                   3885:                       $hidden = 1;
                   3886:                       last;
                   3887:                   }
                   3888:               }
                   3889:               if ($hidden) {
                   3890:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3891:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3892:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3893:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3894:                           $value = &$gradesub($value);
                   3895:                       }
1.1173    kruse    3896:                       $prevattempts.='<td>'. $value.'&nbsp;</td>';
1.945     raeburn  3897:                   } else {
                   3898:                       $prevattempts.='<td>&nbsp;</td>';
                   3899:                   }
                   3900:               } else {
                   3901:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3902:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3903:                       $value = &$gradesub($value);
                   3904:                   }
1.1173    kruse    3905:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  3906:               }
                   3907:           } else {
                   3908: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3909: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3910:                   $value = &$gradesub($value);
                   3911:               }
1.1173    kruse    3912: 	     $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  3913:           }
1.16      harris41 3914:       }
1.596     albertel 3915:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3916:     } else {
1.596     albertel 3917:       $prevattempts=
                   3918: 	  &start_data_table().&start_data_table_row().
                   3919: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3920: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3921:     }
                   3922:   } else {
1.596     albertel 3923:     $prevattempts=
                   3924: 	  &start_data_table().&start_data_table_row().
                   3925: 	  '<td>'.&mt('No data.').'</td>'.
                   3926: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3927:   }
1.10      albertel 3928: }
                   3929: 
1.581     albertel 3930: sub format_previous_attempt_value {
                   3931:     my ($key,$value) = @_;
1.1011    www      3932:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173    kruse    3933:         $value = &Apache::lonlocal::locallocaltime($value);
1.581     albertel 3934:     } elsif (ref($value) eq 'ARRAY') {
1.1173    kruse    3935:         $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988     raeburn  3936:     } elsif ($key =~ /answerstring$/) {
                   3937:         my %answers = &Apache::lonnet::str2hash($value);
1.1173    kruse    3938:         my @answer = %answers;
                   3939:         %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988     raeburn  3940:         my @anskeys = sort(keys(%answers));
                   3941:         if (@anskeys == 1) {
                   3942:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3943:             if ($answer =~ m{\0}) {
                   3944:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3945:             }
                   3946:             my $tag_internal_answer_name = 'INTERNAL';
                   3947:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3948:                 $value = $answer; 
                   3949:             } else {
                   3950:                 $value = $anskeys[0].'='.$answer;
                   3951:             }
                   3952:         } else {
                   3953:             foreach my $ans (@anskeys) {
                   3954:                 my $answer = $answers{$ans};
1.1001    raeburn  3955:                 if ($answer =~ m{\0}) {
                   3956:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3957:                 }
                   3958:                 $value .=  $ans.'='.$answer.'<br />';;
                   3959:             } 
                   3960:         }
1.581     albertel 3961:     } else {
1.1173    kruse    3962:         $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581     albertel 3963:     }
                   3964:     return $value;
                   3965: }
                   3966: 
                   3967: 
1.107     albertel 3968: sub relative_to_absolute {
                   3969:     my ($url,$output)=@_;
                   3970:     my $parser=HTML::TokeParser->new(\$output);
                   3971:     my $token;
                   3972:     my $thisdir=$url;
                   3973:     my @rlinks=();
                   3974:     while ($token=$parser->get_token) {
                   3975: 	if ($token->[0] eq 'S') {
                   3976: 	    if ($token->[1] eq 'a') {
                   3977: 		if ($token->[2]->{'href'}) {
                   3978: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3979: 		}
                   3980: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3981: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3982: 	    } elsif ($token->[1] eq 'base') {
                   3983: 		$thisdir=$token->[2]->{'href'};
                   3984: 	    }
                   3985: 	}
                   3986:     }
                   3987:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3988:     foreach my $link (@rlinks) {
1.726     raeburn  3989: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3990: 		($link=~/^\//) ||
                   3991: 		($link=~/^javascript:/i) ||
                   3992: 		($link=~/^mailto:/i) ||
                   3993: 		($link=~/^\#/)) {
                   3994: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3995: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3996: 	}
                   3997:     }
                   3998: # -------------------------------------------------- Deal with Applet codebases
                   3999:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   4000:     return $output;
                   4001: }
                   4002: 
1.112     bowersj2 4003: =pod
                   4004: 
1.648     raeburn  4005: =item * &get_student_view()
1.112     bowersj2 4006: 
                   4007: show a snapshot of what student was looking at
                   4008: 
                   4009: =cut
                   4010: 
1.10      albertel 4011: sub get_student_view {
1.186     albertel 4012:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      4013:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4014:   my (%form);
1.10      albertel 4015:   my @elements=('symb','courseid','domain','username');
                   4016:   foreach my $element (@elements) {
1.186     albertel 4017:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4018:   }
1.186     albertel 4019:   if (defined($moreenv)) {
                   4020:       %form=(%form,%{$moreenv});
                   4021:   }
1.236     albertel 4022:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 4023:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      4024:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 4025:   $userview=~s/\<body[^\>]*\>//gi;
                   4026:   $userview=~s/\<\/body\>//gi;
                   4027:   $userview=~s/\<html\>//gi;
                   4028:   $userview=~s/\<\/html\>//gi;
                   4029:   $userview=~s/\<head\>//gi;
                   4030:   $userview=~s/\<\/head\>//gi;
                   4031:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 4032:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      4033:   if (wantarray) {
                   4034:      return ($userview,$response);
                   4035:   } else {
                   4036:      return $userview;
                   4037:   }
                   4038: }
                   4039: 
                   4040: sub get_student_view_with_retries {
                   4041:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   4042: 
                   4043:     my $ok = 0;                 # True if we got a good response.
                   4044:     my $content;
                   4045:     my $response;
                   4046: 
                   4047:     # Try to get the student_view done. within the retries count:
                   4048:     
                   4049:     do {
                   4050:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   4051:          $ok      = $response->is_success;
                   4052:          if (!$ok) {
                   4053:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   4054:          }
                   4055:          $retries--;
                   4056:     } while (!$ok && ($retries > 0));
                   4057:     
                   4058:     if (!$ok) {
                   4059:        $content = '';          # On error return an empty content.
                   4060:     }
1.651     www      4061:     if (wantarray) {
                   4062:        return ($content, $response);
                   4063:     } else {
                   4064:        return $content;
                   4065:     }
1.11      albertel 4066: }
                   4067: 
1.112     bowersj2 4068: =pod
                   4069: 
1.648     raeburn  4070: =item * &get_student_answers() 
1.112     bowersj2 4071: 
                   4072: show a snapshot of how student was answering problem
                   4073: 
                   4074: =cut
                   4075: 
1.11      albertel 4076: sub get_student_answers {
1.100     sakharuk 4077:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      4078:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4079:   my (%moreenv);
1.11      albertel 4080:   my @elements=('symb','courseid','domain','username');
                   4081:   foreach my $element (@elements) {
1.186     albertel 4082:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4083:   }
1.186     albertel 4084:   $moreenv{'grade_target'}='answer';
                   4085:   %moreenv=(%form,%moreenv);
1.497     raeburn  4086:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4087:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4088:   return $userview;
1.1       albertel 4089: }
1.116     albertel 4090: 
                   4091: =pod
                   4092: 
                   4093: =item * &submlink()
                   4094: 
1.242     albertel 4095: Inputs: $text $uname $udom $symb $target
1.116     albertel 4096: 
                   4097: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4098: 
                   4099: =cut
                   4100: 
                   4101: ###############################################
                   4102: sub submlink {
1.242     albertel 4103:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4104:     if (!($uname && $udom)) {
                   4105: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4106: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4107: 	if (!$symb) { $symb=$cursymb; }
                   4108:     }
1.254     matthew  4109:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4110:     $symb=&escape($symb);
1.960     bisitz   4111:     if ($target) { $target=" target=\"$target\""; }
                   4112:     return
                   4113:         '<a href="/adm/grades?command=submission'.
                   4114:         '&amp;symb='.$symb.
                   4115:         '&amp;student='.$uname.
                   4116:         '&amp;userdom='.$udom.'"'.
                   4117:         $target.'>'.$text.'</a>';
1.242     albertel 4118: }
                   4119: ##############################################
                   4120: 
                   4121: =pod
                   4122: 
                   4123: =item * &pgrdlink()
                   4124: 
                   4125: Inputs: $text $uname $udom $symb $target
                   4126: 
                   4127: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4128: 
                   4129: =cut
                   4130: 
                   4131: ###############################################
                   4132: sub pgrdlink {
                   4133:     my $link=&submlink(@_);
                   4134:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4135:     return $link;
                   4136: }
                   4137: ##############################################
                   4138: 
                   4139: =pod
                   4140: 
                   4141: =item * &pprmlink()
                   4142: 
                   4143: Inputs: $text $uname $udom $symb $target
                   4144: 
                   4145: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4146: student and a specific resource
1.242     albertel 4147: 
                   4148: =cut
                   4149: 
                   4150: ###############################################
                   4151: sub pprmlink {
                   4152:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4153:     if (!($uname && $udom)) {
                   4154: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4155: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4156: 	if (!$symb) { $symb=$cursymb; }
                   4157:     }
1.254     matthew  4158:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4159:     $symb=&escape($symb);
1.242     albertel 4160:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4161:     return '<a href="/adm/parmset?command=set&amp;'.
                   4162: 	'symb='.$symb.'&amp;uname='.$uname.
                   4163: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4164: }
                   4165: ##############################################
1.37      matthew  4166: 
1.112     bowersj2 4167: =pod
                   4168: 
                   4169: =back
                   4170: 
                   4171: =cut
                   4172: 
1.37      matthew  4173: ###############################################
1.51      www      4174: 
                   4175: 
                   4176: sub timehash {
1.687     raeburn  4177:     my ($thistime) = @_;
                   4178:     my $timezone = &Apache::lonlocal::gettimezone();
                   4179:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4180:                      ->set_time_zone($timezone);
                   4181:     my $wday = $dt->day_of_week();
                   4182:     if ($wday == 7) { $wday = 0; }
                   4183:     return ( 'second' => $dt->second(),
                   4184:              'minute' => $dt->minute(),
                   4185:              'hour'   => $dt->hour(),
                   4186:              'day'     => $dt->day_of_month(),
                   4187:              'month'   => $dt->month(),
                   4188:              'year'    => $dt->year(),
                   4189:              'weekday' => $wday,
                   4190:              'dayyear' => $dt->day_of_year(),
                   4191:              'dlsav'   => $dt->is_dst() );
1.51      www      4192: }
                   4193: 
1.370     www      4194: sub utc_string {
                   4195:     my ($date)=@_;
1.371     www      4196:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4197: }
                   4198: 
1.51      www      4199: sub maketime {
                   4200:     my %th=@_;
1.687     raeburn  4201:     my ($epoch_time,$timezone,$dt);
                   4202:     $timezone = &Apache::lonlocal::gettimezone();
                   4203:     eval {
                   4204:         $dt = DateTime->new( year   => $th{'year'},
                   4205:                              month  => $th{'month'},
                   4206:                              day    => $th{'day'},
                   4207:                              hour   => $th{'hour'},
                   4208:                              minute => $th{'minute'},
                   4209:                              second => $th{'second'},
                   4210:                              time_zone => $timezone,
                   4211:                          );
                   4212:     };
                   4213:     if (!$@) {
                   4214:         $epoch_time = $dt->epoch;
                   4215:         if ($epoch_time) {
                   4216:             return $epoch_time;
                   4217:         }
                   4218:     }
1.51      www      4219:     return POSIX::mktime(
                   4220:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4221:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4222: }
                   4223: 
                   4224: #########################################
1.51      www      4225: 
                   4226: sub findallcourses {
1.482     raeburn  4227:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4228:     my %roles;
                   4229:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4230:     my %courses;
1.51      www      4231:     my $now=time;
1.482     raeburn  4232:     if (!defined($uname)) {
                   4233:         $uname = $env{'user.name'};
                   4234:     }
                   4235:     if (!defined($udom)) {
                   4236:         $udom = $env{'user.domain'};
                   4237:     }
                   4238:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4239:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4240:         if (!%roles) {
                   4241:             %roles = (
                   4242:                        cc => 1,
1.907     raeburn  4243:                        co => 1,
1.482     raeburn  4244:                        in => 1,
                   4245:                        ep => 1,
                   4246:                        ta => 1,
                   4247:                        cr => 1,
                   4248:                        st => 1,
                   4249:              );
                   4250:         }
                   4251:         foreach my $entry (keys(%roleshash)) {
                   4252:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4253:             if ($trole =~ /^cr/) { 
                   4254:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4255:             } else {
                   4256:                 next if (!exists($roles{$trole}));
                   4257:             }
                   4258:             if ($tend) {
                   4259:                 next if ($tend < $now);
                   4260:             }
                   4261:             if ($tstart) {
                   4262:                 next if ($tstart > $now);
                   4263:             }
1.1058    raeburn  4264:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4265:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4266:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4267:             if ($secpart eq '') {
                   4268:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4269:                 $sec = 'none';
1.1058    raeburn  4270:                 $value .= $cnum.'/';
1.482     raeburn  4271:             } else {
                   4272:                 $cnum = $cnumpart;
                   4273:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4274:                 $value .= $cnum.'/'.$sec;
                   4275:             }
                   4276:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4277:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4278:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4279:                 }
                   4280:             } else {
                   4281:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4282:             }
1.482     raeburn  4283:         }
                   4284:     } else {
                   4285:         foreach my $key (keys(%env)) {
1.483     albertel 4286: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4287:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4288: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4289: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4290: 	        next if (%roles && !exists($roles{$role}));
                   4291: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4292:                 my $active=1;
                   4293:                 if ($starttime) {
                   4294: 		    if ($now<$starttime) { $active=0; }
                   4295:                 }
                   4296:                 if ($endtime) {
                   4297:                     if ($now>$endtime) { $active=0; }
                   4298:                 }
                   4299:                 if ($active) {
1.1058    raeburn  4300:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4301:                     if ($sec eq '') {
                   4302:                         $sec = 'none';
1.1058    raeburn  4303:                     } else {
                   4304:                         $value .= $sec;
                   4305:                     }
                   4306:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4307:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4308:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4309:                         }
                   4310:                     } else {
                   4311:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4312:                     }
1.474     raeburn  4313:                 }
                   4314:             }
1.51      www      4315:         }
                   4316:     }
1.474     raeburn  4317:     return %courses;
1.51      www      4318: }
1.37      matthew  4319: 
1.54      www      4320: ###############################################
1.474     raeburn  4321: 
                   4322: sub blockcheck {
1.1062    raeburn  4323:     my ($setters,$activity,$uname,$udom,$url) = @_;
1.490     raeburn  4324: 
                   4325:     if (!defined($udom)) {
                   4326:         $udom = $env{'user.domain'};
                   4327:     }
                   4328:     if (!defined($uname)) {
                   4329:         $uname = $env{'user.name'};
                   4330:     }
                   4331: 
                   4332:     # If uname and udom are for a course, check for blocks in the course.
                   4333: 
                   4334:     if (&Apache::lonnet::is_course($udom,$uname)) {
1.1062    raeburn  4335:         my ($startblock,$endblock,$triggerblock) = 
                   4336:             &get_blocks($setters,$activity,$udom,$uname,$url);
                   4337:         return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4338:     }
1.474     raeburn  4339: 
1.502     raeburn  4340:     my $startblock = 0;
                   4341:     my $endblock = 0;
1.1062    raeburn  4342:     my $triggerblock = '';
1.482     raeburn  4343:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4344: 
1.490     raeburn  4345:     # If uname is for a user, and activity is course-specific, i.e.,
                   4346:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4347: 
1.490     raeburn  4348:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   4349:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   4350:         foreach my $key (keys(%live_courses)) {
                   4351:             if ($key ne $env{'request.course.id'}) {
                   4352:                 delete($live_courses{$key});
                   4353:             }
                   4354:         }
                   4355:     }
                   4356: 
                   4357:     my $otheruser = 0;
                   4358:     my %own_courses;
                   4359:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4360:         # Resource belongs to user other than current user.
                   4361:         $otheruser = 1;
                   4362:         # Gather courses for current user
                   4363:         %own_courses = 
                   4364:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4365:     }
                   4366: 
                   4367:     # Gather active course roles - course coordinator, instructor, 
                   4368:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4369: 
                   4370:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4371:         my ($cdom,$cnum);
                   4372:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4373:             $cdom = $env{'course.'.$course.'.domain'};
                   4374:             $cnum = $env{'course.'.$course.'.num'};
                   4375:         } else {
1.490     raeburn  4376:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4377:         }
                   4378:         my $no_ownblock = 0;
                   4379:         my $no_userblock = 0;
1.533     raeburn  4380:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4381:             # Check if current user has 'evb' priv for this
                   4382:             if (defined($own_courses{$course})) {
                   4383:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4384:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4385:                     if ($sec ne 'none') {
                   4386:                         $checkrole .= '/'.$sec;
                   4387:                     }
                   4388:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4389:                         $no_ownblock = 1;
                   4390:                         last;
                   4391:                     }
                   4392:                 }
                   4393:             }
                   4394:             # if they have 'evb' priv and are currently not playing student
                   4395:             next if (($no_ownblock) &&
                   4396:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4397:         }
1.474     raeburn  4398:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4399:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4400:             if ($sec ne 'none') {
1.482     raeburn  4401:                 $checkrole .= '/'.$sec;
1.474     raeburn  4402:             }
1.490     raeburn  4403:             if ($otheruser) {
                   4404:                 # Resource belongs to user other than current user.
                   4405:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4406:                 my (%allroles,%userroles);
                   4407:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4408:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4409:                         my ($trole,$tdom,$tnum,$tsec);
                   4410:                         if ($entry =~ /^cr/) {
                   4411:                             ($trole,$tdom,$tnum,$tsec) = 
                   4412:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4413:                         } else {
                   4414:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4415:                         }
                   4416:                         my ($spec,$area,$trest);
                   4417:                         $area = '/'.$tdom.'/'.$tnum;
                   4418:                         $trest = $tnum;
                   4419:                         if ($tsec ne '') {
                   4420:                             $area .= '/'.$tsec;
                   4421:                             $trest .= '/'.$tsec;
                   4422:                         }
                   4423:                         $spec = $trole.'.'.$area;
                   4424:                         if ($trole =~ /^cr/) {
                   4425:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4426:                                                               $tdom,$spec,$trest,$area);
                   4427:                         } else {
                   4428:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4429:                                                                 $tdom,$spec,$trest,$area);
                   4430:                         }
                   4431:                     }
                   4432:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4433:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4434:                         if ($1) {
                   4435:                             $no_userblock = 1;
                   4436:                             last;
                   4437:                         }
1.486     raeburn  4438:                     }
                   4439:                 }
1.490     raeburn  4440:             } else {
                   4441:                 # Resource belongs to current user
                   4442:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4443:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4444:                     $no_ownblock = 1;
                   4445:                     last;
                   4446:                 }
1.474     raeburn  4447:             }
                   4448:         }
                   4449:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4450:         next if (($no_ownblock) &&
1.491     albertel 4451:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4452:         next if ($no_userblock);
1.474     raeburn  4453: 
1.866     kalberla 4454:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4455:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4456:         
1.1062    raeburn  4457:         my ($start,$end,$trigger) = 
                   4458:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4459:         if (($start != 0) && 
                   4460:             (($startblock == 0) || ($startblock > $start))) {
                   4461:             $startblock = $start;
1.1062    raeburn  4462:             if ($trigger ne '') {
                   4463:                 $triggerblock = $trigger;
                   4464:             }
1.502     raeburn  4465:         }
                   4466:         if (($end != 0)  &&
                   4467:             (($endblock == 0) || ($endblock < $end))) {
                   4468:             $endblock = $end;
1.1062    raeburn  4469:             if ($trigger ne '') {
                   4470:                 $triggerblock = $trigger;
                   4471:             }
1.502     raeburn  4472:         }
1.490     raeburn  4473:     }
1.1062    raeburn  4474:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4475: }
                   4476: 
                   4477: sub get_blocks {
1.1062    raeburn  4478:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4479:     my $startblock = 0;
                   4480:     my $endblock = 0;
1.1062    raeburn  4481:     my $triggerblock = '';
1.490     raeburn  4482:     my $course = $cdom.'_'.$cnum;
                   4483:     $setters->{$course} = {};
                   4484:     $setters->{$course}{'staff'} = [];
                   4485:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4486:     $setters->{$course}{'triggers'} = [];
                   4487:     my (@blockers,%triggered);
                   4488:     my $now = time;
                   4489:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4490:     if ($activity eq 'docs') {
                   4491:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4492:         foreach my $block (@blockers) {
                   4493:             if ($block =~ /^firstaccess____(.+)$/) {
                   4494:                 my $item = $1;
                   4495:                 my $type = 'map';
                   4496:                 my $timersymb = $item;
                   4497:                 if ($item eq 'course') {
                   4498:                     $type = 'course';
                   4499:                 } elsif ($item =~ /___\d+___/) {
                   4500:                     $type = 'resource';
                   4501:                 } else {
                   4502:                     $timersymb = &Apache::lonnet::symbread($item);
                   4503:                 }
                   4504:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4505:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4506:                 $triggered{$block} = {
                   4507:                                        start => $start,
                   4508:                                        end   => $end,
                   4509:                                        type  => $type,
                   4510:                                      };
                   4511:             }
                   4512:         }
                   4513:     } else {
                   4514:         foreach my $block (keys(%commblocks)) {
                   4515:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4516:                 my ($start,$end) = ($1,$2);
                   4517:                 if ($start <= time && $end >= time) {
                   4518:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4519:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4520:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4521:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4522:                                     push(@blockers,$block);
                   4523:                                 }
                   4524:                             }
                   4525:                         }
                   4526:                     }
                   4527:                 }
                   4528:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4529:                 my $item = $1;
                   4530:                 my $timersymb = $item; 
                   4531:                 my $type = 'map';
                   4532:                 if ($item eq 'course') {
                   4533:                     $type = 'course';
                   4534:                 } elsif ($item =~ /___\d+___/) {
                   4535:                     $type = 'resource';
                   4536:                 } else {
                   4537:                     $timersymb = &Apache::lonnet::symbread($item);
                   4538:                 }
                   4539:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4540:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4541:                 if ($start && $end) {
                   4542:                     if (($start <= time) && ($end >= time)) {
                   4543:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4544:                             push(@blockers,$block);
                   4545:                             $triggered{$block} = {
                   4546:                                                    start => $start,
                   4547:                                                    end   => $end,
                   4548:                                                    type  => $type,
                   4549:                                                  };
                   4550:                         }
                   4551:                     }
1.490     raeburn  4552:                 }
1.1062    raeburn  4553:             }
                   4554:         }
                   4555:     }
                   4556:     foreach my $blocker (@blockers) {
                   4557:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4558:             &parse_block_record($commblocks{$blocker});
                   4559:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4560:         my ($start,$end,$triggertype);
                   4561:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4562:             ($start,$end) = ($1,$2);
                   4563:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4564:             $start = $triggered{$blocker}{'start'};
                   4565:             $end = $triggered{$blocker}{'end'};
                   4566:             $triggertype = $triggered{$blocker}{'type'};
                   4567:         }
                   4568:         if ($start) {
                   4569:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4570:             if ($triggertype) {
                   4571:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4572:             } else {
                   4573:                 push(@{$$setters{$course}{'triggers'}},0);
                   4574:             }
                   4575:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4576:                 $startblock = $start;
                   4577:                 if ($triggertype) {
                   4578:                     $triggerblock = $blocker;
1.474     raeburn  4579:                 }
                   4580:             }
1.1062    raeburn  4581:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4582:                $endblock = $end;
                   4583:                if ($triggertype) {
                   4584:                    $triggerblock = $blocker;
                   4585:                }
                   4586:             }
1.474     raeburn  4587:         }
                   4588:     }
1.1062    raeburn  4589:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4590: }
                   4591: 
                   4592: sub parse_block_record {
                   4593:     my ($record) = @_;
                   4594:     my ($setuname,$setudom,$title,$blocks);
                   4595:     if (ref($record) eq 'HASH') {
                   4596:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4597:         $title = &unescape($record->{'event'});
                   4598:         $blocks = $record->{'blocks'};
                   4599:     } else {
                   4600:         my @data = split(/:/,$record,3);
                   4601:         if (scalar(@data) eq 2) {
                   4602:             $title = $data[1];
                   4603:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4604:         } else {
                   4605:             ($setuname,$setudom,$title) = @data;
                   4606:         }
                   4607:         $blocks = { 'com' => 'on' };
                   4608:     }
                   4609:     return ($setuname,$setudom,$title,$blocks);
                   4610: }
                   4611: 
1.854     kalberla 4612: sub blocking_status {
1.1062    raeburn  4613:     my ($activity,$uname,$udom,$url) = @_;
1.1061    raeburn  4614:     my %setters;
1.890     droeschl 4615: 
1.1061    raeburn  4616: # check for active blocking
1.1062    raeburn  4617:     my ($startblock,$endblock,$triggerblock) = 
                   4618:         &blockcheck(\%setters,$activity,$uname,$udom,$url);
                   4619:     my $blocked = 0;
                   4620:     if ($startblock && $endblock) {
                   4621:         $blocked = 1;
                   4622:     }
1.890     droeschl 4623: 
1.1061    raeburn  4624: # caller just wants to know whether a block is active
                   4625:     if (!wantarray) { return $blocked; }
                   4626: 
                   4627: # build a link to a popup window containing the details
                   4628:     my $querystring  = "?activity=$activity";
                   4629: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062    raeburn  4630:     if ($activity eq 'port') {
                   4631:         $querystring .= "&amp;udom=$udom"      if $udom;
                   4632:         $querystring .= "&amp;uname=$uname"    if $uname;
                   4633:     } elsif ($activity eq 'docs') {
                   4634:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4635:     }
1.1061    raeburn  4636: 
                   4637:     my $output .= <<'END_MYBLOCK';
                   4638: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4639:     var options = "width=" + w + ",height=" + h + ",";
                   4640:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4641:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4642:     var newWin = window.open(url, wdwName, options);
                   4643:     newWin.focus();
                   4644: }
1.890     droeschl 4645: END_MYBLOCK
1.854     kalberla 4646: 
1.1061    raeburn  4647:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4648:   
1.1061    raeburn  4649:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4650:     my $text = &mt('Communication Blocked');
                   4651:     if ($activity eq 'docs') {
                   4652:         $text = &mt('Content Access Blocked');
1.1063    raeburn  4653:     } elsif ($activity eq 'printout') {
                   4654:         $text = &mt('Printing Blocked');
1.1062    raeburn  4655:     }
1.1061    raeburn  4656:     $output .= <<"END_BLOCK";
1.867     kalberla 4657: <div class='LC_comblock'>
1.869     kalberla 4658:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4659:   title='$text'>
                   4660:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4661:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4662:   title='$text'>$text</a>
1.867     kalberla 4663: </div>
                   4664: 
                   4665: END_BLOCK
1.474     raeburn  4666: 
1.1061    raeburn  4667:     return ($blocked, $output);
1.854     kalberla 4668: }
1.490     raeburn  4669: 
1.60      matthew  4670: ###############################################
                   4671: 
1.682     raeburn  4672: sub check_ip_acc {
                   4673:     my ($acc)=@_;
                   4674:     &Apache::lonxml::debug("acc is $acc");
                   4675:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4676:         return 1;
                   4677:     }
                   4678:     my $allowed=0;
                   4679:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4680: 
                   4681:     my $name;
                   4682:     foreach my $pattern (split(',',$acc)) {
                   4683:         $pattern =~ s/^\s*//;
                   4684:         $pattern =~ s/\s*$//;
                   4685:         if ($pattern =~ /\*$/) {
                   4686:             #35.8.*
                   4687:             $pattern=~s/\*//;
                   4688:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4689:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4690:             #35.8.3.[34-56]
                   4691:             my $low=$2;
                   4692:             my $high=$3;
                   4693:             $pattern=$1;
                   4694:             if ($ip =~ /^\Q$pattern\E/) {
                   4695:                 my $last=(split(/\./,$ip))[3];
                   4696:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4697:             }
                   4698:         } elsif ($pattern =~ /^\*/) {
                   4699:             #*.msu.edu
                   4700:             $pattern=~s/\*//;
                   4701:             if (!defined($name)) {
                   4702:                 use Socket;
                   4703:                 my $netaddr=inet_aton($ip);
                   4704:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4705:             }
                   4706:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4707:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4708:             #127.0.0.1
                   4709:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4710:         } else {
                   4711:             #some.name.com
                   4712:             if (!defined($name)) {
                   4713:                 use Socket;
                   4714:                 my $netaddr=inet_aton($ip);
                   4715:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4716:             }
                   4717:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4718:         }
                   4719:         if ($allowed) { last; }
                   4720:     }
                   4721:     return $allowed;
                   4722: }
                   4723: 
                   4724: ###############################################
                   4725: 
1.60      matthew  4726: =pod
                   4727: 
1.112     bowersj2 4728: =head1 Domain Template Functions
                   4729: 
                   4730: =over 4
                   4731: 
                   4732: =item * &determinedomain()
1.60      matthew  4733: 
                   4734: Inputs: $domain (usually will be undef)
                   4735: 
1.63      www      4736: Returns: Determines which domain should be used for designs
1.60      matthew  4737: 
                   4738: =cut
1.54      www      4739: 
1.60      matthew  4740: ###############################################
1.63      www      4741: sub determinedomain {
                   4742:     my $domain=shift;
1.531     albertel 4743:     if (! $domain) {
1.60      matthew  4744:         # Determine domain if we have not been given one
1.893     raeburn  4745:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4746:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4747:         if ($env{'request.role.domain'}) { 
                   4748:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4749:         }
                   4750:     }
1.63      www      4751:     return $domain;
                   4752: }
                   4753: ###############################################
1.517     raeburn  4754: 
1.518     albertel 4755: sub devalidate_domconfig_cache {
                   4756:     my ($udom)=@_;
                   4757:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4758: }
                   4759: 
                   4760: # ---------------------- Get domain configuration for a domain
                   4761: sub get_domainconf {
                   4762:     my ($udom) = @_;
                   4763:     my $cachetime=1800;
                   4764:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4765:     if (defined($cached)) { return %{$result}; }
                   4766: 
                   4767:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4768: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4769:     my (%designhash,%legacy);
1.518     albertel 4770:     if (keys(%domconfig) > 0) {
                   4771:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4772:             if (keys(%{$domconfig{'login'}})) {
                   4773:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4774:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4775:                         if ($key eq 'loginvia') {
                   4776:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013    raeburn  4777:                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948     raeburn  4778:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4779:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4780:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4781:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4782:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4783: 
                   4784:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4785:                                             } else {
1.1013    raeburn  4786:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948     raeburn  4787:                                             }
                   4788:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4789:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4790:                                             }
1.946     raeburn  4791:                                         }
                   4792:                                     }
                   4793:                                 }
                   4794:                             }
                   4795:                         } else {
                   4796:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4797:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4798:                                     $domconfig{'login'}{$key}{$img};
                   4799:                             }
1.699     raeburn  4800:                         }
                   4801:                     } else {
                   4802:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4803:                     }
1.632     raeburn  4804:                 }
                   4805:             } else {
                   4806:                 $legacy{'login'} = 1;
1.518     albertel 4807:             }
1.632     raeburn  4808:         } else {
                   4809:             $legacy{'login'} = 1;
1.518     albertel 4810:         }
                   4811:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4812:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4813:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4814:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4815:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4816:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4817:                         }
1.518     albertel 4818:                     }
                   4819:                 }
1.632     raeburn  4820:             } else {
                   4821:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4822:             }
1.632     raeburn  4823:         } else {
                   4824:             $legacy{'rolecolors'} = 1;
1.518     albertel 4825:         }
1.948     raeburn  4826:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4827:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4828:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4829:             }
                   4830:         }
1.632     raeburn  4831:         if (keys(%legacy) > 0) {
                   4832:             my %legacyhash = &get_legacy_domconf($udom);
                   4833:             foreach my $item (keys(%legacyhash)) {
                   4834:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4835:                     if ($legacy{'login'}) { 
                   4836:                         $designhash{$item} = $legacyhash{$item};
                   4837:                     }
                   4838:                 } else {
                   4839:                     if ($legacy{'rolecolors'}) {
                   4840:                         $designhash{$item} = $legacyhash{$item};
                   4841:                     }
1.518     albertel 4842:                 }
                   4843:             }
                   4844:         }
1.632     raeburn  4845:     } else {
                   4846:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4847:     }
                   4848:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4849: 				  $cachetime);
                   4850:     return %designhash;
                   4851: }
                   4852: 
1.632     raeburn  4853: sub get_legacy_domconf {
                   4854:     my ($udom) = @_;
                   4855:     my %legacyhash;
                   4856:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4857:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4858:     if (-e $designfile) {
                   4859:         if ( open (my $fh,"<$designfile") ) {
                   4860:             while (my $line = <$fh>) {
                   4861:                 next if ($line =~ /^\#/);
                   4862:                 chomp($line);
                   4863:                 my ($key,$val)=(split(/\=/,$line));
                   4864:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4865:             }
                   4866:             close($fh);
                   4867:         }
                   4868:     }
1.1026    raeburn  4869:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4870:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4871:     }
                   4872:     return %legacyhash;
                   4873: }
                   4874: 
1.63      www      4875: =pod
                   4876: 
1.112     bowersj2 4877: =item * &domainlogo()
1.63      www      4878: 
                   4879: Inputs: $domain (usually will be undef)
                   4880: 
                   4881: Returns: A link to a domain logo, if the domain logo exists.
                   4882: If the domain logo does not exist, a description of the domain.
                   4883: 
                   4884: =cut
1.112     bowersj2 4885: 
1.63      www      4886: ###############################################
                   4887: sub domainlogo {
1.517     raeburn  4888:     my $domain = &determinedomain(shift);
1.518     albertel 4889:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4890:     # See if there is a logo
                   4891:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4892:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4893:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4894: 	    if ($imgsrc =~ m{^/res/}) {
                   4895: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4896: 		&Apache::lonnet::repcopy($local_name);
                   4897: 	    }
                   4898: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4899:         } 
                   4900:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4901:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4902:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4903:     } else {
1.60      matthew  4904:         return '';
1.59      www      4905:     }
                   4906: }
1.63      www      4907: ##############################################
                   4908: 
                   4909: =pod
                   4910: 
1.112     bowersj2 4911: =item * &designparm()
1.63      www      4912: 
                   4913: Inputs: $which parameter; $domain (usually will be undef)
                   4914: 
                   4915: Returns: value of designparamter $which
                   4916: 
                   4917: =cut
1.112     bowersj2 4918: 
1.397     albertel 4919: 
1.400     albertel 4920: ##############################################
1.397     albertel 4921: sub designparm {
                   4922:     my ($which,$domain)=@_;
                   4923:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4924:         return $env{'environment.color.'.$which};
1.96      www      4925:     }
1.63      www      4926:     $domain=&determinedomain($domain);
1.1016    raeburn  4927:     my %domdesign;
                   4928:     unless ($domain eq 'public') {
                   4929:         %domdesign = &get_domainconf($domain);
                   4930:     }
1.520     raeburn  4931:     my $output;
1.517     raeburn  4932:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4933:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4934:     } else {
1.520     raeburn  4935:         $output = $defaultdesign{$which};
                   4936:     }
                   4937:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4938:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4939:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4940:             if ($output =~ m{^/res/}) {
                   4941:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4942:                 &Apache::lonnet::repcopy($local_name);
                   4943:             }
1.520     raeburn  4944:             $output = &lonhttpdurl($output);
                   4945:         }
1.63      www      4946:     }
1.520     raeburn  4947:     return $output;
1.63      www      4948: }
1.59      www      4949: 
1.822     bisitz   4950: ##############################################
                   4951: =pod
                   4952: 
1.832     bisitz   4953: =item * &authorspace()
                   4954: 
1.1028    raeburn  4955: Inputs: $url (usually will be undef).
1.832     bisitz   4956: 
1.1132    raeburn  4957: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  4958:          directory being viewed (or for which action is being taken). 
                   4959:          If $url is provided, and begins /priv/<domain>/<uname>
                   4960:          the path will be that portion of the $context argument.
                   4961:          Otherwise the path will be for the author space of the current
                   4962:          user when the current role is author, or for that of the 
                   4963:          co-author/assistant co-author space when the current role 
                   4964:          is co-author or assistant co-author.
1.832     bisitz   4965: 
                   4966: =cut
                   4967: 
                   4968: sub authorspace {
1.1028    raeburn  4969:     my ($url) = @_;
                   4970:     if ($url ne '') {
                   4971:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4972:            return $1;
                   4973:         }
                   4974:     }
1.832     bisitz   4975:     my $caname = '';
1.1024    www      4976:     my $cadom = '';
1.1028    raeburn  4977:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4978:         ($cadom,$caname) =
1.832     bisitz   4979:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4980:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4981:         $caname = $env{'user.name'};
1.1024    www      4982:         $cadom = $env{'user.domain'};
1.832     bisitz   4983:     }
1.1028    raeburn  4984:     if (($caname ne '') && ($cadom ne '')) {
                   4985:         return "/priv/$cadom/$caname/";
                   4986:     }
                   4987:     return;
1.832     bisitz   4988: }
                   4989: 
                   4990: ##############################################
                   4991: =pod
                   4992: 
1.822     bisitz   4993: =item * &head_subbox()
                   4994: 
                   4995: Inputs: $content (contains HTML code with page functions, etc.)
                   4996: 
                   4997: Returns: HTML div with $content
                   4998:          To be included in page header
                   4999: 
                   5000: =cut
                   5001: 
                   5002: sub head_subbox {
                   5003:     my ($content)=@_;
                   5004:     my $output =
1.993     raeburn  5005:         '<div class="LC_head_subbox">'
1.822     bisitz   5006:        .$content
                   5007:        .'</div>'
                   5008: }
                   5009: 
                   5010: ##############################################
                   5011: =pod
                   5012: 
                   5013: =item * &CSTR_pageheader()
                   5014: 
1.1026    raeburn  5015: Input: (optional) filename from which breadcrumb trail is built.
                   5016:        In most cases no input as needed, as $env{'request.filename'}
                   5017:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   5018: 
                   5019: Returns: HTML div with CSTR path and recent box
1.1132    raeburn  5020:          To be included on Authoring Space pages
1.822     bisitz   5021: 
                   5022: =cut
                   5023: 
                   5024: sub CSTR_pageheader {
1.1026    raeburn  5025:     my ($trailfile) = @_;
                   5026:     if ($trailfile eq '') {
                   5027:         $trailfile = $env{'request.filename'};
                   5028:     }
                   5029: 
                   5030: # this is for resources; directories have customtitle, and crumbs
                   5031: # and select recent are created in lonpubdir.pm
                   5032: 
                   5033:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      5034:     my ($udom,$uname,$thisdisfn)=
1.1113    raeburn  5035:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  5036:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   5037:     $formaction =~ s{/+}{/}g;
1.822     bisitz   5038: 
                   5039:     my $parentpath = '';
                   5040:     my $lastitem = '';
                   5041:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   5042:         $parentpath = $1;
                   5043:         $lastitem = $2;
                   5044:     } else {
                   5045:         $lastitem = $thisdisfn;
                   5046:     }
1.921     bisitz   5047: 
                   5048:     my $output =
1.822     bisitz   5049:          '<div>'
                   5050:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1132    raeburn  5051:         .'<b>'.&mt('Authoring Space:').'</b> '
1.822     bisitz   5052:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   5053:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      5054:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   5055: 
                   5056:     if ($lastitem) {
                   5057:         $output .=
                   5058:              '<span class="LC_filename">'
                   5059:             .$lastitem
                   5060:             .'</span>';
                   5061:     }
                   5062:     $output .=
                   5063:          '<br />'
1.822     bisitz   5064:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   5065:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   5066:         .'</form>'
                   5067:         .&Apache::lonmenu::constspaceform()
                   5068:         .'</div>';
1.921     bisitz   5069: 
                   5070:     return $output;
1.822     bisitz   5071: }
                   5072: 
1.60      matthew  5073: ###############################################
                   5074: ###############################################
                   5075: 
                   5076: =pod
                   5077: 
1.112     bowersj2 5078: =back
                   5079: 
1.549     albertel 5080: =head1 HTML Helpers
1.112     bowersj2 5081: 
                   5082: =over 4
                   5083: 
                   5084: =item * &bodytag()
1.60      matthew  5085: 
                   5086: Returns a uniform header for LON-CAPA web pages.
                   5087: 
                   5088: Inputs: 
                   5089: 
1.112     bowersj2 5090: =over 4
                   5091: 
                   5092: =item * $title, A title to be displayed on the page.
                   5093: 
                   5094: =item * $function, the current role (can be undef).
                   5095: 
                   5096: =item * $addentries, extra parameters for the <body> tag.
                   5097: 
                   5098: =item * $bodyonly, if defined, only return the <body> tag.
                   5099: 
                   5100: =item * $domain, if defined, force a given domain.
                   5101: 
                   5102: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5103:             text interface only)
1.60      matthew  5104: 
1.814     bisitz   5105: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5106:                      navigational links
1.317     albertel 5107: 
1.338     albertel 5108: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5109: 
1.460     albertel 5110: =item * $args, optional argument valid values are
                   5111:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 5112:             inherit_jsmath -> when creating popup window in a page,
                   5113:                               should it have jsmath forced on by the
                   5114:                               current page
1.460     albertel 5115: 
1.1096    raeburn  5116: =item * $advtoolsref, optional argument, ref to an array containing
                   5117:             inlineremote items to be added in "Functions" menu below
                   5118:             breadcrumbs.
                   5119: 
1.112     bowersj2 5120: =back
                   5121: 
1.60      matthew  5122: Returns: A uniform header for LON-CAPA web pages.  
                   5123: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5124: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5125: other decorations will be returned.
                   5126: 
                   5127: =cut
                   5128: 
1.54      www      5129: sub bodytag {
1.831     bisitz   5130:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096    raeburn  5131:         $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339     albertel 5132: 
1.954     raeburn  5133:     my $public;
                   5134:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5135:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5136:         $public = 1;
                   5137:     }
1.460     albertel 5138:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154    raeburn  5139:     my $httphost = $args->{'use_absolute'};
1.339     albertel 5140: 
1.183     matthew  5141:     $function = &get_users_function() if (!$function);
1.339     albertel 5142:     my $img =    &designparm($function.'.img',$domain);
                   5143:     my $font =   &designparm($function.'.font',$domain);
                   5144:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5145: 
1.803     bisitz   5146:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5147: 		   'bgcolor' => $pgbg,
1.339     albertel 5148: 		   'text'    => $font,
                   5149:                    'alink'   => &designparm($function.'.alink',$domain),
                   5150: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5151: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5152:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5153: 
1.63      www      5154:  # role and realm
1.1178    raeburn  5155:     my ($role,$realm) = split(m{\./},$env{'request.role'},2);
                   5156:     if ($realm) {
                   5157:         $realm = '/'.$realm;
                   5158:     }
1.378     raeburn  5159:     if ($role  eq 'ca') {
1.479     albertel 5160:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5161:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5162:     } 
1.55      www      5163: # realm
1.258     albertel 5164:     if ($env{'request.course.id'}) {
1.378     raeburn  5165:         if ($env{'request.role'} !~ /^cr/) {
                   5166:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5167:         }
1.898     raeburn  5168:         if ($env{'request.course.sec'}) {
                   5169:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5170:         }   
1.359     albertel 5171: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5172:     } else {
                   5173:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5174:     }
1.433     albertel 5175: 
1.359     albertel 5176:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5177: 
1.438     albertel 5178:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5179: 
1.101     www      5180: # construct main body tag
1.359     albertel 5181:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 5182: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 5183: 
1.1131    raeburn  5184:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5185: 
1.1130    raeburn  5186:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5187:         return $bodytag;
1.1130    raeburn  5188:     }
1.359     albertel 5189: 
1.954     raeburn  5190:     if ($public) {
1.433     albertel 5191: 	undef($role);
                   5192:     }
1.359     albertel 5193:     
1.762     bisitz   5194:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5195:     #
                   5196:     # Extra info if you are the DC
                   5197:     my $dc_info = '';
                   5198:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5199:                         $env{'course.'.$env{'request.course.id'}.
                   5200:                                  '.domain'}.'/'})) {
                   5201:         my $cid = $env{'request.course.id'};
1.917     raeburn  5202:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5203:         $dc_info =~ s/\s+$//;
1.359     albertel 5204:     }
                   5205: 
1.898     raeburn  5206:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853     droeschl 5207: 
1.903     droeschl 5208:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5209: 
                   5210:         #    if ($env{'request.state'} eq 'construct') {
                   5211:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5212:         #    }
                   5213: 
1.1130    raeburn  5214:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154    raeburn  5215:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 5216: 
1.1130    raeburn  5217:         my ($left,$right) = Apache::lonmenu::primary_menu();
1.359     albertel 5218: 
1.916     droeschl 5219:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917     raeburn  5220:              if ($dc_info) {
                   5221:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   5222:              }
1.1130    raeburn  5223:              $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916     droeschl 5224:                 <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5225:             return $bodytag;
                   5226:         }
1.894     droeschl 5227: 
1.927     raeburn  5228:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130    raeburn  5229:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5230:         }
1.916     droeschl 5231: 
1.1130    raeburn  5232:         $bodytag .= $right;
1.852     droeschl 5233: 
1.917     raeburn  5234:         if ($dc_info) {
                   5235:             $dc_info = &dc_courseid_toggle($dc_info);
                   5236:         }
                   5237:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5238: 
1.1169    raeburn  5239:         #if directed to not display the secondary menu, don't.  
1.1168    raeburn  5240:         if ($args->{'no_secondary_menu'}) {
                   5241:             return $bodytag;
                   5242:         }
1.1169    raeburn  5243:         #don't show menus for public users
1.954     raeburn  5244:         if (!$public){
1.1154    raeburn  5245:             $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903     droeschl 5246:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5247:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5248:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5249:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5250:                                 $args->{'bread_crumbs'});
1.1096    raeburn  5251:             } elsif ($forcereg) {
                   5252:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                   5253:                                                             $args->{'group'});
                   5254:             } else {
                   5255:                 $bodytag .= 
                   5256:                     &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5257:                                                         $forcereg,$args->{'group'},
                   5258:                                                         $args->{'bread_crumbs'},
                   5259:                                                         $advtoolsref);
1.920     raeburn  5260:             }
1.903     droeschl 5261:         }else{
                   5262:             # this is to seperate menu from content when there's no secondary
                   5263:             # menu. Especially needed for public accessible ressources.
                   5264:             $bodytag .= '<hr style="clear:both" />';
                   5265:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5266:         }
1.903     droeschl 5267: 
1.235     raeburn  5268:         return $bodytag;
1.182     matthew  5269: }
                   5270: 
1.917     raeburn  5271: sub dc_courseid_toggle {
                   5272:     my ($dc_info) = @_;
1.980     raeburn  5273:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5274:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5275:            &mt('(More ...)').'</a></span>'.
                   5276:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5277: }
                   5278: 
1.330     albertel 5279: sub make_attr_string {
                   5280:     my ($register,$attr_ref) = @_;
                   5281: 
                   5282:     if ($attr_ref && !ref($attr_ref)) {
                   5283: 	die("addentries Must be a hash ref ".
                   5284: 	    join(':',caller(1))." ".
                   5285: 	    join(':',caller(0))." ");
                   5286:     }
                   5287: 
                   5288:     if ($register) {
1.339     albertel 5289: 	my ($on_load,$on_unload);
                   5290: 	foreach my $key (keys(%{$attr_ref})) {
                   5291: 	    if      (lc($key) eq 'onload') {
                   5292: 		$on_load.=$attr_ref->{$key}.';';
                   5293: 		delete($attr_ref->{$key});
                   5294: 
                   5295: 	    } elsif (lc($key) eq 'onunload') {
                   5296: 		$on_unload.=$attr_ref->{$key}.';';
                   5297: 		delete($attr_ref->{$key});
                   5298: 	    }
                   5299: 	}
1.953     droeschl 5300: 	$attr_ref->{'onload'}  = $on_load;
                   5301: 	$attr_ref->{'onunload'}= $on_unload;
1.330     albertel 5302:     }
1.339     albertel 5303: 
1.330     albertel 5304:     my $attr_string;
1.1159    raeburn  5305:     foreach my $attr (sort(keys(%$attr_ref))) {
1.330     albertel 5306: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5307:     }
                   5308:     return $attr_string;
                   5309: }
                   5310: 
                   5311: 
1.182     matthew  5312: ###############################################
1.251     albertel 5313: ###############################################
                   5314: 
                   5315: =pod
                   5316: 
                   5317: =item * &endbodytag()
                   5318: 
                   5319: Returns a uniform footer for LON-CAPA web pages.
                   5320: 
1.635     raeburn  5321: Inputs: 1 - optional reference to an args hash
                   5322: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5323: a 'Continue' link is not displayed if the page contains an
                   5324: internal redirect in the <head></head> section,
                   5325: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5326: 
                   5327: =cut
                   5328: 
                   5329: sub endbodytag {
1.635     raeburn  5330:     my ($args) = @_;
1.1080    raeburn  5331:     my $endbodytag;
                   5332:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5333:         $endbodytag='</body>';
                   5334:     }
1.269     albertel 5335:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 5336:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5337:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5338: 	    $endbodytag=
                   5339: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5340: 	        &mt('Continue').'</a>'.
                   5341: 	        $endbodytag;
                   5342:         }
1.315     albertel 5343:     }
1.251     albertel 5344:     return $endbodytag;
                   5345: }
                   5346: 
1.352     albertel 5347: =pod
                   5348: 
                   5349: =item * &standard_css()
                   5350: 
                   5351: Returns a style sheet
                   5352: 
                   5353: Inputs: (all optional)
                   5354:             domain         -> force to color decorate a page for a specific
                   5355:                                domain
                   5356:             function       -> force usage of a specific rolish color scheme
                   5357:             bgcolor        -> override the default page bgcolor
                   5358: 
                   5359: =cut
                   5360: 
1.343     albertel 5361: sub standard_css {
1.345     albertel 5362:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5363:     $function  = &get_users_function() if (!$function);
                   5364:     my $img    = &designparm($function.'.img',   $domain);
                   5365:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5366:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5367:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5368: #second colour for later usage
1.345     albertel 5369:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5370:     my $pgbg_or_bgcolor =
                   5371: 	         $bgcolor ||
1.352     albertel 5372: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5373:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5374:     my $alink  = &designparm($function.'.alink', $domain);
                   5375:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5376:     my $link   = &designparm($function.'.link',  $domain);
                   5377: 
1.602     albertel 5378:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5379:     my $mono                 = 'monospace';
1.850     bisitz   5380:     my $data_table_head      = $sidebg;
                   5381:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5382:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5383:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5384:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5385:     my $mail_new             = '#FFBB77';
                   5386:     my $mail_new_hover       = '#DD9955';
                   5387:     my $mail_read            = '#BBBB77';
                   5388:     my $mail_read_hover      = '#999944';
                   5389:     my $mail_replied         = '#AAAA88';
                   5390:     my $mail_replied_hover   = '#888855';
                   5391:     my $mail_other           = '#99BBBB';
                   5392:     my $mail_other_hover     = '#669999';
1.391     albertel 5393:     my $table_header         = '#DDDDDD';
1.489     raeburn  5394:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5395:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5396:     my $button_hover         = '#BF2317';
1.392     albertel 5397: 
1.608     albertel 5398:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5399:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5400:                                              : '0 3px 0 4px';
1.448     albertel 5401: 
1.523     albertel 5402: 
1.343     albertel 5403:     return <<END;
1.947     droeschl 5404: 
                   5405: /* needed for iframe to allow 100% height in FF */
                   5406: body, html { 
                   5407:     margin: 0;
                   5408:     padding: 0 0.5%;
                   5409:     height: 99%; /* to avoid scrollbars */
                   5410: }
                   5411: 
1.795     www      5412: body {
1.911     bisitz   5413:   font-family: $sans;
                   5414:   line-height:130%;
                   5415:   font-size:0.83em;
                   5416:   color:$font;
1.795     www      5417: }
                   5418: 
1.959     onken    5419: a:focus,
                   5420: a:focus img {
1.795     www      5421:   color: red;
                   5422: }
1.698     harmsja  5423: 
1.911     bisitz   5424: form, .inline {
                   5425:   display: inline;
1.795     www      5426: }
1.721     harmsja  5427: 
1.795     www      5428: .LC_right {
1.911     bisitz   5429:   text-align:right;
1.795     www      5430: }
                   5431: 
                   5432: .LC_middle {
1.911     bisitz   5433:   vertical-align:middle;
1.795     www      5434: }
1.721     harmsja  5435: 
1.1130    raeburn  5436: .LC_floatleft {
                   5437:   float: left;
                   5438: }
                   5439: 
                   5440: .LC_floatright {
                   5441:   float: right;
                   5442: }
                   5443: 
1.911     bisitz   5444: .LC_400Box {
                   5445:   width:400px;
                   5446: }
1.721     harmsja  5447: 
1.947     droeschl 5448: .LC_iframecontainer {
                   5449:     width: 98%;
                   5450:     margin: 0;
                   5451:     position: fixed;
                   5452:     top: 8.5em;
                   5453:     bottom: 0;
                   5454: }
                   5455: 
                   5456: .LC_iframecontainer iframe{
                   5457:     border: none;
                   5458:     width: 100%;
                   5459:     height: 100%;
                   5460: }
                   5461: 
1.778     bisitz   5462: .LC_filename {
                   5463:   font-family: $mono;
                   5464:   white-space:pre;
1.921     bisitz   5465:   font-size: 120%;
1.778     bisitz   5466: }
                   5467: 
                   5468: .LC_fileicon {
                   5469:   border: none;
                   5470:   height: 1.3em;
                   5471:   vertical-align: text-bottom;
                   5472:   margin-right: 0.3em;
                   5473:   text-decoration:none;
                   5474: }
                   5475: 
1.1008    www      5476: .LC_setting {
                   5477:   text-decoration:underline;
                   5478: }
                   5479: 
1.350     albertel 5480: .LC_error {
                   5481:   color: red;
                   5482: }
1.795     www      5483: 
1.1097    bisitz   5484: .LC_warning {
                   5485:   color: darkorange;
                   5486: }
                   5487: 
1.457     albertel 5488: .LC_diff_removed {
1.733     bisitz   5489:   color: red;
1.394     albertel 5490: }
1.532     albertel 5491: 
                   5492: .LC_info,
1.457     albertel 5493: .LC_success,
                   5494: .LC_diff_added {
1.350     albertel 5495:   color: green;
                   5496: }
1.795     www      5497: 
1.802     bisitz   5498: div.LC_confirm_box {
                   5499:   background-color: #FAFAFA;
                   5500:   border: 1px solid $lg_border_color;
                   5501:   margin-right: 0;
                   5502:   padding: 5px;
                   5503: }
                   5504: 
                   5505: div.LC_confirm_box .LC_error img,
                   5506: div.LC_confirm_box .LC_success img {
                   5507:   vertical-align: middle;
                   5508: }
                   5509: 
1.440     albertel 5510: .LC_icon {
1.771     droeschl 5511:   border: none;
1.790     droeschl 5512:   vertical-align: middle;
1.771     droeschl 5513: }
                   5514: 
1.543     albertel 5515: .LC_docs_spacer {
                   5516:   width: 25px;
                   5517:   height: 1px;
1.771     droeschl 5518:   border: none;
1.543     albertel 5519: }
1.346     albertel 5520: 
1.532     albertel 5521: .LC_internal_info {
1.735     bisitz   5522:   color: #999999;
1.532     albertel 5523: }
                   5524: 
1.794     www      5525: .LC_discussion {
1.1050    www      5526:   background: $data_table_dark;
1.911     bisitz   5527:   border: 1px solid black;
                   5528:   margin: 2px;
1.794     www      5529: }
                   5530: 
                   5531: .LC_disc_action_left {
1.1050    www      5532:   background: $sidebg;
1.911     bisitz   5533:   text-align: left;
1.1050    www      5534:   padding: 4px;
                   5535:   margin: 2px;
1.794     www      5536: }
                   5537: 
                   5538: .LC_disc_action_right {
1.1050    www      5539:   background: $sidebg;
1.911     bisitz   5540:   text-align: right;
1.1050    www      5541:   padding: 4px;
                   5542:   margin: 2px;
1.794     www      5543: }
                   5544: 
                   5545: .LC_disc_new_item {
1.911     bisitz   5546:   background: white;
                   5547:   border: 2px solid red;
1.1050    www      5548:   margin: 4px;
                   5549:   padding: 4px;
1.794     www      5550: }
                   5551: 
                   5552: .LC_disc_old_item {
1.911     bisitz   5553:   background: white;
1.1050    www      5554:   margin: 4px;
                   5555:   padding: 4px;
1.794     www      5556: }
                   5557: 
1.458     albertel 5558: table.LC_pastsubmission {
                   5559:   border: 1px solid black;
                   5560:   margin: 2px;
                   5561: }
                   5562: 
1.924     bisitz   5563: table#LC_menubuttons {
1.345     albertel 5564:   width: 100%;
                   5565:   background: $pgbg;
1.392     albertel 5566:   border: 2px;
1.402     albertel 5567:   border-collapse: separate;
1.803     bisitz   5568:   padding: 0;
1.345     albertel 5569: }
1.392     albertel 5570: 
1.801     tempelho 5571: table#LC_title_bar a {
                   5572:   color: $fontmenu;
                   5573: }
1.836     bisitz   5574: 
1.807     droeschl 5575: table#LC_title_bar {
1.819     tempelho 5576:   clear: both;
1.836     bisitz   5577:   display: none;
1.807     droeschl 5578: }
                   5579: 
1.795     www      5580: table#LC_title_bar,
1.933     droeschl 5581: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5582: table#LC_title_bar.LC_with_remote {
1.359     albertel 5583:   width: 100%;
1.392     albertel 5584:   border-color: $pgbg;
                   5585:   border-style: solid;
                   5586:   border-width: $border;
1.379     albertel 5587:   background: $pgbg;
1.801     tempelho 5588:   color: $fontmenu;
1.392     albertel 5589:   border-collapse: collapse;
1.803     bisitz   5590:   padding: 0;
1.819     tempelho 5591:   margin: 0;
1.359     albertel 5592: }
1.795     www      5593: 
1.933     droeschl 5594: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5595:     margin: 0;
                   5596:     padding: 0;
1.933     droeschl 5597:     position: relative;
                   5598:     list-style: none;
1.913     droeschl 5599: }
1.933     droeschl 5600: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5601:     display: inline;
                   5602: }
1.933     droeschl 5603: 
                   5604: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5605:     padding: 0;
1.933     droeschl 5606:     margin: 0;
                   5607:     float: left;
1.913     droeschl 5608: }
1.933     droeschl 5609: .LC_breadcrumb_tools_tools {
                   5610:     padding: 0;
                   5611:     margin: 0;
1.913     droeschl 5612:     float: right;
                   5613: }
                   5614: 
1.359     albertel 5615: table#LC_title_bar td {
                   5616:   background: $tabbg;
                   5617: }
1.795     www      5618: 
1.911     bisitz   5619: table#LC_menubuttons img {
1.803     bisitz   5620:   border: none;
1.346     albertel 5621: }
1.795     www      5622: 
1.842     droeschl 5623: .LC_breadcrumbs_component {
1.911     bisitz   5624:   float: right;
                   5625:   margin: 0 1em;
1.357     albertel 5626: }
1.842     droeschl 5627: .LC_breadcrumbs_component img {
1.911     bisitz   5628:   vertical-align: middle;
1.777     tempelho 5629: }
1.795     www      5630: 
1.383     albertel 5631: td.LC_table_cell_checkbox {
                   5632:   text-align: center;
                   5633: }
1.795     www      5634: 
                   5635: .LC_fontsize_small {
1.911     bisitz   5636:   font-size: 70%;
1.705     tempelho 5637: }
                   5638: 
1.844     bisitz   5639: #LC_breadcrumbs {
1.911     bisitz   5640:   clear:both;
                   5641:   background: $sidebg;
                   5642:   border-bottom: 1px solid $lg_border_color;
                   5643:   line-height: 2.5em;
1.933     droeschl 5644:   overflow: hidden;
1.911     bisitz   5645:   margin: 0;
                   5646:   padding: 0;
1.995     raeburn  5647:   text-align: left;
1.819     tempelho 5648: }
1.862     bisitz   5649: 
1.1098    bisitz   5650: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   5651:   clear:both;
                   5652:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5653:   border: 1px solid $sidebg;
1.1098    bisitz   5654:   margin: 0 0 10px 0;
1.966     bisitz   5655:   padding: 3px;
1.995     raeburn  5656:   text-align: left;
1.822     bisitz   5657: }
                   5658: 
1.795     www      5659: .LC_fontsize_medium {
1.911     bisitz   5660:   font-size: 85%;
1.705     tempelho 5661: }
                   5662: 
1.795     www      5663: .LC_fontsize_large {
1.911     bisitz   5664:   font-size: 120%;
1.705     tempelho 5665: }
                   5666: 
1.346     albertel 5667: .LC_menubuttons_inline_text {
                   5668:   color: $font;
1.698     harmsja  5669:   font-size: 90%;
1.701     harmsja  5670:   padding-left:3px;
1.346     albertel 5671: }
                   5672: 
1.934     droeschl 5673: .LC_menubuttons_inline_text img{
                   5674:   vertical-align: middle;
                   5675: }
                   5676: 
1.1051    www      5677: li.LC_menubuttons_inline_text img {
1.951     onken    5678:   cursor:pointer;
1.1002    droeschl 5679:   text-decoration: none;
1.951     onken    5680: }
                   5681: 
1.526     www      5682: .LC_menubuttons_link {
                   5683:   text-decoration: none;
                   5684: }
1.795     www      5685: 
1.522     albertel 5686: .LC_menubuttons_category {
1.521     www      5687:   color: $font;
1.526     www      5688:   background: $pgbg;
1.521     www      5689:   font-size: larger;
                   5690:   font-weight: bold;
                   5691: }
                   5692: 
1.346     albertel 5693: td.LC_menubuttons_text {
1.911     bisitz   5694:   color: $font;
1.346     albertel 5695: }
1.706     harmsja  5696: 
1.346     albertel 5697: .LC_current_location {
                   5698:   background: $tabbg;
                   5699: }
1.795     www      5700: 
1.938     bisitz   5701: table.LC_data_table {
1.347     albertel 5702:   border: 1px solid #000000;
1.402     albertel 5703:   border-collapse: separate;
1.426     albertel 5704:   border-spacing: 1px;
1.610     albertel 5705:   background: $pgbg;
1.347     albertel 5706: }
1.795     www      5707: 
1.422     albertel 5708: .LC_data_table_dense {
                   5709:   font-size: small;
                   5710: }
1.795     www      5711: 
1.507     raeburn  5712: table.LC_nested_outer {
                   5713:   border: 1px solid #000000;
1.589     raeburn  5714:   border-collapse: collapse;
1.803     bisitz   5715:   border-spacing: 0;
1.507     raeburn  5716:   width: 100%;
                   5717: }
1.795     www      5718: 
1.879     raeburn  5719: table.LC_innerpickbox,
1.507     raeburn  5720: table.LC_nested {
1.803     bisitz   5721:   border: none;
1.589     raeburn  5722:   border-collapse: collapse;
1.803     bisitz   5723:   border-spacing: 0;
1.507     raeburn  5724:   width: 100%;
                   5725: }
1.795     www      5726: 
1.911     bisitz   5727: table.LC_data_table tr th,
                   5728: table.LC_calendar tr th,
1.879     raeburn  5729: table.LC_prior_tries tr th,
                   5730: table.LC_innerpickbox tr th {
1.349     albertel 5731:   font-weight: bold;
                   5732:   background-color: $data_table_head;
1.801     tempelho 5733:   color:$fontmenu;
1.701     harmsja  5734:   font-size:90%;
1.347     albertel 5735: }
1.795     www      5736: 
1.879     raeburn  5737: table.LC_innerpickbox tr th,
                   5738: table.LC_innerpickbox tr td {
                   5739:   vertical-align: top;
                   5740: }
                   5741: 
1.711     raeburn  5742: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5743:   background-color: #CCCCCC;
1.711     raeburn  5744:   font-weight: bold;
                   5745:   text-align: left;
                   5746: }
1.795     www      5747: 
1.912     bisitz   5748: table.LC_data_table tr.LC_odd_row > td {
                   5749:   background-color: $data_table_light;
                   5750:   padding: 2px;
                   5751:   vertical-align: top;
                   5752: }
                   5753: 
1.809     bisitz   5754: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5755:   background-color: $data_table_light;
1.912     bisitz   5756:   vertical-align: top;
                   5757: }
                   5758: 
                   5759: table.LC_data_table tr.LC_even_row > td {
                   5760:   background-color: $data_table_dark;
1.425     albertel 5761:   padding: 2px;
1.900     bisitz   5762:   vertical-align: top;
1.347     albertel 5763: }
1.795     www      5764: 
1.809     bisitz   5765: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5766:   background-color: $data_table_dark;
1.900     bisitz   5767:   vertical-align: top;
1.347     albertel 5768: }
1.795     www      5769: 
1.425     albertel 5770: table.LC_data_table tr.LC_data_table_highlight td {
                   5771:   background-color: $data_table_darker;
                   5772: }
1.795     www      5773: 
1.639     raeburn  5774: table.LC_data_table tr td.LC_leftcol_header {
                   5775:   background-color: $data_table_head;
                   5776:   font-weight: bold;
                   5777: }
1.795     www      5778: 
1.451     albertel 5779: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5780: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5781:   font-weight: bold;
                   5782:   font-style: italic;
                   5783:   text-align: center;
                   5784:   padding: 8px;
1.347     albertel 5785: }
1.795     www      5786: 
1.1114    raeburn  5787: table.LC_data_table tr.LC_empty_row td,
                   5788: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   5789:   background-color: $sidebg;
                   5790: }
                   5791: 
                   5792: table.LC_nested tr.LC_empty_row td {
                   5793:   background-color: #FFFFFF;
                   5794: }
                   5795: 
1.890     droeschl 5796: table.LC_caption {
                   5797: }
                   5798: 
1.507     raeburn  5799: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5800:   padding: 4ex
                   5801: }
1.795     www      5802: 
1.507     raeburn  5803: table.LC_nested_outer tr th {
                   5804:   font-weight: bold;
1.801     tempelho 5805:   color:$fontmenu;
1.507     raeburn  5806:   background-color: $data_table_head;
1.701     harmsja  5807:   font-size: small;
1.507     raeburn  5808:   border-bottom: 1px solid #000000;
                   5809: }
1.795     www      5810: 
1.507     raeburn  5811: table.LC_nested_outer tr td.LC_subheader {
                   5812:   background-color: $data_table_head;
                   5813:   font-weight: bold;
                   5814:   font-size: small;
                   5815:   border-bottom: 1px solid #000000;
                   5816:   text-align: right;
1.451     albertel 5817: }
1.795     www      5818: 
1.507     raeburn  5819: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5820:   background-color: #CCCCCC;
1.451     albertel 5821:   font-weight: bold;
                   5822:   font-size: small;
1.507     raeburn  5823:   text-align: center;
                   5824: }
1.795     www      5825: 
1.589     raeburn  5826: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5827: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5828:   text-align: left;
1.451     albertel 5829: }
1.795     www      5830: 
1.507     raeburn  5831: table.LC_nested td {
1.735     bisitz   5832:   background-color: #FFFFFF;
1.451     albertel 5833:   font-size: small;
1.507     raeburn  5834: }
1.795     www      5835: 
1.507     raeburn  5836: table.LC_nested_outer tr th.LC_right_item,
                   5837: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5838: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5839: table.LC_nested tr td.LC_right_item {
1.451     albertel 5840:   text-align: right;
                   5841: }
                   5842: 
1.507     raeburn  5843: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5844:   background-color: #EEEEEE;
1.451     albertel 5845: }
                   5846: 
1.473     raeburn  5847: table.LC_createuser {
                   5848: }
                   5849: 
                   5850: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5851:   font-size: small;
1.473     raeburn  5852: }
                   5853: 
                   5854: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5855:   background-color: #CCCCCC;
1.473     raeburn  5856:   font-weight: bold;
                   5857:   text-align: center;
                   5858: }
                   5859: 
1.349     albertel 5860: table.LC_calendar {
                   5861:   border: 1px solid #000000;
                   5862:   border-collapse: collapse;
1.917     raeburn  5863:   width: 98%;
1.349     albertel 5864: }
1.795     www      5865: 
1.349     albertel 5866: table.LC_calendar_pickdate {
                   5867:   font-size: xx-small;
                   5868: }
1.795     www      5869: 
1.349     albertel 5870: table.LC_calendar tr td {
                   5871:   border: 1px solid #000000;
                   5872:   vertical-align: top;
1.917     raeburn  5873:   width: 14%;
1.349     albertel 5874: }
1.795     www      5875: 
1.349     albertel 5876: table.LC_calendar tr td.LC_calendar_day_empty {
                   5877:   background-color: $data_table_dark;
                   5878: }
1.795     www      5879: 
1.779     bisitz   5880: table.LC_calendar tr td.LC_calendar_day_current {
                   5881:   background-color: $data_table_highlight;
1.777     tempelho 5882: }
1.795     www      5883: 
1.938     bisitz   5884: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5885:   background-color: $mail_new;
                   5886: }
1.795     www      5887: 
1.938     bisitz   5888: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5889:   background-color: $mail_new_hover;
                   5890: }
1.795     www      5891: 
1.938     bisitz   5892: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5893:   background-color: $mail_read;
                   5894: }
1.795     www      5895: 
1.938     bisitz   5896: /*
                   5897: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5898:   background-color: $mail_read_hover;
                   5899: }
1.938     bisitz   5900: */
1.795     www      5901: 
1.938     bisitz   5902: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5903:   background-color: $mail_replied;
                   5904: }
1.795     www      5905: 
1.938     bisitz   5906: /*
                   5907: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5908:   background-color: $mail_replied_hover;
                   5909: }
1.938     bisitz   5910: */
1.795     www      5911: 
1.938     bisitz   5912: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5913:   background-color: $mail_other;
                   5914: }
1.795     www      5915: 
1.938     bisitz   5916: /*
                   5917: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5918:   background-color: $mail_other_hover;
                   5919: }
1.938     bisitz   5920: */
1.494     raeburn  5921: 
1.777     tempelho 5922: table.LC_data_table tr > td.LC_browser_file,
                   5923: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5924:   background: #AAEE77;
1.389     albertel 5925: }
1.795     www      5926: 
1.777     tempelho 5927: table.LC_data_table tr > td.LC_browser_file_locked,
                   5928: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5929:   background: #FFAA99;
1.387     albertel 5930: }
1.795     www      5931: 
1.777     tempelho 5932: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5933:   background: #888888;
1.779     bisitz   5934: }
1.795     www      5935: 
1.777     tempelho 5936: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5937: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5938:   background: #F8F866;
1.777     tempelho 5939: }
1.795     www      5940: 
1.696     bisitz   5941: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5942:   background: #E0E8FF;
1.387     albertel 5943: }
1.696     bisitz   5944: 
1.707     bisitz   5945: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5946:   /* background: #77FF77; */
1.707     bisitz   5947: }
1.795     www      5948: 
1.707     bisitz   5949: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5950:   border-right: 8px solid #FFFF77;
1.707     bisitz   5951: }
1.795     www      5952: 
1.707     bisitz   5953: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5954:   border-right: 8px solid #FFAA77;
1.707     bisitz   5955: }
1.795     www      5956: 
1.707     bisitz   5957: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5958:   border-right: 8px solid #FF7777;
1.707     bisitz   5959: }
1.795     www      5960: 
1.707     bisitz   5961: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5962:   border-right: 8px solid #AAFF77;
1.707     bisitz   5963: }
1.795     www      5964: 
1.707     bisitz   5965: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5966:   border-right: 8px solid #11CC55;
1.707     bisitz   5967: }
                   5968: 
1.388     albertel 5969: span.LC_current_location {
1.701     harmsja  5970:   font-size:larger;
1.388     albertel 5971:   background: $pgbg;
                   5972: }
1.387     albertel 5973: 
1.1029    www      5974: span.LC_current_nav_location {
                   5975:   font-weight:bold;
                   5976:   background: $sidebg;
                   5977: }
                   5978: 
1.395     albertel 5979: span.LC_parm_menu_item {
                   5980:   font-size: larger;
                   5981: }
1.795     www      5982: 
1.395     albertel 5983: span.LC_parm_scope_all {
                   5984:   color: red;
                   5985: }
1.795     www      5986: 
1.395     albertel 5987: span.LC_parm_scope_folder {
                   5988:   color: green;
                   5989: }
1.795     www      5990: 
1.395     albertel 5991: span.LC_parm_scope_resource {
                   5992:   color: orange;
                   5993: }
1.795     www      5994: 
1.395     albertel 5995: span.LC_parm_part {
                   5996:   color: blue;
                   5997: }
1.795     www      5998: 
1.911     bisitz   5999: span.LC_parm_folder,
                   6000: span.LC_parm_symb {
1.395     albertel 6001:   font-size: x-small;
                   6002:   font-family: $mono;
                   6003:   color: #AAAAAA;
                   6004: }
                   6005: 
1.977     bisitz   6006: ul.LC_parm_parmlist li {
                   6007:   display: inline-block;
                   6008:   padding: 0.3em 0.8em;
                   6009:   vertical-align: top;
                   6010:   width: 150px;
                   6011:   border-top:1px solid $lg_border_color;
                   6012: }
                   6013: 
1.795     www      6014: td.LC_parm_overview_level_menu,
                   6015: td.LC_parm_overview_map_menu,
                   6016: td.LC_parm_overview_parm_selectors,
                   6017: td.LC_parm_overview_restrictions  {
1.396     albertel 6018:   border: 1px solid black;
                   6019:   border-collapse: collapse;
                   6020: }
1.795     www      6021: 
1.396     albertel 6022: table.LC_parm_overview_restrictions td {
                   6023:   border-width: 1px 4px 1px 4px;
                   6024:   border-style: solid;
                   6025:   border-color: $pgbg;
                   6026:   text-align: center;
                   6027: }
1.795     www      6028: 
1.396     albertel 6029: table.LC_parm_overview_restrictions th {
                   6030:   background: $tabbg;
                   6031:   border-width: 1px 4px 1px 4px;
                   6032:   border-style: solid;
                   6033:   border-color: $pgbg;
                   6034: }
1.795     www      6035: 
1.398     albertel 6036: table#LC_helpmenu {
1.803     bisitz   6037:   border: none;
1.398     albertel 6038:   height: 55px;
1.803     bisitz   6039:   border-spacing: 0;
1.398     albertel 6040: }
                   6041: 
                   6042: table#LC_helpmenu fieldset legend {
                   6043:   font-size: larger;
                   6044: }
1.795     www      6045: 
1.397     albertel 6046: table#LC_helpmenu_links {
                   6047:   width: 100%;
                   6048:   border: 1px solid black;
                   6049:   background: $pgbg;
1.803     bisitz   6050:   padding: 0;
1.397     albertel 6051:   border-spacing: 1px;
                   6052: }
1.795     www      6053: 
1.397     albertel 6054: table#LC_helpmenu_links tr td {
                   6055:   padding: 1px;
                   6056:   background: $tabbg;
1.399     albertel 6057:   text-align: center;
                   6058:   font-weight: bold;
1.397     albertel 6059: }
1.396     albertel 6060: 
1.795     www      6061: table#LC_helpmenu_links a:link,
                   6062: table#LC_helpmenu_links a:visited,
1.397     albertel 6063: table#LC_helpmenu_links a:active {
                   6064:   text-decoration: none;
                   6065:   color: $font;
                   6066: }
1.795     www      6067: 
1.397     albertel 6068: table#LC_helpmenu_links a:hover {
                   6069:   text-decoration: underline;
                   6070:   color: $vlink;
                   6071: }
1.396     albertel 6072: 
1.417     albertel 6073: .LC_chrt_popup_exists {
                   6074:   border: 1px solid #339933;
                   6075:   margin: -1px;
                   6076: }
1.795     www      6077: 
1.417     albertel 6078: .LC_chrt_popup_up {
                   6079:   border: 1px solid yellow;
                   6080:   margin: -1px;
                   6081: }
1.795     www      6082: 
1.417     albertel 6083: .LC_chrt_popup {
                   6084:   border: 1px solid #8888FF;
                   6085:   background: #CCCCFF;
                   6086: }
1.795     www      6087: 
1.421     albertel 6088: table.LC_pick_box {
                   6089:   border-collapse: separate;
                   6090:   background: white;
                   6091:   border: 1px solid black;
                   6092:   border-spacing: 1px;
                   6093: }
1.795     www      6094: 
1.421     albertel 6095: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6096:   background: $sidebg;
1.421     albertel 6097:   font-weight: bold;
1.900     bisitz   6098:   text-align: left;
1.740     bisitz   6099:   vertical-align: top;
1.421     albertel 6100:   width: 184px;
                   6101:   padding: 8px;
                   6102: }
1.795     www      6103: 
1.579     raeburn  6104: table.LC_pick_box td.LC_pick_box_value {
                   6105:   text-align: left;
                   6106:   padding: 8px;
                   6107: }
1.795     www      6108: 
1.579     raeburn  6109: table.LC_pick_box td.LC_pick_box_select {
                   6110:   text-align: left;
                   6111:   padding: 8px;
                   6112: }
1.795     www      6113: 
1.424     albertel 6114: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6115:   padding: 0;
1.421     albertel 6116:   height: 1px;
                   6117:   background: black;
                   6118: }
1.795     www      6119: 
1.421     albertel 6120: table.LC_pick_box td.LC_pick_box_submit {
                   6121:   text-align: right;
                   6122: }
1.795     www      6123: 
1.579     raeburn  6124: table.LC_pick_box td.LC_evenrow_value {
                   6125:   text-align: left;
                   6126:   padding: 8px;
                   6127:   background-color: $data_table_light;
                   6128: }
1.795     www      6129: 
1.579     raeburn  6130: table.LC_pick_box td.LC_oddrow_value {
                   6131:   text-align: left;
                   6132:   padding: 8px;
                   6133:   background-color: $data_table_light;
                   6134: }
1.795     www      6135: 
1.579     raeburn  6136: span.LC_helpform_receipt_cat {
                   6137:   font-weight: bold;
                   6138: }
1.795     www      6139: 
1.424     albertel 6140: table.LC_group_priv_box {
                   6141:   background: white;
                   6142:   border: 1px solid black;
                   6143:   border-spacing: 1px;
                   6144: }
1.795     www      6145: 
1.424     albertel 6146: table.LC_group_priv_box td.LC_pick_box_title {
                   6147:   background: $tabbg;
                   6148:   font-weight: bold;
                   6149:   text-align: right;
                   6150:   width: 184px;
                   6151: }
1.795     www      6152: 
1.424     albertel 6153: table.LC_group_priv_box td.LC_groups_fixed {
                   6154:   background: $data_table_light;
                   6155:   text-align: center;
                   6156: }
1.795     www      6157: 
1.424     albertel 6158: table.LC_group_priv_box td.LC_groups_optional {
                   6159:   background: $data_table_dark;
                   6160:   text-align: center;
                   6161: }
1.795     www      6162: 
1.424     albertel 6163: table.LC_group_priv_box td.LC_groups_functionality {
                   6164:   background: $data_table_darker;
                   6165:   text-align: center;
                   6166:   font-weight: bold;
                   6167: }
1.795     www      6168: 
1.424     albertel 6169: table.LC_group_priv td {
                   6170:   text-align: left;
1.803     bisitz   6171:   padding: 0;
1.424     albertel 6172: }
                   6173: 
                   6174: .LC_navbuttons {
                   6175:   margin: 2ex 0ex 2ex 0ex;
                   6176: }
1.795     www      6177: 
1.423     albertel 6178: .LC_topic_bar {
                   6179:   font-weight: bold;
                   6180:   background: $tabbg;
1.918     wenzelju 6181:   margin: 1em 0em 1em 2em;
1.805     bisitz   6182:   padding: 3px;
1.918     wenzelju 6183:   font-size: 1.2em;
1.423     albertel 6184: }
1.795     www      6185: 
1.423     albertel 6186: .LC_topic_bar span {
1.918     wenzelju 6187:   left: 0.5em;
                   6188:   position: absolute;
1.423     albertel 6189:   vertical-align: middle;
1.918     wenzelju 6190:   font-size: 1.2em;
1.423     albertel 6191: }
1.795     www      6192: 
1.423     albertel 6193: table.LC_course_group_status {
                   6194:   margin: 20px;
                   6195: }
1.795     www      6196: 
1.423     albertel 6197: table.LC_status_selector td {
                   6198:   vertical-align: top;
                   6199:   text-align: center;
1.424     albertel 6200:   padding: 4px;
                   6201: }
1.795     www      6202: 
1.599     albertel 6203: div.LC_feedback_link {
1.616     albertel 6204:   clear: both;
1.829     kalberla 6205:   background: $sidebg;
1.779     bisitz   6206:   width: 100%;
1.829     kalberla 6207:   padding-bottom: 10px;
                   6208:   border: 1px $tabbg solid;
1.833     kalberla 6209:   height: 22px;
                   6210:   line-height: 22px;
                   6211:   padding-top: 5px;
                   6212: }
                   6213: 
                   6214: div.LC_feedback_link img {
                   6215:   height: 22px;
1.867     kalberla 6216:   vertical-align:middle;
1.829     kalberla 6217: }
                   6218: 
1.911     bisitz   6219: div.LC_feedback_link a {
1.829     kalberla 6220:   text-decoration: none;
1.489     raeburn  6221: }
1.795     www      6222: 
1.867     kalberla 6223: div.LC_comblock {
1.911     bisitz   6224:   display:inline;
1.867     kalberla 6225:   color:$font;
                   6226:   font-size:90%;
                   6227: }
                   6228: 
                   6229: div.LC_feedback_link div.LC_comblock {
                   6230:   padding-left:5px;
                   6231: }
                   6232: 
                   6233: div.LC_feedback_link div.LC_comblock a {
                   6234:   color:$font;
                   6235: }
                   6236: 
1.489     raeburn  6237: span.LC_feedback_link {
1.858     bisitz   6238:   /* background: $feedback_link_bg; */
1.599     albertel 6239:   font-size: larger;
                   6240: }
1.795     www      6241: 
1.599     albertel 6242: span.LC_message_link {
1.858     bisitz   6243:   /* background: $feedback_link_bg; */
1.599     albertel 6244:   font-size: larger;
                   6245:   position: absolute;
                   6246:   right: 1em;
1.489     raeburn  6247: }
1.421     albertel 6248: 
1.515     albertel 6249: table.LC_prior_tries {
1.524     albertel 6250:   border: 1px solid #000000;
                   6251:   border-collapse: separate;
                   6252:   border-spacing: 1px;
1.515     albertel 6253: }
1.523     albertel 6254: 
1.515     albertel 6255: table.LC_prior_tries td {
1.524     albertel 6256:   padding: 2px;
1.515     albertel 6257: }
1.523     albertel 6258: 
                   6259: .LC_answer_correct {
1.795     www      6260:   background: lightgreen;
                   6261:   color: darkgreen;
                   6262:   padding: 6px;
1.523     albertel 6263: }
1.795     www      6264: 
1.523     albertel 6265: .LC_answer_charged_try {
1.797     www      6266:   background: #FFAAAA;
1.795     www      6267:   color: darkred;
                   6268:   padding: 6px;
1.523     albertel 6269: }
1.795     www      6270: 
1.779     bisitz   6271: .LC_answer_not_charged_try,
1.523     albertel 6272: .LC_answer_no_grade,
                   6273: .LC_answer_late {
1.795     www      6274:   background: lightyellow;
1.523     albertel 6275:   color: black;
1.795     www      6276:   padding: 6px;
1.523     albertel 6277: }
1.795     www      6278: 
1.523     albertel 6279: .LC_answer_previous {
1.795     www      6280:   background: lightblue;
                   6281:   color: darkblue;
                   6282:   padding: 6px;
1.523     albertel 6283: }
1.795     www      6284: 
1.779     bisitz   6285: .LC_answer_no_message {
1.777     tempelho 6286:   background: #FFFFFF;
                   6287:   color: black;
1.795     www      6288:   padding: 6px;
1.779     bisitz   6289: }
1.795     www      6290: 
1.779     bisitz   6291: .LC_answer_unknown {
                   6292:   background: orange;
                   6293:   color: black;
1.795     www      6294:   padding: 6px;
1.777     tempelho 6295: }
1.795     www      6296: 
1.529     albertel 6297: span.LC_prior_numerical,
                   6298: span.LC_prior_string,
                   6299: span.LC_prior_custom,
                   6300: span.LC_prior_reaction,
                   6301: span.LC_prior_math {
1.925     bisitz   6302:   font-family: $mono;
1.523     albertel 6303:   white-space: pre;
                   6304: }
                   6305: 
1.525     albertel 6306: span.LC_prior_string {
1.925     bisitz   6307:   font-family: $mono;
1.525     albertel 6308:   white-space: pre;
                   6309: }
                   6310: 
1.523     albertel 6311: table.LC_prior_option {
                   6312:   width: 100%;
                   6313:   border-collapse: collapse;
                   6314: }
1.795     www      6315: 
1.911     bisitz   6316: table.LC_prior_rank,
1.795     www      6317: table.LC_prior_match {
1.528     albertel 6318:   border-collapse: collapse;
                   6319: }
1.795     www      6320: 
1.528     albertel 6321: table.LC_prior_option tr td,
                   6322: table.LC_prior_rank tr td,
                   6323: table.LC_prior_match tr td {
1.524     albertel 6324:   border: 1px solid #000000;
1.515     albertel 6325: }
                   6326: 
1.855     bisitz   6327: .LC_nobreak {
1.544     albertel 6328:   white-space: nowrap;
1.519     raeburn  6329: }
                   6330: 
1.576     raeburn  6331: span.LC_cusr_emph {
                   6332:   font-style: italic;
                   6333: }
                   6334: 
1.633     raeburn  6335: span.LC_cusr_subheading {
                   6336:   font-weight: normal;
                   6337:   font-size: 85%;
                   6338: }
                   6339: 
1.861     bisitz   6340: div.LC_docs_entry_move {
1.859     bisitz   6341:   border: 1px solid #BBBBBB;
1.545     albertel 6342:   background: #DDDDDD;
1.861     bisitz   6343:   width: 22px;
1.859     bisitz   6344:   padding: 1px;
                   6345:   margin: 0;
1.545     albertel 6346: }
                   6347: 
1.861     bisitz   6348: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6349: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6350:   font-size: x-small;
                   6351: }
1.795     www      6352: 
1.861     bisitz   6353: .LC_docs_entry_parameter {
                   6354:   white-space: nowrap;
                   6355: }
                   6356: 
1.544     albertel 6357: .LC_docs_copy {
1.545     albertel 6358:   color: #000099;
1.544     albertel 6359: }
1.795     www      6360: 
1.544     albertel 6361: .LC_docs_cut {
1.545     albertel 6362:   color: #550044;
1.544     albertel 6363: }
1.795     www      6364: 
1.544     albertel 6365: .LC_docs_rename {
1.545     albertel 6366:   color: #009900;
1.544     albertel 6367: }
1.795     www      6368: 
1.544     albertel 6369: .LC_docs_remove {
1.545     albertel 6370:   color: #990000;
                   6371: }
                   6372: 
1.547     albertel 6373: .LC_docs_reinit_warn,
                   6374: .LC_docs_ext_edit {
                   6375:   font-size: x-small;
                   6376: }
                   6377: 
1.545     albertel 6378: table.LC_docs_adddocs td,
                   6379: table.LC_docs_adddocs th {
                   6380:   border: 1px solid #BBBBBB;
                   6381:   padding: 4px;
                   6382:   background: #DDDDDD;
1.543     albertel 6383: }
                   6384: 
1.584     albertel 6385: table.LC_sty_begin {
                   6386:   background: #BBFFBB;
                   6387: }
1.795     www      6388: 
1.584     albertel 6389: table.LC_sty_end {
                   6390:   background: #FFBBBB;
                   6391: }
                   6392: 
1.589     raeburn  6393: table.LC_double_column {
1.803     bisitz   6394:   border-width: 0;
1.589     raeburn  6395:   border-collapse: collapse;
                   6396:   width: 100%;
                   6397:   padding: 2px;
                   6398: }
                   6399: 
                   6400: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6401:   top: 2px;
1.589     raeburn  6402:   left: 2px;
                   6403:   width: 47%;
                   6404:   vertical-align: top;
                   6405: }
                   6406: 
                   6407: table.LC_double_column tr td.LC_right_col {
                   6408:   top: 2px;
1.779     bisitz   6409:   right: 2px;
1.589     raeburn  6410:   width: 47%;
                   6411:   vertical-align: top;
                   6412: }
                   6413: 
1.591     raeburn  6414: div.LC_left_float {
                   6415:   float: left;
                   6416:   padding-right: 5%;
1.597     albertel 6417:   padding-bottom: 4px;
1.591     raeburn  6418: }
                   6419: 
                   6420: div.LC_clear_float_header {
1.597     albertel 6421:   padding-bottom: 2px;
1.591     raeburn  6422: }
                   6423: 
                   6424: div.LC_clear_float_footer {
1.597     albertel 6425:   padding-top: 10px;
1.591     raeburn  6426:   clear: both;
                   6427: }
                   6428: 
1.597     albertel 6429: div.LC_grade_show_user {
1.941     bisitz   6430: /*  border-left: 5px solid $sidebg; */
                   6431:   border-top: 5px solid #000000;
                   6432:   margin: 50px 0 0 0;
1.936     bisitz   6433:   padding: 15px 0 5px 10px;
1.597     albertel 6434: }
1.795     www      6435: 
1.936     bisitz   6436: div.LC_grade_show_user_odd_row {
1.941     bisitz   6437: /*  border-left: 5px solid #000000; */
                   6438: }
                   6439: 
                   6440: div.LC_grade_show_user div.LC_Box {
                   6441:   margin-right: 50px;
1.597     albertel 6442: }
                   6443: 
                   6444: div.LC_grade_submissions,
                   6445: div.LC_grade_message_center,
1.936     bisitz   6446: div.LC_grade_info_links {
1.597     albertel 6447:   margin: 5px;
                   6448:   width: 99%;
                   6449:   background: #FFFFFF;
                   6450: }
1.795     www      6451: 
1.597     albertel 6452: div.LC_grade_submissions_header,
1.936     bisitz   6453: div.LC_grade_message_center_header {
1.705     tempelho 6454:   font-weight: bold;
                   6455:   font-size: large;
1.597     albertel 6456: }
1.795     www      6457: 
1.597     albertel 6458: div.LC_grade_submissions_body,
1.936     bisitz   6459: div.LC_grade_message_center_body {
1.597     albertel 6460:   border: 1px solid black;
                   6461:   width: 99%;
                   6462:   background: #FFFFFF;
                   6463: }
1.795     www      6464: 
1.613     albertel 6465: table.LC_scantron_action {
                   6466:   width: 100%;
                   6467: }
1.795     www      6468: 
1.613     albertel 6469: table.LC_scantron_action tr th {
1.698     harmsja  6470:   font-weight:bold;
                   6471:   font-style:normal;
1.613     albertel 6472: }
1.795     www      6473: 
1.779     bisitz   6474: .LC_edit_problem_header,
1.614     albertel 6475: div.LC_edit_problem_footer {
1.705     tempelho 6476:   font-weight: normal;
                   6477:   font-size:  medium;
1.602     albertel 6478:   margin: 2px;
1.1060    bisitz   6479:   background-color: $sidebg;
1.600     albertel 6480: }
1.795     www      6481: 
1.600     albertel 6482: div.LC_edit_problem_header,
1.602     albertel 6483: div.LC_edit_problem_header div,
1.614     albertel 6484: div.LC_edit_problem_footer,
                   6485: div.LC_edit_problem_footer div,
1.602     albertel 6486: div.LC_edit_problem_editxml_header,
                   6487: div.LC_edit_problem_editxml_header div {
1.600     albertel 6488:   margin-top: 5px;
                   6489: }
1.795     www      6490: 
1.600     albertel 6491: div.LC_edit_problem_header_title {
1.705     tempelho 6492:   font-weight: bold;
                   6493:   font-size: larger;
1.602     albertel 6494:   background: $tabbg;
                   6495:   padding: 3px;
1.1060    bisitz   6496:   margin: 0 0 5px 0;
1.602     albertel 6497: }
1.795     www      6498: 
1.602     albertel 6499: table.LC_edit_problem_header_title {
                   6500:   width: 100%;
1.600     albertel 6501:   background: $tabbg;
1.602     albertel 6502: }
                   6503: 
                   6504: div.LC_edit_problem_discards {
                   6505:   float: left;
                   6506:   padding-bottom: 5px;
                   6507: }
1.795     www      6508: 
1.602     albertel 6509: div.LC_edit_problem_saves {
                   6510:   float: right;
                   6511:   padding-bottom: 5px;
1.600     albertel 6512: }
1.795     www      6513: 
1.1124    bisitz   6514: .LC_edit_opt {
                   6515:   padding-left: 1em;
                   6516:   white-space: nowrap;
                   6517: }
                   6518: 
1.1152    golterma 6519: .LC_edit_problem_latexhelper{
                   6520:     text-align: right;
                   6521: }
                   6522: 
                   6523: #LC_edit_problem_colorful div{
                   6524:     margin-left: 40px;
                   6525: }
                   6526: 
1.911     bisitz   6527: img.stift {
1.803     bisitz   6528:   border-width: 0;
                   6529:   vertical-align: middle;
1.677     riegler  6530: }
1.680     riegler  6531: 
1.923     bisitz   6532: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6533:   vertical-align: top;
1.777     tempelho 6534: }
1.795     www      6535: 
1.716     raeburn  6536: div.LC_createcourse {
1.911     bisitz   6537:   margin: 10px 10px 10px 10px;
1.716     raeburn  6538: }
                   6539: 
1.917     raeburn  6540: .LC_dccid {
1.1130    raeburn  6541:   float: right;
1.917     raeburn  6542:   margin: 0.2em 0 0 0;
                   6543:   padding: 0;
                   6544:   font-size: 90%;
                   6545:   display:none;
                   6546: }
                   6547: 
1.897     wenzelju 6548: ol.LC_primary_menu a:hover,
1.721     harmsja  6549: ol#LC_MenuBreadcrumbs a:hover,
                   6550: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6551: ul#LC_secondary_menu a:hover,
1.721     harmsja  6552: .LC_FormSectionClearButton input:hover
1.795     www      6553: ul.LC_TabContent   li:hover a {
1.952     onken    6554:   color:$button_hover;
1.911     bisitz   6555:   text-decoration:none;
1.693     droeschl 6556: }
                   6557: 
1.779     bisitz   6558: h1 {
1.911     bisitz   6559:   padding: 0;
                   6560:   line-height:130%;
1.693     droeschl 6561: }
1.698     harmsja  6562: 
1.911     bisitz   6563: h2,
                   6564: h3,
                   6565: h4,
                   6566: h5,
                   6567: h6 {
                   6568:   margin: 5px 0 5px 0;
                   6569:   padding: 0;
                   6570:   line-height:130%;
1.693     droeschl 6571: }
1.795     www      6572: 
                   6573: .LC_hcell {
1.911     bisitz   6574:   padding:3px 15px 3px 15px;
                   6575:   margin: 0;
                   6576:   background-color:$tabbg;
                   6577:   color:$fontmenu;
                   6578:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6579: }
1.795     www      6580: 
1.840     bisitz   6581: .LC_Box > .LC_hcell {
1.911     bisitz   6582:   margin: 0 -10px 10px -10px;
1.835     bisitz   6583: }
                   6584: 
1.721     harmsja  6585: .LC_noBorder {
1.911     bisitz   6586:   border: 0;
1.698     harmsja  6587: }
1.693     droeschl 6588: 
1.721     harmsja  6589: .LC_FormSectionClearButton input {
1.911     bisitz   6590:   background-color:transparent;
                   6591:   border: none;
                   6592:   cursor:pointer;
                   6593:   text-decoration:underline;
1.693     droeschl 6594: }
1.763     bisitz   6595: 
                   6596: .LC_help_open_topic {
1.911     bisitz   6597:   color: #FFFFFF;
                   6598:   background-color: #EEEEFF;
                   6599:   margin: 1px;
                   6600:   padding: 4px;
                   6601:   border: 1px solid #000033;
                   6602:   white-space: nowrap;
                   6603:   /* vertical-align: middle; */
1.759     neumanie 6604: }
1.693     droeschl 6605: 
1.911     bisitz   6606: dl,
                   6607: ul,
                   6608: div,
                   6609: fieldset {
                   6610:   margin: 10px 10px 10px 0;
                   6611:   /* overflow: hidden; */
1.693     droeschl 6612: }
1.795     www      6613: 
1.838     bisitz   6614: fieldset > legend {
1.911     bisitz   6615:   font-weight: bold;
                   6616:   padding: 0 5px 0 5px;
1.838     bisitz   6617: }
                   6618: 
1.813     bisitz   6619: #LC_nav_bar {
1.911     bisitz   6620:   float: left;
1.995     raeburn  6621:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6622:   margin: 0 0 2px 0;
1.807     droeschl 6623: }
                   6624: 
1.916     droeschl 6625: #LC_realm {
                   6626:   margin: 0.2em 0 0 0;
                   6627:   padding: 0;
                   6628:   font-weight: bold;
                   6629:   text-align: center;
1.995     raeburn  6630:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6631: }
                   6632: 
1.911     bisitz   6633: #LC_nav_bar em {
                   6634:   font-weight: bold;
                   6635:   font-style: normal;
1.807     droeschl 6636: }
                   6637: 
1.897     wenzelju 6638: ol.LC_primary_menu {
1.934     droeschl 6639:   margin: 0;
1.1076    raeburn  6640:   padding: 0;
1.995     raeburn  6641:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6642: }
                   6643: 
1.852     droeschl 6644: ol#LC_PathBreadcrumbs {
1.911     bisitz   6645:   margin: 0;
1.693     droeschl 6646: }
                   6647: 
1.897     wenzelju 6648: ol.LC_primary_menu li {
1.1076    raeburn  6649:   color: RGB(80, 80, 80);
                   6650:   vertical-align: middle;
                   6651:   text-align: left;
                   6652:   list-style: none;
                   6653:   float: left;
                   6654: }
                   6655: 
                   6656: ol.LC_primary_menu li a {
                   6657:   display: block;
                   6658:   margin: 0;
                   6659:   padding: 0 5px 0 10px;
                   6660:   text-decoration: none;
                   6661: }
                   6662: 
                   6663: ol.LC_primary_menu li ul {
                   6664:   display: none;
                   6665:   width: 10em;
                   6666:   background-color: $data_table_light;
                   6667: }
                   6668: 
                   6669: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
                   6670:   display: block;
                   6671:   position: absolute;
                   6672:   margin: 0;
                   6673:   padding: 0;
1.1078    raeburn  6674:   z-index: 2;
1.1076    raeburn  6675: }
                   6676: 
                   6677: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
                   6678:   font-size: 90%;
1.911     bisitz   6679:   vertical-align: top;
1.1076    raeburn  6680:   float: none;
1.1079    raeburn  6681:   border-left: 1px solid black;
                   6682:   border-right: 1px solid black;
1.1076    raeburn  6683: }
                   6684: 
                   6685: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1078    raeburn  6686:   background-color:$data_table_light;
1.1076    raeburn  6687: }
                   6688: 
                   6689: ol.LC_primary_menu li li a:hover {
                   6690:    color:$button_hover;
                   6691:    background-color:$data_table_dark;
1.693     droeschl 6692: }
                   6693: 
1.897     wenzelju 6694: ol.LC_primary_menu li img {
1.911     bisitz   6695:   vertical-align: bottom;
1.934     droeschl 6696:   height: 1.1em;
1.1077    raeburn  6697:   margin: 0.2em 0 0 0;
1.693     droeschl 6698: }
                   6699: 
1.897     wenzelju 6700: ol.LC_primary_menu a {
1.911     bisitz   6701:   color: RGB(80, 80, 80);
                   6702:   text-decoration: none;
1.693     droeschl 6703: }
1.795     www      6704: 
1.949     droeschl 6705: ol.LC_primary_menu a.LC_new_message {
                   6706:   font-weight:bold;
                   6707:   color: darkred;
                   6708: }
                   6709: 
1.975     raeburn  6710: ol.LC_docs_parameters {
                   6711:   margin-left: 0;
                   6712:   padding: 0;
                   6713:   list-style: none;
                   6714: }
                   6715: 
                   6716: ol.LC_docs_parameters li {
                   6717:   margin: 0;
                   6718:   padding-right: 20px;
                   6719:   display: inline;
                   6720: }
                   6721: 
1.976     raeburn  6722: ol.LC_docs_parameters li:before {
                   6723:   content: "\\002022 \\0020";
                   6724: }
                   6725: 
                   6726: li.LC_docs_parameters_title {
                   6727:   font-weight: bold;
                   6728: }
                   6729: 
                   6730: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6731:   content: "";
                   6732: }
                   6733: 
1.897     wenzelju 6734: ul#LC_secondary_menu {
1.1107    raeburn  6735:   clear: right;
1.911     bisitz   6736:   color: $fontmenu;
                   6737:   background: $tabbg;
                   6738:   list-style: none;
                   6739:   padding: 0;
                   6740:   margin: 0;
                   6741:   width: 100%;
1.995     raeburn  6742:   text-align: left;
1.1107    raeburn  6743:   float: left;
1.808     droeschl 6744: }
                   6745: 
1.897     wenzelju 6746: ul#LC_secondary_menu li {
1.911     bisitz   6747:   font-weight: bold;
                   6748:   line-height: 1.8em;
1.1107    raeburn  6749:   border-right: 1px solid black;
                   6750:   float: left;
                   6751: }
                   6752: 
                   6753: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   6754:   background-color: $data_table_light;
                   6755: }
                   6756: 
                   6757: ul#LC_secondary_menu li a {
1.911     bisitz   6758:   padding: 0 0.8em;
1.1107    raeburn  6759: }
                   6760: 
                   6761: ul#LC_secondary_menu li ul {
                   6762:   display: none;
                   6763: }
                   6764: 
                   6765: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   6766:   display: block;
                   6767:   position: absolute;
                   6768:   margin: 0;
                   6769:   padding: 0;
                   6770:   list-style:none;
                   6771:   float: none;
                   6772:   background-color: $data_table_light;
                   6773:   z-index: 2;
                   6774:   margin-left: -1px;
                   6775: }
                   6776: 
                   6777: ul#LC_secondary_menu li ul li {
                   6778:   font-size: 90%;
                   6779:   vertical-align: top;
                   6780:   border-left: 1px solid black;
1.911     bisitz   6781:   border-right: 1px solid black;
1.1119    raeburn  6782:   background-color: $data_table_light;
1.1107    raeburn  6783:   list-style:none;
                   6784:   float: none;
                   6785: }
                   6786: 
                   6787: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   6788:   background-color: $data_table_dark;
1.807     droeschl 6789: }
                   6790: 
1.847     tempelho 6791: ul.LC_TabContent {
1.911     bisitz   6792:   display:block;
                   6793:   background: $sidebg;
                   6794:   border-bottom: solid 1px $lg_border_color;
                   6795:   list-style:none;
1.1020    raeburn  6796:   margin: -1px -10px 0 -10px;
1.911     bisitz   6797:   padding: 0;
1.693     droeschl 6798: }
                   6799: 
1.795     www      6800: ul.LC_TabContent li,
                   6801: ul.LC_TabContentBigger li {
1.911     bisitz   6802:   float:left;
1.741     harmsja  6803: }
1.795     www      6804: 
1.897     wenzelju 6805: ul#LC_secondary_menu li a {
1.911     bisitz   6806:   color: $fontmenu;
                   6807:   text-decoration: none;
1.693     droeschl 6808: }
1.795     www      6809: 
1.721     harmsja  6810: ul.LC_TabContent {
1.952     onken    6811:   min-height:20px;
1.721     harmsja  6812: }
1.795     www      6813: 
                   6814: ul.LC_TabContent li {
1.911     bisitz   6815:   vertical-align:middle;
1.959     onken    6816:   padding: 0 16px 0 10px;
1.911     bisitz   6817:   background-color:$tabbg;
                   6818:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6819:   border-left: solid 1px $font;
1.721     harmsja  6820: }
1.795     www      6821: 
1.847     tempelho 6822: ul.LC_TabContent .right {
1.911     bisitz   6823:   float:right;
1.847     tempelho 6824: }
                   6825: 
1.911     bisitz   6826: ul.LC_TabContent li a,
                   6827: ul.LC_TabContent li {
                   6828:   color:rgb(47,47,47);
                   6829:   text-decoration:none;
                   6830:   font-size:95%;
                   6831:   font-weight:bold;
1.952     onken    6832:   min-height:20px;
                   6833: }
                   6834: 
1.959     onken    6835: ul.LC_TabContent li a:hover,
                   6836: ul.LC_TabContent li a:focus {
1.952     onken    6837:   color: $button_hover;
1.959     onken    6838:   background:none;
                   6839:   outline:none;
1.952     onken    6840: }
                   6841: 
                   6842: ul.LC_TabContent li:hover {
                   6843:   color: $button_hover;
                   6844:   cursor:pointer;
1.721     harmsja  6845: }
1.795     www      6846: 
1.911     bisitz   6847: ul.LC_TabContent li.active {
1.952     onken    6848:   color: $font;
1.911     bisitz   6849:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6850:   border-bottom:solid 1px #FFFFFF;
                   6851:   cursor: default;
1.744     ehlerst  6852: }
1.795     www      6853: 
1.959     onken    6854: ul.LC_TabContent li.active a {
                   6855:   color:$font;
                   6856:   background:#FFFFFF;
                   6857:   outline: none;
                   6858: }
1.1047    raeburn  6859: 
                   6860: ul.LC_TabContent li.goback {
                   6861:   float: left;
                   6862:   border-left: none;
                   6863: }
                   6864: 
1.870     tempelho 6865: #maincoursedoc {
1.911     bisitz   6866:   clear:both;
1.870     tempelho 6867: }
                   6868: 
                   6869: ul.LC_TabContentBigger {
1.911     bisitz   6870:   display:block;
                   6871:   list-style:none;
                   6872:   padding: 0;
1.870     tempelho 6873: }
                   6874: 
1.795     www      6875: ul.LC_TabContentBigger li {
1.911     bisitz   6876:   vertical-align:bottom;
                   6877:   height: 30px;
                   6878:   font-size:110%;
                   6879:   font-weight:bold;
                   6880:   color: #737373;
1.841     tempelho 6881: }
                   6882: 
1.957     onken    6883: ul.LC_TabContentBigger li.active {
                   6884:   position: relative;
                   6885:   top: 1px;
                   6886: }
                   6887: 
1.870     tempelho 6888: ul.LC_TabContentBigger li a {
1.911     bisitz   6889:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6890:   height: 30px;
                   6891:   line-height: 30px;
                   6892:   text-align: center;
                   6893:   display: block;
                   6894:   text-decoration: none;
1.958     onken    6895:   outline: none;  
1.741     harmsja  6896: }
1.795     www      6897: 
1.870     tempelho 6898: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6899:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6900:   color:$font;
1.744     ehlerst  6901: }
1.795     www      6902: 
1.870     tempelho 6903: ul.LC_TabContentBigger li b {
1.911     bisitz   6904:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6905:   display: block;
                   6906:   float: left;
                   6907:   padding: 0 30px;
1.957     onken    6908:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6909: }
                   6910: 
1.956     onken    6911: ul.LC_TabContentBigger li:hover b {
                   6912:   color:$button_hover;
                   6913: }
                   6914: 
1.870     tempelho 6915: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6916:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6917:   color:$font;
1.957     onken    6918:   border: 0;
1.741     harmsja  6919: }
1.693     droeschl 6920: 
1.870     tempelho 6921: 
1.862     bisitz   6922: ul.LC_CourseBreadcrumbs {
                   6923:   background: $sidebg;
1.1020    raeburn  6924:   height: 2em;
1.862     bisitz   6925:   padding-left: 10px;
1.1020    raeburn  6926:   margin: 0;
1.862     bisitz   6927:   list-style-position: inside;
                   6928: }
                   6929: 
1.911     bisitz   6930: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6931: ol#LC_PathBreadcrumbs {
1.911     bisitz   6932:   padding-left: 10px;
                   6933:   margin: 0;
1.933     droeschl 6934:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6935: }
                   6936: 
1.911     bisitz   6937: ol#LC_MenuBreadcrumbs li,
                   6938: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6939: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6940:   display: inline;
1.933     droeschl 6941:   white-space: normal;  
1.693     droeschl 6942: }
                   6943: 
1.823     bisitz   6944: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6945: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6946:   text-decoration: none;
                   6947:   font-size:90%;
1.693     droeschl 6948: }
1.795     www      6949: 
1.969     droeschl 6950: ol#LC_MenuBreadcrumbs h1 {
                   6951:   display: inline;
                   6952:   font-size: 90%;
                   6953:   line-height: 2.5em;
                   6954:   margin: 0;
                   6955:   padding: 0;
                   6956: }
                   6957: 
1.795     www      6958: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6959:   text-decoration:none;
                   6960:   font-size:100%;
                   6961:   font-weight:bold;
1.693     droeschl 6962: }
1.795     www      6963: 
1.840     bisitz   6964: .LC_Box {
1.911     bisitz   6965:   border: solid 1px $lg_border_color;
                   6966:   padding: 0 10px 10px 10px;
1.746     neumanie 6967: }
1.795     www      6968: 
1.1020    raeburn  6969: .LC_DocsBox {
                   6970:   border: solid 1px $lg_border_color;
                   6971:   padding: 0 0 10px 10px;
                   6972: }
                   6973: 
1.795     www      6974: .LC_AboutMe_Image {
1.911     bisitz   6975:   float:left;
                   6976:   margin-right:10px;
1.747     neumanie 6977: }
1.795     www      6978: 
                   6979: .LC_Clear_AboutMe_Image {
1.911     bisitz   6980:   clear:left;
1.747     neumanie 6981: }
1.795     www      6982: 
1.721     harmsja  6983: dl.LC_ListStyleClean dt {
1.911     bisitz   6984:   padding-right: 5px;
                   6985:   display: table-header-group;
1.693     droeschl 6986: }
                   6987: 
1.721     harmsja  6988: dl.LC_ListStyleClean dd {
1.911     bisitz   6989:   display: table-row;
1.693     droeschl 6990: }
                   6991: 
1.721     harmsja  6992: .LC_ListStyleClean,
                   6993: .LC_ListStyleSimple,
                   6994: .LC_ListStyleNormal,
1.795     www      6995: .LC_ListStyleSpecial {
1.911     bisitz   6996:   /* display:block; */
                   6997:   list-style-position: inside;
                   6998:   list-style-type: none;
                   6999:   overflow: hidden;
                   7000:   padding: 0;
1.693     droeschl 7001: }
                   7002: 
1.721     harmsja  7003: .LC_ListStyleSimple li,
                   7004: .LC_ListStyleSimple dd,
                   7005: .LC_ListStyleNormal li,
                   7006: .LC_ListStyleNormal dd,
                   7007: .LC_ListStyleSpecial li,
1.795     www      7008: .LC_ListStyleSpecial dd {
1.911     bisitz   7009:   margin: 0;
                   7010:   padding: 5px 5px 5px 10px;
                   7011:   clear: both;
1.693     droeschl 7012: }
                   7013: 
1.721     harmsja  7014: .LC_ListStyleClean li,
                   7015: .LC_ListStyleClean dd {
1.911     bisitz   7016:   padding-top: 0;
                   7017:   padding-bottom: 0;
1.693     droeschl 7018: }
                   7019: 
1.721     harmsja  7020: .LC_ListStyleSimple dd,
1.795     www      7021: .LC_ListStyleSimple li {
1.911     bisitz   7022:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 7023: }
                   7024: 
1.721     harmsja  7025: .LC_ListStyleSpecial li,
                   7026: .LC_ListStyleSpecial dd {
1.911     bisitz   7027:   list-style-type: none;
                   7028:   background-color: RGB(220, 220, 220);
                   7029:   margin-bottom: 4px;
1.693     droeschl 7030: }
                   7031: 
1.721     harmsja  7032: table.LC_SimpleTable {
1.911     bisitz   7033:   margin:5px;
                   7034:   border:solid 1px $lg_border_color;
1.795     www      7035: }
1.693     droeschl 7036: 
1.721     harmsja  7037: table.LC_SimpleTable tr {
1.911     bisitz   7038:   padding: 0;
                   7039:   border:solid 1px $lg_border_color;
1.693     droeschl 7040: }
1.795     www      7041: 
                   7042: table.LC_SimpleTable thead {
1.911     bisitz   7043:   background:rgb(220,220,220);
1.693     droeschl 7044: }
                   7045: 
1.721     harmsja  7046: div.LC_columnSection {
1.911     bisitz   7047:   display: block;
                   7048:   clear: both;
                   7049:   overflow: hidden;
                   7050:   margin: 0;
1.693     droeschl 7051: }
                   7052: 
1.721     harmsja  7053: div.LC_columnSection>* {
1.911     bisitz   7054:   float: left;
                   7055:   margin: 10px 20px 10px 0;
                   7056:   overflow:hidden;
1.693     droeschl 7057: }
1.721     harmsja  7058: 
1.795     www      7059: table em {
1.911     bisitz   7060:   font-weight: bold;
                   7061:   font-style: normal;
1.748     schulted 7062: }
1.795     www      7063: 
1.779     bisitz   7064: table.LC_tableBrowseRes,
1.795     www      7065: table.LC_tableOfContent {
1.911     bisitz   7066:   border:none;
                   7067:   border-spacing: 1px;
                   7068:   padding: 3px;
                   7069:   background-color: #FFFFFF;
                   7070:   font-size: 90%;
1.753     droeschl 7071: }
1.789     droeschl 7072: 
1.911     bisitz   7073: table.LC_tableOfContent {
                   7074:   border-collapse: collapse;
1.789     droeschl 7075: }
                   7076: 
1.771     droeschl 7077: table.LC_tableBrowseRes a,
1.768     schulted 7078: table.LC_tableOfContent a {
1.911     bisitz   7079:   background-color: transparent;
                   7080:   text-decoration: none;
1.753     droeschl 7081: }
                   7082: 
1.795     www      7083: table.LC_tableOfContent img {
1.911     bisitz   7084:   border: none;
                   7085:   height: 1.3em;
                   7086:   vertical-align: text-bottom;
                   7087:   margin-right: 0.3em;
1.753     droeschl 7088: }
1.757     schulted 7089: 
1.795     www      7090: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7091:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7092: }
                   7093: 
1.795     www      7094: a#LC_content_toolbar_everything {
1.911     bisitz   7095:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7096: }
                   7097: 
1.795     www      7098: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7099:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7100: }
                   7101: 
1.795     www      7102: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7103:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7104: }
                   7105: 
1.795     www      7106: a#LC_content_toolbar_changefolder {
1.911     bisitz   7107:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7108: }
                   7109: 
1.795     www      7110: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7111:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7112: }
                   7113: 
1.1043    raeburn  7114: a#LC_content_toolbar_edittoplevel {
                   7115:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7116: }
                   7117: 
1.795     www      7118: ul#LC_toolbar li a:hover {
1.911     bisitz   7119:   background-position: bottom center;
1.757     schulted 7120: }
                   7121: 
1.795     www      7122: ul#LC_toolbar {
1.911     bisitz   7123:   padding: 0;
                   7124:   margin: 2px;
                   7125:   list-style:none;
                   7126:   position:relative;
                   7127:   background-color:white;
1.1082    raeburn  7128:   overflow: auto;
1.757     schulted 7129: }
                   7130: 
1.795     www      7131: ul#LC_toolbar li {
1.911     bisitz   7132:   border:1px solid white;
                   7133:   padding: 0;
                   7134:   margin: 0;
                   7135:   float: left;
                   7136:   display:inline;
                   7137:   vertical-align:middle;
1.1082    raeburn  7138:   white-space: nowrap;
1.911     bisitz   7139: }
1.757     schulted 7140: 
1.783     amueller 7141: 
1.795     www      7142: a.LC_toolbarItem {
1.911     bisitz   7143:   display:block;
                   7144:   padding: 0;
                   7145:   margin: 0;
                   7146:   height: 32px;
                   7147:   width: 32px;
                   7148:   color:white;
                   7149:   border: none;
                   7150:   background-repeat:no-repeat;
                   7151:   background-color:transparent;
1.757     schulted 7152: }
                   7153: 
1.915     droeschl 7154: ul.LC_funclist {
                   7155:     margin: 0;
                   7156:     padding: 0.5em 1em 0.5em 0;
                   7157: }
                   7158: 
1.933     droeschl 7159: ul.LC_funclist > li:first-child {
                   7160:     font-weight:bold; 
                   7161:     margin-left:0.8em;
                   7162: }
                   7163: 
1.915     droeschl 7164: ul.LC_funclist + ul.LC_funclist {
                   7165:     /* 
                   7166:        left border as a seperator if we have more than
                   7167:        one list 
                   7168:     */
                   7169:     border-left: 1px solid $sidebg;
                   7170:     /* 
                   7171:        this hides the left border behind the border of the 
                   7172:        outer box if element is wrapped to the next 'line' 
                   7173:     */
                   7174:     margin-left: -1px;
                   7175: }
                   7176: 
1.843     bisitz   7177: ul.LC_funclist li {
1.915     droeschl 7178:   display: inline;
1.782     bisitz   7179:   white-space: nowrap;
1.915     droeschl 7180:   margin: 0 0 0 25px;
                   7181:   line-height: 150%;
1.782     bisitz   7182: }
                   7183: 
1.974     wenzelju 7184: .LC_hidden {
                   7185:   display: none;
                   7186: }
                   7187: 
1.1030    www      7188: .LCmodal-overlay {
                   7189: 		position:fixed;
                   7190: 		top:0;
                   7191: 		right:0;
                   7192: 		bottom:0;
                   7193: 		left:0;
                   7194: 		height:100%;
                   7195: 		width:100%;
                   7196: 		margin:0;
                   7197: 		padding:0;
                   7198: 		background:#999;
                   7199: 		opacity:.75;
                   7200: 		filter: alpha(opacity=75);
                   7201: 		-moz-opacity: 0.75;
                   7202: 		z-index:101;
                   7203: }
                   7204: 
                   7205: * html .LCmodal-overlay {   
                   7206: 		position: absolute;
                   7207: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7208: }
                   7209: 
                   7210: .LCmodal-window {
                   7211: 		position:fixed;
                   7212: 		top:50%;
                   7213: 		left:50%;
                   7214: 		margin:0;
                   7215: 		padding:0;
                   7216: 		z-index:102;
                   7217: 	}
                   7218: 
                   7219: * html .LCmodal-window {
                   7220: 		position:absolute;
                   7221: }
                   7222: 
                   7223: .LCclose-window {
                   7224: 		position:absolute;
                   7225: 		width:32px;
                   7226: 		height:32px;
                   7227: 		right:8px;
                   7228: 		top:8px;
                   7229: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7230: 		text-indent:-99999px;
                   7231: 		overflow:hidden;
                   7232: 		cursor:pointer;
                   7233: }
                   7234: 
1.1100    raeburn  7235: /*
                   7236:   styles used by TTH when "Default set of options to pass to tth/m
                   7237:   when converting TeX" in course settings has been set
                   7238: 
                   7239:   option passed: -t
                   7240: 
                   7241: */
                   7242: 
                   7243: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7244: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7245: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7246: td div.norm {line-height:normal;}
                   7247: 
                   7248: /*
                   7249:   option passed -y3
                   7250: */
                   7251: 
                   7252: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7253: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7254: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7255: 
1.343     albertel 7256: END
                   7257: }
                   7258: 
1.306     albertel 7259: =pod
                   7260: 
                   7261: =item * &headtag()
                   7262: 
                   7263: Returns a uniform footer for LON-CAPA web pages.
                   7264: 
1.307     albertel 7265: Inputs: $title - optional title for the head
                   7266:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7267:         $args - optional arguments
1.319     albertel 7268:             force_register - if is true call registerurl so the remote is 
                   7269:                              informed
1.415     albertel 7270:             redirect       -> array ref of
                   7271:                                    1- seconds before redirect occurs
                   7272:                                    2- url to redirect to
                   7273:                                    3- whether the side effect should occur
1.315     albertel 7274:                            (side effect of setting 
                   7275:                                $env{'internal.head.redirect'} to the url 
                   7276:                                redirected too)
1.352     albertel 7277:             domain         -> force to color decorate a page for a specific
                   7278:                                domain
                   7279:             function       -> force usage of a specific rolish color scheme
                   7280:             bgcolor        -> override the default page bgcolor
1.460     albertel 7281:             no_auto_mt_title
                   7282:                            -> prevent &mt()ing the title arg
1.464     albertel 7283: 
1.306     albertel 7284: =cut
                   7285: 
                   7286: sub headtag {
1.313     albertel 7287:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7288:     
1.363     albertel 7289:     my $function = $args->{'function'} || &get_users_function();
                   7290:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7291:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1154    raeburn  7292:     my $httphost = $args->{'use_absolute'};
1.418     albertel 7293:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7294: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7295: 		   #time(),
1.418     albertel 7296: 		   $env{'environment.color.timestamp'},
1.363     albertel 7297: 		   $function,$domain,$bgcolor);
                   7298: 
1.369     www      7299:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7300: 
1.308     albertel 7301:     my $result =
                   7302: 	'<head>'.
1.1160    raeburn  7303: 	&font_settings($args);
1.319     albertel 7304: 
1.1064    raeburn  7305:     my $inhibitprint = &print_suppression();
                   7306: 
1.461     albertel 7307:     if (!$args->{'frameset'}) {
                   7308: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7309:     }
1.962     droeschl 7310:     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
                   7311:         $result .= Apache::lonxml::display_title();
1.319     albertel 7312:     }
1.436     albertel 7313:     if (!$args->{'no_nav_bar'} 
                   7314: 	&& !$args->{'only_body'}
                   7315: 	&& !$args->{'frameset'}) {
1.1154    raeburn  7316: 	$result .= &help_menu_js($httphost);
1.1032    www      7317:         $result.=&modal_window();
1.1038    www      7318:         $result.=&togglebox_script();
1.1034    www      7319:         $result.=&wishlist_window();
1.1041    www      7320:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7321:     } else {
                   7322:         if ($args->{'add_modal'}) {
                   7323:            $result.=&modal_window();
                   7324:         }
                   7325:         if ($args->{'add_wishlist'}) {
                   7326:            $result.=&wishlist_window();
                   7327:         }
1.1038    www      7328:         if ($args->{'add_togglebox'}) {
                   7329:            $result.=&togglebox_script();
                   7330:         }
1.1041    www      7331:         if ($args->{'add_progressbar'}) {
                   7332:            $result.=&LCprogressbarUpdate_script();
                   7333:         }
1.436     albertel 7334:     }
1.314     albertel 7335:     if (ref($args->{'redirect'})) {
1.414     albertel 7336: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7337: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7338: 	if (!$inhibit_continue) {
                   7339: 	    $env{'internal.head.redirect'} = $url;
                   7340: 	}
1.313     albertel 7341: 	$result.=<<ADDMETA
                   7342: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7343: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7344: ADDMETA
                   7345:     }
1.306     albertel 7346:     if (!defined($title)) {
                   7347: 	$title = 'The LearningOnline Network with CAPA';
                   7348:     }
1.460     albertel 7349:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7350:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168    raeburn  7351: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'"';
                   7352:     if (!$args->{'frameset'}) {
                   7353:         $result .= ' /';
                   7354:     }
                   7355:     $result .= '>' 
1.1064    raeburn  7356:         .$inhibitprint
1.414     albertel 7357: 	.$head_extra;
1.1137    raeburn  7358:     if ($env{'browser.mobile'}) {
                   7359:         $result .= '
                   7360: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   7361: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   7362:     }
1.962     droeschl 7363:     return $result.'</head>';
1.306     albertel 7364: }
                   7365: 
                   7366: =pod
                   7367: 
1.340     albertel 7368: =item * &font_settings()
                   7369: 
                   7370: Returns neccessary <meta> to set the proper encoding
                   7371: 
1.1160    raeburn  7372: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340     albertel 7373: 
                   7374: =cut
                   7375: 
                   7376: sub font_settings {
1.1160    raeburn  7377:     my ($args) = @_;
1.340     albertel 7378:     my $headerstring='';
1.1160    raeburn  7379:     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
                   7380:         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168    raeburn  7381:         $headerstring.=
                   7382:             '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
                   7383:         if (!$args->{'frameset'}) {
                   7384: 	    $headerstring.= ' /';
                   7385:         }
                   7386: 	$headerstring .= '>'."\n";
1.340     albertel 7387:     }
                   7388:     return $headerstring;
                   7389: }
                   7390: 
1.341     albertel 7391: =pod
                   7392: 
1.1064    raeburn  7393: =item * &print_suppression()
                   7394: 
                   7395: In course context returns css which causes the body to be blank when media="print",
                   7396: if printout generation is unavailable for the current resource.
                   7397: 
                   7398: This could be because:
                   7399: 
                   7400: (a) printstartdate is in the future
                   7401: 
                   7402: (b) printenddate is in the past
                   7403: 
                   7404: (c) there is an active exam block with "printout"
                   7405: functionality blocked
                   7406: 
                   7407: Users with pav, pfo or evb privileges are exempt.
                   7408: 
                   7409: Inputs: none
                   7410: 
                   7411: =cut
                   7412: 
                   7413: 
                   7414: sub print_suppression {
                   7415:     my $noprint;
                   7416:     if ($env{'request.course.id'}) {
                   7417:         my $scope = $env{'request.course.id'};
                   7418:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7419:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7420:             return;
                   7421:         }
                   7422:         if ($env{'request.course.sec'} ne '') {
                   7423:             $scope .= "/$env{'request.course.sec'}";
                   7424:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7425:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7426:                 return;
1.1064    raeburn  7427:             }
                   7428:         }
                   7429:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7430:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1065    raeburn  7431:         my $blocked = &blocking_status('printout',$cnum,$cdom);
1.1064    raeburn  7432:         if ($blocked) {
                   7433:             my $checkrole = "cm./$cdom/$cnum";
                   7434:             if ($env{'request.course.sec'} ne '') {
                   7435:                 $checkrole .= "/$env{'request.course.sec'}";
                   7436:             }
                   7437:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7438:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7439:                 $noprint = 1;
                   7440:             }
                   7441:         }
                   7442:         unless ($noprint) {
                   7443:             my $symb = &Apache::lonnet::symbread();
                   7444:             if ($symb ne '') {
                   7445:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7446:                 if (ref($navmap)) {
                   7447:                     my $res = $navmap->getBySymb($symb);
                   7448:                     if (ref($res)) {
                   7449:                         if (!$res->resprintable()) {
                   7450:                             $noprint = 1;
                   7451:                         }
                   7452:                     }
                   7453:                 }
                   7454:             }
                   7455:         }
                   7456:         if ($noprint) {
                   7457:             return <<"ENDSTYLE";
                   7458: <style type="text/css" media="print">
                   7459:     body { display:none }
                   7460: </style>
                   7461: ENDSTYLE
                   7462:         }
                   7463:     }
                   7464:     return;
                   7465: }
                   7466: 
                   7467: =pod
                   7468: 
1.341     albertel 7469: =item * &xml_begin()
                   7470: 
                   7471: Returns the needed doctype and <html>
                   7472: 
                   7473: Inputs: none
                   7474: 
                   7475: =cut
                   7476: 
                   7477: sub xml_begin {
1.1168    raeburn  7478:     my ($is_frameset) = @_;
1.341     albertel 7479:     my $output='';
                   7480: 
                   7481:     if ($env{'browser.mathml'}) {
                   7482: 	$output='<?xml version="1.0"?>'
                   7483:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7484: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7485:             
                   7486: #	    .'<!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">] >'
                   7487: 	    .'<!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">'
                   7488:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7489: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168    raeburn  7490:     } elsif ($is_frameset) {
                   7491:         $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   7492:                 '<html>'."\n";
1.341     albertel 7493:     } else {
1.1168    raeburn  7494: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
                   7495:                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341     albertel 7496:     }
                   7497:     return $output;
                   7498: }
1.340     albertel 7499: 
                   7500: =pod
                   7501: 
1.306     albertel 7502: =item * &start_page()
                   7503: 
                   7504: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7505: 
1.648     raeburn  7506: Inputs:
                   7507: 
                   7508: =over 4
                   7509: 
                   7510: $title - optional title for the page
                   7511: 
                   7512: $head_extra - optional extra HTML to incude inside the <head>
                   7513: 
                   7514: $args - additional optional args supported are:
                   7515: 
                   7516: =over 8
                   7517: 
                   7518:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 7519:                                     arg on
1.814     bisitz   7520:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  7521:              add_entries    -> additional attributes to add to the  <body>
                   7522:              domain         -> force to color decorate a page for a 
1.317     albertel 7523:                                     specific domain
1.648     raeburn  7524:              function       -> force usage of a specific rolish color
1.317     albertel 7525:                                     scheme
1.648     raeburn  7526:              redirect       -> see &headtag()
                   7527:              bgcolor        -> override the default page bg color
                   7528:              js_ready       -> return a string ready for being used in 
1.317     albertel 7529:                                     a javascript writeln
1.648     raeburn  7530:              html_encode    -> return a string ready for being used in 
1.320     albertel 7531:                                     a html attribute
1.648     raeburn  7532:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 7533:                                     $forcereg arg
1.648     raeburn  7534:              frameset       -> if true will start with a <frameset>
1.330     albertel 7535:                                     rather than <body>
1.648     raeburn  7536:              skip_phases    -> hash ref of 
1.338     albertel 7537:                                     head -> skip the <html><head> generation
                   7538:                                     body -> skip all <body> generation
1.648     raeburn  7539:              no_auto_mt_title -> prevent &mt()ing the title arg
                   7540:              inherit_jsmath -> when creating popup window in a page,
                   7541:                                     should it have jsmath forced on by the
                   7542:                                     current page
1.867     kalberla 7543:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  7544:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1096    raeburn  7545:              group          -> includes the current group, if page is for a 
                   7546:                                specific group  
1.361     albertel 7547: 
1.648     raeburn  7548: =back
1.460     albertel 7549: 
1.648     raeburn  7550: =back
1.562     albertel 7551: 
1.306     albertel 7552: =cut
                   7553: 
                   7554: sub start_page {
1.309     albertel 7555:     my ($title,$head_extra,$args) = @_;
1.318     albertel 7556:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 7557: 
1.315     albertel 7558:     $env{'internal.start_page'}++;
1.1096    raeburn  7559:     my ($result,@advtools);
1.964     droeschl 7560: 
1.338     albertel 7561:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168    raeburn  7562:         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338     albertel 7563:     }
                   7564:     
                   7565:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   7566: 	if ($args->{'frameset'}) {
                   7567: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   7568: 						$args->{'add_entries'});
                   7569: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   7570:         } else {
                   7571:             $result .=
                   7572:                 &bodytag($title, 
                   7573:                          $args->{'function'},       $args->{'add_entries'},
                   7574:                          $args->{'only_body'},      $args->{'domain'},
                   7575:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096    raeburn  7576:                          $args->{'bgcolor'},        $args,
                   7577:                          \@advtools);
1.831     bisitz   7578:         }
1.330     albertel 7579:     }
1.338     albertel 7580: 
1.315     albertel 7581:     if ($args->{'js_ready'}) {
1.713     kaisler  7582: 		$result = &js_ready($result);
1.315     albertel 7583:     }
1.320     albertel 7584:     if ($args->{'html_encode'}) {
1.713     kaisler  7585: 		$result = &html_encode($result);
                   7586:     }
                   7587: 
1.813     bisitz   7588:     # Preparation for new and consistent functionlist at top of screen
                   7589:     # if ($args->{'functionlist'}) {
                   7590:     #            $result .= &build_functionlist();
                   7591:     #}
                   7592: 
1.964     droeschl 7593:     # Don't add anything more if only_body wanted or in const space
                   7594:     return $result if    $args->{'only_body'} 
                   7595:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   7596: 
                   7597:     #Breadcrumbs
1.758     kaisler  7598:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   7599: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   7600: 		#if any br links exists, add them to the breadcrumbs
                   7601: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   7602: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   7603: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   7604: 			}
                   7605: 		}
1.1096    raeburn  7606:                 # if @advtools array contains items add then to the breadcrumbs
                   7607:                 if (@advtools > 0) {
                   7608:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   7609:                 }
1.758     kaisler  7610: 
                   7611: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   7612: 		if(exists($args->{'bread_crumbs_component'})){
                   7613: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   7614: 		}else{
                   7615: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   7616: 		}
1.320     albertel 7617:     }
1.315     albertel 7618:     return $result;
1.306     albertel 7619: }
                   7620: 
                   7621: sub end_page {
1.315     albertel 7622:     my ($args) = @_;
                   7623:     $env{'internal.end_page'}++;
1.330     albertel 7624:     my $result;
1.335     albertel 7625:     if ($args->{'discussion'}) {
                   7626: 	my ($target,$parser);
                   7627: 	if (ref($args->{'discussion'})) {
                   7628: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   7629: 				$args->{'discussion'}{'parser'});
                   7630: 	}
                   7631: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   7632:     }
1.330     albertel 7633:     if ($args->{'frameset'}) {
                   7634: 	$result .= '</frameset>';
                   7635:     } else {
1.635     raeburn  7636: 	$result .= &endbodytag($args);
1.330     albertel 7637:     }
1.1080    raeburn  7638:     unless ($args->{'notbody'}) {
                   7639:         $result .= "\n</html>";
                   7640:     }
1.330     albertel 7641: 
1.315     albertel 7642:     if ($args->{'js_ready'}) {
1.317     albertel 7643: 	$result = &js_ready($result);
1.315     albertel 7644:     }
1.335     albertel 7645: 
1.320     albertel 7646:     if ($args->{'html_encode'}) {
                   7647: 	$result = &html_encode($result);
                   7648:     }
1.335     albertel 7649: 
1.315     albertel 7650:     return $result;
                   7651: }
                   7652: 
1.1034    www      7653: sub wishlist_window {
                   7654:     return(<<'ENDWISHLIST');
1.1046    raeburn  7655: <script type="text/javascript">
1.1034    www      7656: // <![CDATA[
                   7657: // <!-- BEGIN LON-CAPA Internal
                   7658: function set_wishlistlink(title, path) {
                   7659:     if (!title) {
                   7660:         title = document.title;
                   7661:         title = title.replace(/^LON-CAPA /,'');
                   7662:     }
1.1175    raeburn  7663:     title = encodeURIComponent(title);
1.1034    www      7664:     if (!path) {
                   7665:         path = location.pathname;
                   7666:     }
1.1175    raeburn  7667:     path = encodeURIComponent(path);
1.1034    www      7668:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   7669:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   7670: }
                   7671: // END LON-CAPA Internal -->
                   7672: // ]]>
                   7673: </script>
                   7674: ENDWISHLIST
                   7675: }
                   7676: 
1.1030    www      7677: sub modal_window {
                   7678:     return(<<'ENDMODAL');
1.1046    raeburn  7679: <script type="text/javascript">
1.1030    www      7680: // <![CDATA[
                   7681: // <!-- BEGIN LON-CAPA Internal
                   7682: var modalWindow = {
                   7683: 	parent:"body",
                   7684: 	windowId:null,
                   7685: 	content:null,
                   7686: 	width:null,
                   7687: 	height:null,
                   7688: 	close:function()
                   7689: 	{
                   7690: 	        $(".LCmodal-window").remove();
                   7691: 	        $(".LCmodal-overlay").remove();
                   7692: 	},
                   7693: 	open:function()
                   7694: 	{
                   7695: 		var modal = "";
                   7696: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7697: 		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;\">";
                   7698: 		modal += this.content;
                   7699: 		modal += "</div>";	
                   7700: 
                   7701: 		$(this.parent).append(modal);
                   7702: 
                   7703: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7704: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7705: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7706: 	}
                   7707: };
1.1140    raeburn  7708: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      7709: 	{
                   7710: 		modalWindow.windowId = "myModal";
                   7711: 		modalWindow.width = width;
                   7712: 		modalWindow.height = height;
1.1140    raeburn  7713: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'>&lt/iframe>";
1.1030    www      7714: 		modalWindow.open();
                   7715: 	};	
                   7716: // END LON-CAPA Internal -->
                   7717: // ]]>
                   7718: </script>
                   7719: ENDMODAL
                   7720: }
                   7721: 
                   7722: sub modal_link {
1.1140    raeburn  7723:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      7724:     unless ($width) { $width=480; }
                   7725:     unless ($height) { $height=400; }
1.1031    www      7726:     unless ($scrolling) { $scrolling='yes'; }
1.1140    raeburn  7727:     unless ($transparency) { $transparency='true'; }
                   7728: 
1.1074    raeburn  7729:     my $target_attr;
                   7730:     if (defined($target)) {
                   7731:         $target_attr = 'target="'.$target.'"';
                   7732:     }
                   7733:     return <<"ENDLINK";
1.1140    raeburn  7734: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074    raeburn  7735:            $linktext</a>
                   7736: ENDLINK
1.1030    www      7737: }
                   7738: 
1.1032    www      7739: sub modal_adhoc_script {
                   7740:     my ($funcname,$width,$height,$content)=@_;
                   7741:     return (<<ENDADHOC);
1.1046    raeburn  7742: <script type="text/javascript">
1.1032    www      7743: // <![CDATA[
                   7744:         var $funcname = function()
                   7745:         {
                   7746:                 modalWindow.windowId = "myModal";
                   7747:                 modalWindow.width = $width;
                   7748:                 modalWindow.height = $height;
                   7749:                 modalWindow.content = '$content';
                   7750:                 modalWindow.open();
                   7751:         };  
                   7752: // ]]>
                   7753: </script>
                   7754: ENDADHOC
                   7755: }
                   7756: 
1.1041    www      7757: sub modal_adhoc_inner {
                   7758:     my ($funcname,$width,$height,$content)=@_;
                   7759:     my $innerwidth=$width-20;
                   7760:     $content=&js_ready(
1.1140    raeburn  7761:                  &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
                   7762:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   7763:                  $content.
1.1041    www      7764:                  &end_scrollbox().
1.1140    raeburn  7765:                  &end_page()
1.1041    www      7766:              );
                   7767:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   7768: }
                   7769: 
                   7770: sub modal_adhoc_window {
                   7771:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7772:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   7773:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7774: }
                   7775: 
                   7776: sub modal_adhoc_launch {
                   7777:     my ($funcname,$width,$height,$content)=@_;
                   7778:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   7779: <script type="text/javascript">
                   7780: // <![CDATA[
                   7781: $funcname();
                   7782: // ]]>
                   7783: </script>
                   7784: ENDLAUNCH
                   7785: }
                   7786: 
                   7787: sub modal_adhoc_close {
                   7788:     return (<<ENDCLOSE);
                   7789: <script type="text/javascript">
                   7790: // <![CDATA[
                   7791: modalWindow.close();
                   7792: // ]]>
                   7793: </script>
                   7794: ENDCLOSE
                   7795: }
                   7796: 
1.1038    www      7797: sub togglebox_script {
                   7798:    return(<<ENDTOGGLE);
                   7799: <script type="text/javascript"> 
                   7800: // <![CDATA[
                   7801: function LCtoggleDisplay(id,hidetext,showtext) {
                   7802:    link = document.getElementById(id + "link").childNodes[0];
                   7803:    with (document.getElementById(id).style) {
                   7804:       if (display == "none" ) {
                   7805:           display = "inline";
                   7806:           link.nodeValue = hidetext;
                   7807:         } else {
                   7808:           display = "none";
                   7809:           link.nodeValue = showtext;
                   7810:        }
                   7811:    }
                   7812: }
                   7813: // ]]>
                   7814: </script>
                   7815: ENDTOGGLE
                   7816: }
                   7817: 
1.1039    www      7818: sub start_togglebox {
                   7819:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7820:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7821:     unless ($showtext) { $showtext=&mt('show'); }
                   7822:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7823:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7824:     return &start_data_table().
                   7825:            &start_data_table_header_row().
                   7826:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7827:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7828:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7829:            &end_data_table_header_row().
                   7830:            '<tr id="'.$id.'" style="display:none""><td>';
                   7831: }
                   7832: 
                   7833: sub end_togglebox {
                   7834:     return '</td></tr>'.&end_data_table();
                   7835: }
                   7836: 
1.1041    www      7837: sub LCprogressbar_script {
1.1045    www      7838:    my ($id)=@_;
1.1041    www      7839:    return(<<ENDPROGRESS);
                   7840: <script type="text/javascript">
                   7841: // <![CDATA[
1.1045    www      7842: \$('#progressbar$id').progressbar({
1.1041    www      7843:   value: 0,
                   7844:   change: function(event, ui) {
                   7845:     var newVal = \$(this).progressbar('option', 'value');
                   7846:     \$('.pblabel', this).text(LCprogressTxt);
                   7847:   }
                   7848: });
                   7849: // ]]>
                   7850: </script>
                   7851: ENDPROGRESS
                   7852: }
                   7853: 
                   7854: sub LCprogressbarUpdate_script {
                   7855:    return(<<ENDPROGRESSUPDATE);
                   7856: <style type="text/css">
                   7857: .ui-progressbar { position:relative; }
                   7858: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   7859: </style>
                   7860: <script type="text/javascript">
                   7861: // <![CDATA[
1.1045    www      7862: var LCprogressTxt='---';
                   7863: 
                   7864: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      7865:    LCprogressTxt=progresstext;
1.1045    www      7866:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      7867: }
                   7868: // ]]>
                   7869: </script>
                   7870: ENDPROGRESSUPDATE
                   7871: }
                   7872: 
1.1042    www      7873: my $LClastpercent;
1.1045    www      7874: my $LCidcnt;
                   7875: my $LCcurrentid;
1.1042    www      7876: 
1.1041    www      7877: sub LCprogressbar {
1.1042    www      7878:     my ($r)=(@_);
                   7879:     $LClastpercent=0;
1.1045    www      7880:     $LCidcnt++;
                   7881:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      7882:     my $starting=&mt('Starting');
                   7883:     my $content=(<<ENDPROGBAR);
1.1045    www      7884:   <div id="progressbar$LCcurrentid">
1.1041    www      7885:     <span class="pblabel">$starting</span>
                   7886:   </div>
                   7887: ENDPROGBAR
1.1045    www      7888:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      7889: }
                   7890: 
                   7891: sub LCprogressbarUpdate {
1.1042    www      7892:     my ($r,$val,$text)=@_;
                   7893:     unless ($val) { 
                   7894:        if ($LClastpercent) {
                   7895:            $val=$LClastpercent;
                   7896:        } else {
                   7897:            $val=0;
                   7898:        }
                   7899:     }
1.1041    www      7900:     if ($val<0) { $val=0; }
                   7901:     if ($val>100) { $val=0; }
1.1042    www      7902:     $LClastpercent=$val;
1.1041    www      7903:     unless ($text) { $text=$val.'%'; }
                   7904:     $text=&js_ready($text);
1.1044    www      7905:     &r_print($r,<<ENDUPDATE);
1.1041    www      7906: <script type="text/javascript">
                   7907: // <![CDATA[
1.1045    www      7908: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      7909: // ]]>
                   7910: </script>
                   7911: ENDUPDATE
1.1035    www      7912: }
                   7913: 
1.1042    www      7914: sub LCprogressbarClose {
                   7915:     my ($r)=@_;
                   7916:     $LClastpercent=0;
1.1044    www      7917:     &r_print($r,<<ENDCLOSE);
1.1042    www      7918: <script type="text/javascript">
                   7919: // <![CDATA[
1.1045    www      7920: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      7921: // ]]>
                   7922: </script>
                   7923: ENDCLOSE
1.1044    www      7924: }
                   7925: 
                   7926: sub r_print {
                   7927:     my ($r,$to_print)=@_;
                   7928:     if ($r) {
                   7929:       $r->print($to_print);
                   7930:       $r->rflush();
                   7931:     } else {
                   7932:       print($to_print);
                   7933:     }
1.1042    www      7934: }
                   7935: 
1.320     albertel 7936: sub html_encode {
                   7937:     my ($result) = @_;
                   7938: 
1.322     albertel 7939:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7940:     
                   7941:     return $result;
                   7942: }
1.1044    www      7943: 
1.317     albertel 7944: sub js_ready {
                   7945:     my ($result) = @_;
                   7946: 
1.323     albertel 7947:     $result =~ s/[\n\r]/ /xmsg;
                   7948:     $result =~ s/\\/\\\\/xmsg;
                   7949:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7950:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7951:     
                   7952:     return $result;
                   7953: }
                   7954: 
1.315     albertel 7955: sub validate_page {
                   7956:     if (  exists($env{'internal.start_page'})
1.316     albertel 7957: 	  &&     $env{'internal.start_page'} > 1) {
                   7958: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7959: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7960: 				 $ENV{'request.filename'});
1.315     albertel 7961:     }
                   7962:     if (  exists($env{'internal.end_page'})
1.316     albertel 7963: 	  &&     $env{'internal.end_page'} > 1) {
                   7964: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7965: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7966: 				 $env{'request.filename'});
1.315     albertel 7967:     }
                   7968:     if (     exists($env{'internal.start_page'})
                   7969: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7970: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7971: 				 $env{'request.filename'});
1.315     albertel 7972:     }
                   7973:     if (   ! exists($env{'internal.start_page'})
                   7974: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7975: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7976: 				 $env{'request.filename'});
1.315     albertel 7977:     }
1.306     albertel 7978: }
1.315     albertel 7979: 
1.996     www      7980: 
                   7981: sub start_scrollbox {
1.1140    raeburn  7982:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  7983:     unless ($outerwidth) { $outerwidth='520px'; }
                   7984:     unless ($width) { $width='500px'; }
                   7985:     unless ($height) { $height='200px'; }
1.1075    raeburn  7986:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  7987:     if ($id ne '') {
1.1140    raeburn  7988:         $table_id = ' id="table_'.$id.'"';
1.1137    raeburn  7989:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  7990:     }
1.1075    raeburn  7991:     if ($bgcolor ne '') {
                   7992:         $tdcol = "background-color: $bgcolor;";
                   7993:     }
1.1137    raeburn  7994:     my $nicescroll_js;
                   7995:     if ($env{'browser.mobile'}) {
1.1140    raeburn  7996:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   7997:     }
                   7998:     return <<"END";
                   7999: $nicescroll_js
                   8000: 
                   8001: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
                   8002: <div style="overflow:auto; width:$width; height:$height;"$div_id>
                   8003: END
                   8004: }
                   8005: 
                   8006: sub end_scrollbox {
                   8007:     return '</div></td></tr></table>';
                   8008: }
                   8009: 
                   8010: sub nicescroll_javascript {
                   8011:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   8012:     my %options;
                   8013:     if (ref($cursor) eq 'HASH') {
                   8014:         %options = %{$cursor};
                   8015:     }
                   8016:     unless ($options{'railalign'} =~ /^left|right$/) {
                   8017:         $options{'railalign'} = 'left';
                   8018:     }
                   8019:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8020:         my $function  = &get_users_function();
                   8021:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138    raeburn  8022:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140    raeburn  8023:             $options{'cursorcolor'} = '#00F';
1.1138    raeburn  8024:         }
1.1140    raeburn  8025:     }
                   8026:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   8027:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138    raeburn  8028:             $options{'cursoropacity'}='1.0';
                   8029:         }
1.1140    raeburn  8030:     } else {
                   8031:         $options{'cursoropacity'}='1.0';
                   8032:     }
                   8033:     if ($options{'cursorfixedheight'} eq 'none') {
                   8034:         delete($options{'cursorfixedheight'});
                   8035:     } else {
                   8036:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   8037:     }
                   8038:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   8039:         delete($options{'railoffset'});
                   8040:     }
                   8041:     my @niceoptions;
                   8042:     while (my($key,$value) = each(%options)) {
                   8043:         if ($value =~ /^\{.+\}$/) {
                   8044:             push(@niceoptions,$key.':'.$value);
1.1138    raeburn  8045:         } else {
1.1140    raeburn  8046:             push(@niceoptions,$key.':"'.$value.'"');
1.1138    raeburn  8047:         }
1.1140    raeburn  8048:     }
                   8049:     my $nicescroll_js = '
1.1137    raeburn  8050: $(document).ready(
1.1140    raeburn  8051:       function() {
                   8052:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   8053:       }
1.1137    raeburn  8054: );
                   8055: ';
1.1140    raeburn  8056:     if ($framecheck) {
                   8057:         $nicescroll_js .= '
                   8058: function expand_div(caller) {
                   8059:     if (top === self) {
                   8060:         document.getElementById("'.$id.'").style.width = "auto";
                   8061:         document.getElementById("'.$id.'").style.height = "auto";
                   8062:     } else {
                   8063:         try {
                   8064:             if (parent.frames) {
                   8065:                 if (parent.frames.length > 1) {
                   8066:                     var framesrc = parent.frames[1].location.href;
                   8067:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   8068:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   8069:                         document.getElementById("'.$id.'").style.width = "auto";
                   8070:                         document.getElementById("'.$id.'").style.height = "auto";
                   8071:                     }
                   8072:                 }
                   8073:             }
                   8074:         } catch (e) {
                   8075:             return;
                   8076:         }
1.1137    raeburn  8077:     }
1.1140    raeburn  8078:     return;
1.996     www      8079: }
1.1140    raeburn  8080: ';
                   8081:     }
                   8082:     if ($needjsready) {
                   8083:         $nicescroll_js = '
                   8084: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   8085:     } else {
                   8086:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   8087:     }
                   8088:     return $nicescroll_js;
1.996     www      8089: }
                   8090: 
1.318     albertel 8091: sub simple_error_page {
1.1150    bisitz   8092:     my ($r,$title,$msg,$args) = @_;
1.1151    raeburn  8093:     if (ref($args) eq 'HASH') {
                   8094:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
                   8095:     } else {
                   8096:         $msg = &mt($msg);
                   8097:     }
1.1150    bisitz   8098: 
1.318     albertel 8099:     my $page =
                   8100: 	&Apache::loncommon::start_page($title).
1.1150    bisitz   8101: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 8102: 	&Apache::loncommon::end_page();
                   8103:     if (ref($r)) {
                   8104: 	$r->print($page);
1.327     albertel 8105: 	return;
1.318     albertel 8106:     }
                   8107:     return $page;
                   8108: }
1.347     albertel 8109: 
                   8110: {
1.610     albertel 8111:     my @row_count;
1.961     onken    8112: 
                   8113:     sub start_data_table_count {
                   8114:         unshift(@row_count, 0);
                   8115:         return;
                   8116:     }
                   8117: 
                   8118:     sub end_data_table_count {
                   8119:         shift(@row_count);
                   8120:         return;
                   8121:     }
                   8122: 
1.347     albertel 8123:     sub start_data_table {
1.1018    raeburn  8124: 	my ($add_class,$id) = @_;
1.422     albertel 8125: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  8126:         my $table_id;
                   8127:         if (defined($id)) {
                   8128:             $table_id = ' id="'.$id.'"';
                   8129:         }
1.961     onken    8130: 	&start_data_table_count();
1.1018    raeburn  8131: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 8132:     }
                   8133: 
                   8134:     sub end_data_table {
1.961     onken    8135: 	&end_data_table_count();
1.389     albertel 8136: 	return '</table>'."\n";;
1.347     albertel 8137:     }
                   8138: 
                   8139:     sub start_data_table_row {
1.974     wenzelju 8140: 	my ($add_class, $id) = @_;
1.610     albertel 8141: 	$row_count[0]++;
                   8142: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   8143: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 8144:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8145:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 8146:     }
1.471     banghart 8147:     
                   8148:     sub continue_data_table_row {
1.974     wenzelju 8149: 	my ($add_class, $id) = @_;
1.610     albertel 8150: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 8151: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   8152:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8153:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 8154:     }
1.347     albertel 8155: 
                   8156:     sub end_data_table_row {
1.389     albertel 8157: 	return '</tr>'."\n";;
1.347     albertel 8158:     }
1.367     www      8159: 
1.421     albertel 8160:     sub start_data_table_empty_row {
1.707     bisitz   8161: #	$row_count[0]++;
1.421     albertel 8162: 	return  '<tr class="LC_empty_row" >'."\n";;
                   8163:     }
                   8164: 
                   8165:     sub end_data_table_empty_row {
                   8166: 	return '</tr>'."\n";;
                   8167:     }
                   8168: 
1.367     www      8169:     sub start_data_table_header_row {
1.389     albertel 8170: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      8171:     }
                   8172: 
                   8173:     sub end_data_table_header_row {
1.389     albertel 8174: 	return '</tr>'."\n";;
1.367     www      8175:     }
1.890     droeschl 8176: 
                   8177:     sub data_table_caption {
                   8178:         my $caption = shift;
                   8179:         return "<caption class=\"LC_caption\">$caption</caption>";
                   8180:     }
1.347     albertel 8181: }
                   8182: 
1.548     albertel 8183: =pod
                   8184: 
                   8185: =item * &inhibit_menu_check($arg)
                   8186: 
                   8187: Checks for a inhibitmenu state and generates output to preserve it
                   8188: 
                   8189: Inputs:         $arg - can be any of
                   8190:                      - undef - in which case the return value is a string 
                   8191:                                to add  into arguments list of a uri
                   8192:                      - 'input' - in which case the return value is a HTML
                   8193:                                  <form> <input> field of type hidden to
                   8194:                                  preserve the value
                   8195:                      - a url - in which case the return value is the url with
                   8196:                                the neccesary cgi args added to preserve the
                   8197:                                inhibitmenu state
                   8198:                      - a ref to a url - no return value, but the string is
                   8199:                                         updated to include the neccessary cgi
                   8200:                                         args to preserve the inhibitmenu state
                   8201: 
                   8202: =cut
                   8203: 
                   8204: sub inhibit_menu_check {
                   8205:     my ($arg) = @_;
                   8206:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   8207:     if ($arg eq 'input') {
                   8208: 	if ($env{'form.inhibitmenu'}) {
                   8209: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   8210: 	} else {
                   8211: 	    return
                   8212: 	}
                   8213:     }
                   8214:     if ($env{'form.inhibitmenu'}) {
                   8215: 	if (ref($arg)) {
                   8216: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8217: 	} elsif ($arg eq '') {
                   8218: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8219: 	} else {
                   8220: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8221: 	}
                   8222:     }
                   8223:     if (!ref($arg)) {
                   8224: 	return $arg;
                   8225:     }
                   8226: }
                   8227: 
1.251     albertel 8228: ###############################################
1.182     matthew  8229: 
                   8230: =pod
                   8231: 
1.549     albertel 8232: =back
                   8233: 
                   8234: =head1 User Information Routines
                   8235: 
                   8236: =over 4
                   8237: 
1.405     albertel 8238: =item * &get_users_function()
1.182     matthew  8239: 
                   8240: Used by &bodytag to determine the current users primary role.
                   8241: Returns either 'student','coordinator','admin', or 'author'.
                   8242: 
                   8243: =cut
                   8244: 
                   8245: ###############################################
                   8246: sub get_users_function {
1.815     tempelho 8247:     my $function = 'norole';
1.818     tempelho 8248:     if ($env{'request.role'}=~/^(st)/) {
                   8249:         $function='student';
                   8250:     }
1.907     raeburn  8251:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8252:         $function='coordinator';
                   8253:     }
1.258     albertel 8254:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8255:         $function='admin';
                   8256:     }
1.826     bisitz   8257:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8258:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8259:         $function='author';
                   8260:     }
                   8261:     return $function;
1.54      www      8262: }
1.99      www      8263: 
                   8264: ###############################################
                   8265: 
1.233     raeburn  8266: =pod
                   8267: 
1.821     raeburn  8268: =item * &show_course()
                   8269: 
                   8270: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8271: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8272: 
                   8273: Inputs:
                   8274: None
                   8275: 
                   8276: Outputs:
                   8277: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8278: 
                   8279: =cut
                   8280: 
                   8281: ###############################################
                   8282: sub show_course {
                   8283:     my $course = !$env{'user.adv'};
                   8284:     if (!$env{'user.adv'}) {
                   8285:         foreach my $env (keys(%env)) {
                   8286:             next if ($env !~ m/^user\.priv\./);
                   8287:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8288:                 $course = 0;
                   8289:                 last;
                   8290:             }
                   8291:         }
                   8292:     }
                   8293:     return $course;
                   8294: }
                   8295: 
                   8296: ###############################################
                   8297: 
                   8298: =pod
                   8299: 
1.542     raeburn  8300: =item * &check_user_status()
1.274     raeburn  8301: 
                   8302: Determines current status of supplied role for a
                   8303: specific user. Roles can be active, previous or future.
                   8304: 
                   8305: Inputs: 
                   8306: user's domain, user's username, course's domain,
1.375     raeburn  8307: course's number, optional section ID.
1.274     raeburn  8308: 
                   8309: Outputs:
                   8310: role status: active, previous or future. 
                   8311: 
                   8312: =cut
                   8313: 
                   8314: sub check_user_status {
1.412     raeburn  8315:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8316:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274     raeburn  8317:     my @uroles = keys %userinfo;
                   8318:     my $srchstr;
                   8319:     my $active_chk = 'none';
1.412     raeburn  8320:     my $now = time;
1.274     raeburn  8321:     if (@uroles > 0) {
1.908     raeburn  8322:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8323:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8324:         } else {
1.412     raeburn  8325:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8326:         }
                   8327:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8328:             my $role_end = 0;
                   8329:             my $role_start = 0;
                   8330:             $active_chk = 'active';
1.412     raeburn  8331:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8332:                 $role_end = $1;
                   8333:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8334:                     $role_start = $1;
1.274     raeburn  8335:                 }
                   8336:             }
                   8337:             if ($role_start > 0) {
1.412     raeburn  8338:                 if ($now < $role_start) {
1.274     raeburn  8339:                     $active_chk = 'future';
                   8340:                 }
                   8341:             }
                   8342:             if ($role_end > 0) {
1.412     raeburn  8343:                 if ($now > $role_end) {
1.274     raeburn  8344:                     $active_chk = 'previous';
                   8345:                 }
                   8346:             }
                   8347:         }
                   8348:     }
                   8349:     return $active_chk;
                   8350: }
                   8351: 
                   8352: ###############################################
                   8353: 
                   8354: =pod
                   8355: 
1.405     albertel 8356: =item * &get_sections()
1.233     raeburn  8357: 
                   8358: Determines all the sections for a course including
                   8359: sections with students and sections containing other roles.
1.419     raeburn  8360: Incoming parameters: 
                   8361: 
                   8362: 1. domain
                   8363: 2. course number 
                   8364: 3. reference to array containing roles for which sections should 
                   8365: be gathered (optional).
                   8366: 4. reference to array containing status types for which sections 
                   8367: should be gathered (optional).
                   8368: 
                   8369: If the third argument is undefined, sections are gathered for any role. 
                   8370: If the fourth argument is undefined, sections are gathered for any status.
                   8371: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  8372:  
1.374     raeburn  8373: Returns section hash (keys are section IDs, values are
                   8374: number of users in each section), subject to the
1.419     raeburn  8375: optional roles filter, optional status filter 
1.233     raeburn  8376: 
                   8377: =cut
                   8378: 
                   8379: ###############################################
                   8380: sub get_sections {
1.419     raeburn  8381:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 8382:     if (!defined($cdom) || !defined($cnum)) {
                   8383:         my $cid =  $env{'request.course.id'};
                   8384: 
                   8385: 	return if (!defined($cid));
                   8386: 
                   8387:         $cdom = $env{'course.'.$cid.'.domain'};
                   8388:         $cnum = $env{'course.'.$cid.'.num'};
                   8389:     }
                   8390: 
                   8391:     my %sectioncount;
1.419     raeburn  8392:     my $now = time;
1.240     albertel 8393: 
1.1118    raeburn  8394:     my $check_students = 1;
                   8395:     my $only_students = 0;
                   8396:     if (ref($possible_roles) eq 'ARRAY') {
                   8397:         if (grep(/^st$/,@{$possible_roles})) {
                   8398:             if (@{$possible_roles} == 1) {
                   8399:                 $only_students = 1;
                   8400:             }
                   8401:         } else {
                   8402:             $check_students = 0;
                   8403:         }
                   8404:     }
                   8405: 
                   8406:     if ($check_students) { 
1.276     albertel 8407: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 8408: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   8409: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  8410:         my $start_index = &Apache::loncoursedata::CL_START();
                   8411:         my $end_index = &Apache::loncoursedata::CL_END();
                   8412:         my $status;
1.366     albertel 8413: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  8414: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   8415: 				                     $data->[$status_index],
                   8416:                                                      $data->[$start_index],
                   8417:                                                      $data->[$end_index]);
                   8418:             if ($stu_status eq 'Active') {
                   8419:                 $status = 'active';
                   8420:             } elsif ($end < $now) {
                   8421:                 $status = 'previous';
                   8422:             } elsif ($start > $now) {
                   8423:                 $status = 'future';
                   8424:             } 
                   8425: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   8426:                 if ((!defined($possible_status)) || (($status ne '') && 
                   8427:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   8428: 		    $sectioncount{$section}++;
                   8429:                 }
1.240     albertel 8430: 	    }
                   8431: 	}
                   8432:     }
1.1118    raeburn  8433:     if ($only_students) {
                   8434:         return %sectioncount;
                   8435:     }
1.240     albertel 8436:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8437:     foreach my $user (sort(keys(%courseroles))) {
                   8438: 	if ($user !~ /^(\w{2})/) { next; }
                   8439: 	my ($role) = ($user =~ /^(\w{2})/);
                   8440: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  8441: 	my ($section,$status);
1.240     albertel 8442: 	if ($role eq 'cr' &&
                   8443: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   8444: 	    $section=$1;
                   8445: 	}
                   8446: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   8447: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  8448:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   8449:         if ($end == -1 && $start == -1) {
                   8450:             next; #deleted role
                   8451:         }
                   8452:         if (!defined($possible_status)) { 
                   8453:             $sectioncount{$section}++;
                   8454:         } else {
                   8455:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   8456:                 $status = 'active';
                   8457:             } elsif ($end < $now) {
                   8458:                 $status = 'future';
                   8459:             } elsif ($start > $now) {
                   8460:                 $status = 'previous';
                   8461:             }
                   8462:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   8463:                 $sectioncount{$section}++;
                   8464:             }
                   8465:         }
1.233     raeburn  8466:     }
1.366     albertel 8467:     return %sectioncount;
1.233     raeburn  8468: }
                   8469: 
1.274     raeburn  8470: ###############################################
1.294     raeburn  8471: 
                   8472: =pod
1.405     albertel 8473: 
                   8474: =item * &get_course_users()
                   8475: 
1.275     raeburn  8476: Retrieves usernames:domains for users in the specified course
                   8477: with specific role(s), and access status. 
                   8478: 
                   8479: Incoming parameters:
1.277     albertel 8480: 1. course domain
                   8481: 2. course number
                   8482: 3. access status: users must have - either active, 
1.275     raeburn  8483: previous, future, or all.
1.277     albertel 8484: 4. reference to array of permissible roles
1.288     raeburn  8485: 5. reference to array of section restrictions (optional)
                   8486: 6. reference to results object (hash of hashes).
                   8487: 7. reference to optional userdata hash
1.609     raeburn  8488: 8. reference to optional statushash
1.630     raeburn  8489: 9. flag if privileged users (except those set to unhide in
                   8490:    course settings) should be excluded    
1.609     raeburn  8491: Keys of top level results hash are roles.
1.275     raeburn  8492: Keys of inner hashes are username:domain, with 
                   8493: values set to access type.
1.288     raeburn  8494: Optional userdata hash returns an array with arguments in the 
                   8495: same order as loncoursedata::get_classlist() for student data.
                   8496: 
1.609     raeburn  8497: Optional statushash returns
                   8498: 
1.288     raeburn  8499: Entries for end, start, section and status are blank because
                   8500: of the possibility of multiple values for non-student roles.
                   8501: 
1.275     raeburn  8502: =cut
1.405     albertel 8503: 
1.275     raeburn  8504: ###############################################
1.405     albertel 8505: 
1.275     raeburn  8506: sub get_course_users {
1.630     raeburn  8507:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  8508:     my %idx = ();
1.419     raeburn  8509:     my %seclists;
1.288     raeburn  8510: 
                   8511:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   8512:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   8513:     $idx{end} = &Apache::loncoursedata::CL_END();
                   8514:     $idx{start} = &Apache::loncoursedata::CL_START();
                   8515:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   8516:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   8517:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   8518:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   8519: 
1.290     albertel 8520:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 8521:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  8522:         my $now = time;
1.277     albertel 8523:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  8524:             my $match = 0;
1.412     raeburn  8525:             my $secmatch = 0;
1.419     raeburn  8526:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  8527:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  8528:             if ($section eq '') {
                   8529:                 $section = 'none';
                   8530:             }
1.291     albertel 8531:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8532:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8533:                     $secmatch = 1;
                   8534:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 8535:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8536:                         $secmatch = 1;
                   8537:                     }
                   8538:                 } else {  
1.419     raeburn  8539: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  8540: 		        $secmatch = 1;
                   8541:                     }
1.290     albertel 8542: 		}
1.412     raeburn  8543:                 if (!$secmatch) {
                   8544:                     next;
                   8545:                 }
1.419     raeburn  8546:             }
1.275     raeburn  8547:             if (defined($$types{'active'})) {
1.288     raeburn  8548:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  8549:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  8550:                     $match = 1;
1.275     raeburn  8551:                 }
                   8552:             }
                   8553:             if (defined($$types{'previous'})) {
1.609     raeburn  8554:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  8555:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  8556:                     $match = 1;
1.275     raeburn  8557:                 }
                   8558:             }
                   8559:             if (defined($$types{'future'})) {
1.609     raeburn  8560:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  8561:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  8562:                     $match = 1;
1.275     raeburn  8563:                 }
                   8564:             }
1.609     raeburn  8565:             if ($match) {
                   8566:                 push(@{$seclists{$student}},$section);
                   8567:                 if (ref($userdata) eq 'HASH') {
                   8568:                     $$userdata{$student} = $$classlist{$student};
                   8569:                 }
                   8570:                 if (ref($statushash) eq 'HASH') {
                   8571:                     $statushash->{$student}{'st'}{$section} = $status;
                   8572:                 }
1.288     raeburn  8573:             }
1.275     raeburn  8574:         }
                   8575:     }
1.412     raeburn  8576:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  8577:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8578:         my $now = time;
1.609     raeburn  8579:         my %displaystatus = ( previous => 'Expired',
                   8580:                               active   => 'Active',
                   8581:                               future   => 'Future',
                   8582:                             );
1.1121    raeburn  8583:         my (%nothide,@possdoms);
1.630     raeburn  8584:         if ($hidepriv) {
                   8585:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   8586:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   8587:                 if ($user !~ /:/) {
                   8588:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   8589:                 } else {
                   8590:                     $nothide{$user} = 1;
                   8591:                 }
                   8592:             }
1.1121    raeburn  8593:             my @possdoms = ($cdom);
                   8594:             if ($coursehash{'checkforpriv'}) {
                   8595:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   8596:             }
1.630     raeburn  8597:         }
1.439     raeburn  8598:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  8599:             my $match = 0;
1.412     raeburn  8600:             my $secmatch = 0;
1.439     raeburn  8601:             my $status;
1.412     raeburn  8602:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  8603:             $user =~ s/:$//;
1.439     raeburn  8604:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   8605:             if ($end == -1 || $start == -1) {
                   8606:                 next;
                   8607:             }
                   8608:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   8609:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  8610:                 my ($uname,$udom) = split(/:/,$user);
                   8611:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8612:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8613:                         $secmatch = 1;
                   8614:                     } elsif ($usec eq '') {
1.420     albertel 8615:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8616:                             $secmatch = 1;
                   8617:                         }
                   8618:                     } else {
                   8619:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   8620:                             $secmatch = 1;
                   8621:                         }
                   8622:                     }
                   8623:                     if (!$secmatch) {
                   8624:                         next;
                   8625:                     }
1.288     raeburn  8626:                 }
1.419     raeburn  8627:                 if ($usec eq '') {
                   8628:                     $usec = 'none';
                   8629:                 }
1.275     raeburn  8630:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  8631:                     if ($hidepriv) {
1.1121    raeburn  8632:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  8633:                             (!$nothide{$uname.':'.$udom})) {
                   8634:                             next;
                   8635:                         }
                   8636:                     }
1.503     raeburn  8637:                     if ($end > 0 && $end < $now) {
1.439     raeburn  8638:                         $status = 'previous';
                   8639:                     } elsif ($start > $now) {
                   8640:                         $status = 'future';
                   8641:                     } else {
                   8642:                         $status = 'active';
                   8643:                     }
1.277     albertel 8644:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  8645:                         if ($status eq $type) {
1.420     albertel 8646:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  8647:                                 push(@{$$users{$role}{$user}},$type);
                   8648:                             }
1.288     raeburn  8649:                             $match = 1;
                   8650:                         }
                   8651:                     }
1.419     raeburn  8652:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   8653:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   8654: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   8655:                         }
1.420     albertel 8656:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  8657:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   8658:                         }
1.609     raeburn  8659:                         if (ref($statushash) eq 'HASH') {
                   8660:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   8661:                         }
1.275     raeburn  8662:                     }
                   8663:                 }
                   8664:             }
                   8665:         }
1.290     albertel 8666:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  8667:             if ((defined($cdom)) && (defined($cnum))) {
                   8668:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   8669:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   8670:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  8671:                     next if ($owner eq '');
                   8672:                     my ($ownername,$ownerdom);
                   8673:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   8674:                         $ownername = $1;
                   8675:                         $ownerdom = $2;
                   8676:                     } else {
                   8677:                         $ownername = $owner;
                   8678:                         $ownerdom = $cdom;
                   8679:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  8680:                     }
                   8681:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 8682:                     if (defined($userdata) && 
1.609     raeburn  8683: 			!exists($$userdata{$owner})) {
                   8684: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   8685:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   8686:                             push(@{$seclists{$owner}},'none');
                   8687:                         }
                   8688:                         if (ref($statushash) eq 'HASH') {
                   8689:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  8690:                         }
1.290     albertel 8691: 		    }
1.279     raeburn  8692:                 }
                   8693:             }
                   8694:         }
1.419     raeburn  8695:         foreach my $user (keys(%seclists)) {
                   8696:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   8697:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   8698:         }
1.275     raeburn  8699:     }
                   8700:     return;
                   8701: }
                   8702: 
1.288     raeburn  8703: sub get_user_info {
                   8704:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 8705:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   8706: 	&plainname($uname,$udom,'lastname');
1.291     albertel 8707:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  8708:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  8709:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   8710:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  8711:     return;
                   8712: }
1.275     raeburn  8713: 
1.472     raeburn  8714: ###############################################
                   8715: 
                   8716: =pod
                   8717: 
                   8718: =item * &get_user_quota()
                   8719: 
1.1134    raeburn  8720: Retrieves quota assigned for storage of user files.
                   8721: Default is to report quota for portfolio files.
1.472     raeburn  8722: 
                   8723: Incoming parameters:
                   8724: 1. user's username
                   8725: 2. user's domain
1.1134    raeburn  8726: 3. quota name - portfolio, author, or course
1.1136    raeburn  8727:    (if no quota name provided, defaults to portfolio).
1.1165    raeburn  8728: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1136    raeburn  8729:    course
1.472     raeburn  8730: 
                   8731: Returns:
1.1163    raeburn  8732: 1. Disk quota (in MB) assigned to student.
1.536     raeburn  8733: 2. (Optional) Type of setting: custom or default
                   8734:    (individually assigned or default for user's 
                   8735:    institutional status).
                   8736: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   8737:    or student - types as defined in localenroll::inst_usertypes 
                   8738:    for user's domain, which determines default quota for user.
                   8739: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  8740: 
                   8741: If a value has been stored in the user's environment, 
1.536     raeburn  8742: it will return that, otherwise it returns the maximal default
1.1134    raeburn  8743: defined for the user's institutional status(es) in the domain.
1.472     raeburn  8744: 
                   8745: =cut
                   8746: 
                   8747: ###############################################
                   8748: 
                   8749: 
                   8750: sub get_user_quota {
1.1136    raeburn  8751:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  8752:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  8753:     if (!defined($udom)) {
                   8754:         $udom = $env{'user.domain'};
                   8755:     }
                   8756:     if (!defined($uname)) {
                   8757:         $uname = $env{'user.name'};
                   8758:     }
                   8759:     if (($udom eq '' || $uname eq '') ||
                   8760:         ($udom eq 'public') && ($uname eq 'public')) {
                   8761:         $quota = 0;
1.536     raeburn  8762:         $quotatype = 'default';
                   8763:         $defquota = 0; 
1.472     raeburn  8764:     } else {
1.536     raeburn  8765:         my $inststatus;
1.1134    raeburn  8766:         if ($quotaname eq 'course') {
                   8767:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   8768:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   8769:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   8770:             } else {
                   8771:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   8772:                 $quota = $cenv{'internal.uploadquota'};
                   8773:             }
1.536     raeburn  8774:         } else {
1.1134    raeburn  8775:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   8776:                 if ($quotaname eq 'author') {
                   8777:                     $quota = $env{'environment.authorquota'};
                   8778:                 } else {
                   8779:                     $quota = $env{'environment.portfolioquota'};
                   8780:                 }
                   8781:                 $inststatus = $env{'environment.inststatus'};
                   8782:             } else {
                   8783:                 my %userenv = 
                   8784:                     &Apache::lonnet::get('environment',['portfolioquota',
                   8785:                                          'authorquota','inststatus'],$udom,$uname);
                   8786:                 my ($tmp) = keys(%userenv);
                   8787:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8788:                     if ($quotaname eq 'author') {
                   8789:                         $quota = $userenv{'authorquota'};
                   8790:                     } else {
                   8791:                         $quota = $userenv{'portfolioquota'};
                   8792:                     }
                   8793:                     $inststatus = $userenv{'inststatus'};
                   8794:                 } else {
                   8795:                     undef(%userenv);
                   8796:                 }
                   8797:             }
                   8798:         }
                   8799:         if ($quota eq '' || wantarray) {
                   8800:             if ($quotaname eq 'course') {
                   8801:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165    raeburn  8802:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') || 
                   8803:                     ($crstype eq 'community') || ($crstype eq 'textbook')) { 
1.1136    raeburn  8804:                     $defquota = $domdefs{$crstype.'quota'};
                   8805:                 }
                   8806:                 if ($defquota eq '') {
                   8807:                     $defquota = 500;
                   8808:                 }
1.1134    raeburn  8809:             } else {
                   8810:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   8811:             }
                   8812:             if ($quota eq '') {
                   8813:                 $quota = $defquota;
                   8814:                 $quotatype = 'default';
                   8815:             } else {
                   8816:                 $quotatype = 'custom';
                   8817:             }
1.472     raeburn  8818:         }
                   8819:     }
1.536     raeburn  8820:     if (wantarray) {
                   8821:         return ($quota,$quotatype,$settingstatus,$defquota);
                   8822:     } else {
                   8823:         return $quota;
                   8824:     }
1.472     raeburn  8825: }
                   8826: 
                   8827: ###############################################
                   8828: 
                   8829: =pod
                   8830: 
                   8831: =item * &default_quota()
                   8832: 
1.536     raeburn  8833: Retrieves default quota assigned for storage of user portfolio files,
                   8834: given an (optional) user's institutional status.
1.472     raeburn  8835: 
                   8836: Incoming parameters:
1.1142    raeburn  8837: 
1.472     raeburn  8838: 1. domain
1.536     raeburn  8839: 2. (Optional) institutional status(es).  This is a : separated list of 
                   8840:    status types (e.g., faculty, staff, student etc.)
                   8841:    which apply to the user for whom the default is being retrieved.
                   8842:    If the institutional status string in undefined, the domain
1.1134    raeburn  8843:    default quota will be returned.
                   8844: 3.  quota name - portfolio, author, or course
                   8845:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  8846: 
                   8847: Returns:
1.1142    raeburn  8848: 
1.1163    raeburn  8849: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536     raeburn  8850: 2. (Optional) institutional type which determined the value of the
                   8851:    default quota.
1.472     raeburn  8852: 
                   8853: If a value has been stored in the domain's configuration db,
                   8854: it will return that, otherwise it returns 20 (for backwards 
                   8855: compatibility with domains which have not set up a configuration
1.1163    raeburn  8856: db file; the original statically defined portfolio quota was 20 MB). 
1.472     raeburn  8857: 
1.536     raeburn  8858: If the user's status includes multiple types (e.g., staff and student),
                   8859: the largest default quota which applies to the user determines the
                   8860: default quota returned.
                   8861: 
1.472     raeburn  8862: =cut
                   8863: 
                   8864: ###############################################
                   8865: 
                   8866: 
                   8867: sub default_quota {
1.1134    raeburn  8868:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  8869:     my ($defquota,$settingstatus);
                   8870:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  8871:                                             ['quotas'],$udom);
1.1134    raeburn  8872:     my $key = 'defaultquota';
                   8873:     if ($quotaname eq 'author') {
                   8874:         $key = 'authorquota';
                   8875:     }
1.622     raeburn  8876:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  8877:         if ($inststatus ne '') {
1.765     raeburn  8878:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  8879:             foreach my $item (@statuses) {
1.1134    raeburn  8880:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8881:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  8882:                         if ($defquota eq '') {
1.1134    raeburn  8883:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8884:                             $settingstatus = $item;
1.1134    raeburn  8885:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   8886:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8887:                             $settingstatus = $item;
                   8888:                         }
                   8889:                     }
1.1134    raeburn  8890:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  8891:                     if ($quotahash{'quotas'}{$item} ne '') {
                   8892:                         if ($defquota eq '') {
                   8893:                             $defquota = $quotahash{'quotas'}{$item};
                   8894:                             $settingstatus = $item;
                   8895:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   8896:                             $defquota = $quotahash{'quotas'}{$item};
                   8897:                             $settingstatus = $item;
                   8898:                         }
1.536     raeburn  8899:                     }
                   8900:                 }
                   8901:             }
                   8902:         }
                   8903:         if ($defquota eq '') {
1.1134    raeburn  8904:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8905:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   8906:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  8907:                 $defquota = $quotahash{'quotas'}{'default'};
                   8908:             }
1.536     raeburn  8909:             $settingstatus = 'default';
1.1139    raeburn  8910:             if ($defquota eq '') {
                   8911:                 if ($quotaname eq 'author') {
                   8912:                     $defquota = 500;
                   8913:                 }
                   8914:             }
1.536     raeburn  8915:         }
                   8916:     } else {
                   8917:         $settingstatus = 'default';
1.1134    raeburn  8918:         if ($quotaname eq 'author') {
                   8919:             $defquota = 500;
                   8920:         } else {
                   8921:             $defquota = 20;
                   8922:         }
1.536     raeburn  8923:     }
                   8924:     if (wantarray) {
                   8925:         return ($defquota,$settingstatus);
1.472     raeburn  8926:     } else {
1.536     raeburn  8927:         return $defquota;
1.472     raeburn  8928:     }
                   8929: }
                   8930: 
1.1135    raeburn  8931: ###############################################
                   8932: 
                   8933: =pod
                   8934: 
1.1136    raeburn  8935: =item * &excess_filesize_warning()
1.1135    raeburn  8936: 
                   8937: Returns warning message if upload of file to authoring space, or copying
1.1136    raeburn  8938: of existing file within authoring space will cause quota for the authoring
1.1146    raeburn  8939: space to be exceeded.
1.1136    raeburn  8940: 
                   8941: Same, if upload of a file directly to a course/community via Course Editor
1.1137    raeburn  8942: will cause quota for uploaded content for the course to be exceeded.
1.1135    raeburn  8943: 
1.1165    raeburn  8944: Inputs: 7 
1.1136    raeburn  8945: 1. username or coursenum
1.1135    raeburn  8946: 2. domain
1.1136    raeburn  8947: 3. context ('author' or 'course')
1.1135    raeburn  8948: 4. filename of file for which action is being requested
                   8949: 5. filesize (kB) of file
                   8950: 6. action being taken: copy or upload.
1.1165    raeburn  8951: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1135    raeburn  8952: 
                   8953: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142    raeburn  8954:          otherwise return null.
                   8955: 
                   8956: =back
1.1135    raeburn  8957: 
                   8958: =cut
                   8959: 
1.1136    raeburn  8960: sub excess_filesize_warning {
1.1165    raeburn  8961:     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136    raeburn  8962:     my $current_disk_usage = 0;
1.1165    raeburn  8963:     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136    raeburn  8964:     if ($context eq 'author') {
                   8965:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   8966:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   8967:     } else {
                   8968:         foreach my $subdir ('docs','supplemental') {
                   8969:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   8970:         }
                   8971:     }
1.1135    raeburn  8972:     $disk_quota = int($disk_quota * 1000);
                   8973:     if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179    bisitz   8974:         return '<p class="LC_warning">'.
1.1135    raeburn  8975:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179    bisitz   8976:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                   8977:                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135    raeburn  8978:                             $disk_quota,$current_disk_usage).
                   8979:                '</p>';
                   8980:     }
                   8981:     return;
                   8982: }
                   8983: 
                   8984: ###############################################
                   8985: 
                   8986: 
1.1136    raeburn  8987: 
                   8988: 
1.384     raeburn  8989: sub get_secgrprole_info {
                   8990:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   8991:     my %sections_count = &get_sections($cdom,$cnum);
                   8992:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   8993:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   8994:     my @groups = sort(keys(%curr_groups));
                   8995:     my $allroles = [];
                   8996:     my $rolehash;
                   8997:     my $accesshash = {
                   8998:                      active => 'Currently has access',
                   8999:                      future => 'Will have future access',
                   9000:                      previous => 'Previously had access',
                   9001:                   };
                   9002:     if ($needroles) {
                   9003:         $rolehash = {'all' => 'all'};
1.385     albertel 9004:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9005: 	if (&Apache::lonnet::error(%user_roles)) {
                   9006: 	    undef(%user_roles);
                   9007: 	}
                   9008:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  9009:             my ($role)=split(/\:/,$item,2);
                   9010:             if ($role eq 'cr') { next; }
                   9011:             if ($role =~ /^cr/) {
                   9012:                 $$rolehash{$role} = (split('/',$role))[3];
                   9013:             } else {
                   9014:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   9015:             }
                   9016:         }
                   9017:         foreach my $key (sort(keys(%{$rolehash}))) {
                   9018:             push(@{$allroles},$key);
                   9019:         }
                   9020:         push (@{$allroles},'st');
                   9021:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   9022:     }
                   9023:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   9024: }
                   9025: 
1.555     raeburn  9026: sub user_picker {
1.994     raeburn  9027:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  9028:     my $currdom = $dom;
                   9029:     my %curr_selected = (
                   9030:                         srchin => 'dom',
1.580     raeburn  9031:                         srchby => 'lastname',
1.555     raeburn  9032:                       );
                   9033:     my $srchterm;
1.625     raeburn  9034:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  9035:         if ($srch->{'srchby'} ne '') {
                   9036:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   9037:         }
                   9038:         if ($srch->{'srchin'} ne '') {
                   9039:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   9040:         }
                   9041:         if ($srch->{'srchtype'} ne '') {
                   9042:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   9043:         }
                   9044:         if ($srch->{'srchdomain'} ne '') {
                   9045:             $currdom = $srch->{'srchdomain'};
                   9046:         }
                   9047:         $srchterm = $srch->{'srchterm'};
                   9048:     }
                   9049:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  9050:                     'usr'       => 'Search criteria',
1.563     raeburn  9051:                     'doma'      => 'Domain/institution to search',
1.558     albertel 9052:                     'uname'     => 'username',
                   9053:                     'lastname'  => 'last name',
1.555     raeburn  9054:                     'lastfirst' => 'last name, first name',
1.558     albertel 9055:                     'crs'       => 'in this course',
1.576     raeburn  9056:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 9057:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  9058:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 9059:                     'exact'     => 'is',
                   9060:                     'contains'  => 'contains',
1.569     raeburn  9061:                     'begins'    => 'begins with',
1.571     raeburn  9062:                     'youm'      => "You must include some text to search for.",
                   9063:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   9064:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   9065:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   9066:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   9067:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   9068:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   9069:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  9070:                                        );
1.563     raeburn  9071:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   9072:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  9073: 
                   9074:     my @srchins = ('crs','dom','alc','instd');
                   9075: 
                   9076:     foreach my $option (@srchins) {
                   9077:         # FIXME 'alc' option unavailable until 
                   9078:         #       loncreateuser::print_user_query_page()
                   9079:         #       has been completed.
                   9080:         next if ($option eq 'alc');
1.880     raeburn  9081:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  9082:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  9083:         if ($curr_selected{'srchin'} eq $option) {
                   9084:             $srchinsel .= ' 
                   9085:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9086:         } else {
                   9087:             $srchinsel .= '
                   9088:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9089:         }
1.555     raeburn  9090:     }
1.563     raeburn  9091:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  9092: 
                   9093:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  9094:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  9095:         if ($curr_selected{'srchby'} eq $option) {
                   9096:             $srchbysel .= '
                   9097:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9098:         } else {
                   9099:             $srchbysel .= '
                   9100:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9101:          }
                   9102:     }
                   9103:     $srchbysel .= "\n  </select>\n";
                   9104: 
                   9105:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  9106:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  9107:         if ($curr_selected{'srchtype'} eq $option) {
                   9108:             $srchtypesel .= '
                   9109:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9110:         } else {
                   9111:             $srchtypesel .= '
                   9112:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9113:         }
                   9114:     }
                   9115:     $srchtypesel .= "\n  </select>\n";
                   9116: 
1.558     albertel 9117:     my ($newuserscript,$new_user_create);
1.994     raeburn  9118:     my $context_dom = $env{'request.role.domain'};
                   9119:     if ($context eq 'requestcrs') {
                   9120:         if ($env{'form.coursedom'} ne '') { 
                   9121:             $context_dom = $env{'form.coursedom'};
                   9122:         }
                   9123:     }
1.556     raeburn  9124:     if ($forcenewuser) {
1.576     raeburn  9125:         if (ref($srch) eq 'HASH') {
1.994     raeburn  9126:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  9127:                 if ($cancreate) {
                   9128:                     $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>';
                   9129:                 } else {
1.799     bisitz   9130:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  9131:                     my %usertypetext = (
                   9132:                         official   => 'institutional',
                   9133:                         unofficial => 'non-institutional',
                   9134:                     );
1.799     bisitz   9135:                     $new_user_create = '<p class="LC_warning">'
                   9136:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   9137:                                       .' '
                   9138:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   9139:                                           ,'<a href="'.$helplink.'">','</a>')
                   9140:                                       .'</p><br />';
1.627     raeburn  9141:                 }
1.576     raeburn  9142:             }
                   9143:         }
                   9144: 
1.556     raeburn  9145:         $newuserscript = <<"ENDSCRIPT";
                   9146: 
1.570     raeburn  9147: function setSearch(createnew,callingForm) {
1.556     raeburn  9148:     if (createnew == 1) {
1.570     raeburn  9149:         for (var i=0; i<callingForm.srchby.length; i++) {
                   9150:             if (callingForm.srchby.options[i].value == 'uname') {
                   9151:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  9152:             }
                   9153:         }
1.570     raeburn  9154:         for (var i=0; i<callingForm.srchin.length; i++) {
                   9155:             if ( callingForm.srchin.options[i].value == 'dom') {
                   9156: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  9157:             }
                   9158:         }
1.570     raeburn  9159:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   9160:             if (callingForm.srchtype.options[i].value == 'exact') {
                   9161:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  9162:             }
                   9163:         }
1.570     raeburn  9164:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  9165:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  9166:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  9167:             }
                   9168:         }
                   9169:     }
                   9170: }
                   9171: ENDSCRIPT
1.558     albertel 9172: 
1.556     raeburn  9173:     }
                   9174: 
1.555     raeburn  9175:     my $output = <<"END_BLOCK";
1.556     raeburn  9176: <script type="text/javascript">
1.824     bisitz   9177: // <![CDATA[
1.570     raeburn  9178: function validateEntry(callingForm) {
1.558     albertel 9179: 
1.556     raeburn  9180:     var checkok = 1;
1.558     albertel 9181:     var srchin;
1.570     raeburn  9182:     for (var i=0; i<callingForm.srchin.length; i++) {
                   9183: 	if ( callingForm.srchin[i].checked ) {
                   9184: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 9185: 	}
                   9186:     }
                   9187: 
1.570     raeburn  9188:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   9189:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   9190:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   9191:     var srchterm =  callingForm.srchterm.value;
                   9192:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  9193:     var msg = "";
                   9194: 
                   9195:     if (srchterm == "") {
                   9196:         checkok = 0;
1.571     raeburn  9197:         msg += "$lt{'youm'}\\n";
1.556     raeburn  9198:     }
                   9199: 
1.569     raeburn  9200:     if (srchtype== 'begins') {
                   9201:         if (srchterm.length < 2) {
                   9202:             checkok = 0;
1.571     raeburn  9203:             msg += "$lt{'thte'}\\n";
1.569     raeburn  9204:         }
                   9205:     }
                   9206: 
1.556     raeburn  9207:     if (srchtype== 'contains') {
                   9208:         if (srchterm.length < 3) {
                   9209:             checkok = 0;
1.571     raeburn  9210:             msg += "$lt{'thet'}\\n";
1.556     raeburn  9211:         }
                   9212:     }
                   9213:     if (srchin == 'instd') {
                   9214:         if (srchdomain == '') {
                   9215:             checkok = 0;
1.571     raeburn  9216:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  9217:         }
                   9218:     }
                   9219:     if (srchin == 'dom') {
                   9220:         if (srchdomain == '') {
                   9221:             checkok = 0;
1.571     raeburn  9222:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  9223:         }
                   9224:     }
                   9225:     if (srchby == 'lastfirst') {
                   9226:         if (srchterm.indexOf(",") == -1) {
                   9227:             checkok = 0;
1.571     raeburn  9228:             msg += "$lt{'whus'}\\n";
1.556     raeburn  9229:         }
                   9230:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   9231:             checkok = 0;
1.571     raeburn  9232:             msg += "$lt{'whse'}\\n";
1.556     raeburn  9233:         }
                   9234:     }
                   9235:     if (checkok == 0) {
1.571     raeburn  9236:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  9237:         return;
                   9238:     }
                   9239:     if (checkok == 1) {
1.570     raeburn  9240:         callingForm.submit();
1.556     raeburn  9241:     }
                   9242: }
                   9243: 
                   9244: $newuserscript
                   9245: 
1.824     bisitz   9246: // ]]>
1.556     raeburn  9247: </script>
1.558     albertel 9248: 
                   9249: $new_user_create
                   9250: 
1.555     raeburn  9251: END_BLOCK
1.558     albertel 9252: 
1.876     raeburn  9253:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   9254:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   9255:                $domform.
                   9256:                &Apache::lonhtmlcommon::row_closure().
                   9257:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   9258:                $srchbysel.
                   9259:                $srchtypesel. 
                   9260:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   9261:                $srchinsel.
                   9262:                &Apache::lonhtmlcommon::row_closure(1). 
                   9263:                &Apache::lonhtmlcommon::end_pick_box().
                   9264:                '<br />';
1.555     raeburn  9265:     return $output;
                   9266: }
                   9267: 
1.612     raeburn  9268: sub user_rule_check {
1.615     raeburn  9269:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  9270:     my $response;
                   9271:     if (ref($usershash) eq 'HASH') {
                   9272:         foreach my $user (keys(%{$usershash})) {
                   9273:             my ($uname,$udom) = split(/:/,$user);
                   9274:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  9275:             my ($id,$newuser);
1.612     raeburn  9276:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  9277:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  9278:                 $id = $usershash->{$user}->{'id'};
                   9279:             }
                   9280:             my $inst_response;
                   9281:             if (ref($checks) eq 'HASH') {
                   9282:                 if (defined($checks->{'username'})) {
1.615     raeburn  9283:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  9284:                         &Apache::lonnet::get_instuser($udom,$uname);
                   9285:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  9286:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  9287:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   9288:                 }
1.615     raeburn  9289:             } else {
                   9290:                 ($inst_response,%{$inst_results->{$user}}) =
                   9291:                     &Apache::lonnet::get_instuser($udom,$uname);
                   9292:                 return;
1.612     raeburn  9293:             }
1.615     raeburn  9294:             if (!$got_rules->{$udom}) {
1.612     raeburn  9295:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   9296:                                                   ['usercreation'],$udom);
                   9297:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  9298:                     foreach my $item ('username','id') {
1.612     raeburn  9299:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   9300:                             $$curr_rules{$udom}{$item} = 
                   9301:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  9302:                         }
                   9303:                     }
                   9304:                 }
1.615     raeburn  9305:                 $got_rules->{$udom} = 1;  
1.585     raeburn  9306:             }
1.612     raeburn  9307:             foreach my $item (keys(%{$checks})) {
                   9308:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   9309:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   9310:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   9311:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   9312:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   9313:                                 if ($rule_check{$rule}) {
                   9314:                                     $$rulematch{$user}{$item} = $rule;
                   9315:                                     if ($inst_response eq 'ok') {
1.615     raeburn  9316:                                         if (ref($inst_results) eq 'HASH') {
                   9317:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   9318:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   9319:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   9320:                                                 }
1.612     raeburn  9321:                                             }
                   9322:                                         }
1.615     raeburn  9323:                                     }
                   9324:                                     last;
1.585     raeburn  9325:                                 }
                   9326:                             }
                   9327:                         }
                   9328:                     }
                   9329:                 }
                   9330:             }
                   9331:         }
                   9332:     }
1.612     raeburn  9333:     return;
                   9334: }
                   9335: 
                   9336: sub user_rule_formats {
                   9337:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   9338:     my %text = ( 
                   9339:                  'username' => 'Usernames',
                   9340:                  'id'       => 'IDs',
                   9341:                );
                   9342:     my $output;
                   9343:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   9344:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   9345:         if (@{$ruleorder} > 0) {
1.1102    raeburn  9346:             $output = '<br />'.
                   9347:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   9348:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   9349:                       ' <ul>';
1.612     raeburn  9350:             foreach my $rule (@{$ruleorder}) {
                   9351:                 if (ref($curr_rules) eq 'ARRAY') {
                   9352:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   9353:                         if (ref($rules->{$rule}) eq 'HASH') {
                   9354:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   9355:                                         $rules->{$rule}{'desc'}.'</li>';
                   9356:                         }
                   9357:                     }
                   9358:                 }
                   9359:             }
                   9360:             $output .= '</ul>';
                   9361:         }
                   9362:     }
                   9363:     return $output;
                   9364: }
                   9365: 
                   9366: sub instrule_disallow_msg {
1.615     raeburn  9367:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  9368:     my $response;
                   9369:     my %text = (
                   9370:                   item   => 'username',
                   9371:                   items  => 'usernames',
                   9372:                   match  => 'matches',
                   9373:                   do     => 'does',
                   9374:                   action => 'a username',
                   9375:                   one    => 'one',
                   9376:                );
                   9377:     if ($count > 1) {
                   9378:         $text{'item'} = 'usernames';
                   9379:         $text{'match'} ='match';
                   9380:         $text{'do'} = 'do';
                   9381:         $text{'action'} = 'usernames',
                   9382:         $text{'one'} = 'ones';
                   9383:     }
                   9384:     if ($checkitem eq 'id') {
                   9385:         $text{'items'} = 'IDs';
                   9386:         $text{'item'} = 'ID';
                   9387:         $text{'action'} = 'an ID';
1.615     raeburn  9388:         if ($count > 1) {
                   9389:             $text{'item'} = 'IDs';
                   9390:             $text{'action'} = 'IDs';
                   9391:         }
1.612     raeburn  9392:     }
1.674     bisitz   9393:     $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  9394:     if ($mode eq 'upload') {
                   9395:         if ($checkitem eq 'username') {
                   9396:             $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'}.");
                   9397:         } elsif ($checkitem eq 'id') {
1.674     bisitz   9398:             $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  9399:         }
1.669     raeburn  9400:     } elsif ($mode eq 'selfcreate') {
                   9401:         if ($checkitem eq 'id') {
                   9402:             $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.");
                   9403:         }
1.615     raeburn  9404:     } else {
                   9405:         if ($checkitem eq 'username') {
                   9406:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   9407:         } elsif ($checkitem eq 'id') {
                   9408:             $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.");
                   9409:         }
1.612     raeburn  9410:     }
                   9411:     return $response;
1.585     raeburn  9412: }
                   9413: 
1.624     raeburn  9414: sub personal_data_fieldtitles {
                   9415:     my %fieldtitles = &Apache::lonlocal::texthash (
                   9416:                         id => 'Student/Employee ID',
                   9417:                         permanentemail => 'E-mail address',
                   9418:                         lastname => 'Last Name',
                   9419:                         firstname => 'First Name',
                   9420:                         middlename => 'Middle Name',
                   9421:                         generation => 'Generation',
                   9422:                         gen => 'Generation',
1.765     raeburn  9423:                         inststatus => 'Affiliation',
1.624     raeburn  9424:                    );
                   9425:     return %fieldtitles;
                   9426: }
                   9427: 
1.642     raeburn  9428: sub sorted_inst_types {
                   9429:     my ($dom) = @_;
                   9430:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   9431:     my $othertitle = &mt('All users');
                   9432:     if ($env{'request.course.id'}) {
1.668     raeburn  9433:         $othertitle  = &mt('Any users');
1.642     raeburn  9434:     }
                   9435:     my @types;
                   9436:     if (ref($order) eq 'ARRAY') {
                   9437:         @types = @{$order};
                   9438:     }
                   9439:     if (@types == 0) {
                   9440:         if (ref($usertypes) eq 'HASH') {
                   9441:             @types = sort(keys(%{$usertypes}));
                   9442:         }
                   9443:     }
                   9444:     if (keys(%{$usertypes}) > 0) {
                   9445:         $othertitle = &mt('Other users');
                   9446:     }
                   9447:     return ($othertitle,$usertypes,\@types);
                   9448: }
                   9449: 
1.645     raeburn  9450: sub get_institutional_codes {
                   9451:     my ($settings,$allcourses,$LC_code) = @_;
                   9452: # Get complete list of course sections to update
                   9453:     my @currsections = ();
                   9454:     my @currxlists = ();
                   9455:     my $coursecode = $$settings{'internal.coursecode'};
                   9456: 
                   9457:     if ($$settings{'internal.sectionnums'} ne '') {
                   9458:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   9459:     }
                   9460: 
                   9461:     if ($$settings{'internal.crosslistings'} ne '') {
                   9462:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   9463:     }
                   9464: 
                   9465:     if (@currxlists > 0) {
                   9466:         foreach (@currxlists) {
                   9467:             if (m/^([^:]+):(\w*)$/) {
                   9468:                 unless (grep/^$1$/,@{$allcourses}) {
                   9469:                     push @{$allcourses},$1;
                   9470:                     $$LC_code{$1} = $2;
                   9471:                 }
                   9472:             }
                   9473:         }
                   9474:     }
                   9475:  
                   9476:     if (@currsections > 0) {
                   9477:         foreach (@currsections) {
                   9478:             if (m/^(\w+):(\w*)$/) {
                   9479:                 my $sec = $coursecode.$1;
                   9480:                 my $lc_sec = $2;
                   9481:                 unless (grep/^$sec$/,@{$allcourses}) {
                   9482:                     push @{$allcourses},$sec;
                   9483:                     $$LC_code{$sec} = $lc_sec;
                   9484:                 }
                   9485:             }
                   9486:         }
                   9487:     }
                   9488:     return;
                   9489: }
                   9490: 
1.971     raeburn  9491: sub get_standard_codeitems {
                   9492:     return ('Year','Semester','Department','Number','Section');
                   9493: }
                   9494: 
1.112     bowersj2 9495: =pod
                   9496: 
1.780     raeburn  9497: =head1 Slot Helpers
                   9498: 
                   9499: =over 4
                   9500: 
                   9501: =item * sorted_slots()
                   9502: 
1.1040    raeburn  9503: Sorts an array of slot names in order of an optional sort key,
                   9504: default sort is by slot start time (earliest first). 
1.780     raeburn  9505: 
                   9506: Inputs:
                   9507: 
                   9508: =over 4
                   9509: 
                   9510: slotsarr  - Reference to array of unsorted slot names.
                   9511: 
                   9512: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   9513: 
1.1040    raeburn  9514: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   9515: 
1.549     albertel 9516: =back
                   9517: 
1.780     raeburn  9518: Returns:
                   9519: 
                   9520: =over 4
                   9521: 
1.1040    raeburn  9522: sorted   - An array of slot names sorted by a specified sort key 
                   9523:            (default sort key is start time of the slot).
1.780     raeburn  9524: 
                   9525: =back
                   9526: 
                   9527: =cut
                   9528: 
                   9529: 
                   9530: sub sorted_slots {
1.1040    raeburn  9531:     my ($slotsarr,$slots,$sortkey) = @_;
                   9532:     if ($sortkey eq '') {
                   9533:         $sortkey = 'starttime';
                   9534:     }
1.780     raeburn  9535:     my @sorted;
                   9536:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   9537:         @sorted =
                   9538:             sort {
                   9539:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  9540:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  9541:                      }
                   9542:                      if (ref($slots->{$a})) { return -1;}
                   9543:                      if (ref($slots->{$b})) { return 1;}
                   9544:                      return 0;
                   9545:                  } @{$slotsarr};
                   9546:     }
                   9547:     return @sorted;
                   9548: }
                   9549: 
1.1040    raeburn  9550: =pod
                   9551: 
                   9552: =item * get_future_slots()
                   9553: 
                   9554: Inputs:
                   9555: 
                   9556: =over 4
                   9557: 
                   9558: cnum - course number
                   9559: 
                   9560: cdom - course domain
                   9561: 
                   9562: now - current UNIX time
                   9563: 
                   9564: symb - optional symb
                   9565: 
                   9566: =back
                   9567: 
                   9568: Returns:
                   9569: 
                   9570: =over 4
                   9571: 
                   9572: sorted_reservable - ref to array of student_schedulable slots currently 
                   9573:                     reservable, ordered by end date of reservation period.
                   9574: 
                   9575: reservable_now - ref to hash of student_schedulable slots currently
                   9576:                  reservable.
                   9577: 
                   9578:     Keys in inner hash are:
                   9579:     (a) symb: either blank or symb to which slot use is restricted.
                   9580:     (b) endreserve: end date of reservation period. 
                   9581: 
                   9582: sorted_future - ref to array of student_schedulable slots reservable in
                   9583:                 the future, ordered by start date of reservation period.
                   9584: 
                   9585: future_reservable - ref to hash of student_schedulable slots reservable
                   9586:                     in the future.
                   9587: 
                   9588:     Keys in inner hash are:
                   9589:     (a) symb: either blank or symb to which slot use is restricted.
                   9590:     (b) startreserve:  start date of reservation period.
                   9591: 
                   9592: =back
                   9593: 
                   9594: =cut
                   9595: 
                   9596: sub get_future_slots {
                   9597:     my ($cnum,$cdom,$now,$symb) = @_;
                   9598:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   9599:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   9600:     foreach my $slot (keys(%slots)) {
                   9601:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   9602:         if ($symb) {
                   9603:             next if (($slots{$slot}->{'symb'} ne '') && 
                   9604:                      ($slots{$slot}->{'symb'} ne $symb));
                   9605:         }
                   9606:         if (($slots{$slot}->{'starttime'} > $now) &&
                   9607:             ($slots{$slot}->{'endtime'} > $now)) {
                   9608:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   9609:                 my $userallowed = 0;
                   9610:                 if ($slots{$slot}->{'allowedsections'}) {
                   9611:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   9612:                     if (!defined($env{'request.role.sec'})
                   9613:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   9614:                         $userallowed=1;
                   9615:                     } else {
                   9616:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   9617:                             $userallowed=1;
                   9618:                         }
                   9619:                     }
                   9620:                     unless ($userallowed) {
                   9621:                         if (defined($env{'request.course.groups'})) {
                   9622:                             my @groups = split(/:/,$env{'request.course.groups'});
                   9623:                             foreach my $group (@groups) {
                   9624:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   9625:                                     $userallowed=1;
                   9626:                                     last;
                   9627:                                 }
                   9628:                             }
                   9629:                         }
                   9630:                     }
                   9631:                 }
                   9632:                 if ($slots{$slot}->{'allowedusers'}) {
                   9633:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   9634:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   9635:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   9636:                         $userallowed = 1;
                   9637:                     }
                   9638:                 }
                   9639:                 next unless($userallowed);
                   9640:             }
                   9641:             my $startreserve = $slots{$slot}->{'startreserve'};
                   9642:             my $endreserve = $slots{$slot}->{'endreserve'};
                   9643:             my $symb = $slots{$slot}->{'symb'};
                   9644:             if (($startreserve < $now) &&
                   9645:                 (!$endreserve || $endreserve > $now)) {
                   9646:                 my $lastres = $endreserve;
                   9647:                 if (!$lastres) {
                   9648:                     $lastres = $slots{$slot}->{'starttime'};
                   9649:                 }
                   9650:                 $reservable_now{$slot} = {
                   9651:                                            symb       => $symb,
                   9652:                                            endreserve => $lastres
                   9653:                                          };
                   9654:             } elsif (($startreserve > $now) &&
                   9655:                      (!$endreserve || $endreserve > $startreserve)) {
                   9656:                 $future_reservable{$slot} = {
                   9657:                                               symb         => $symb,
                   9658:                                               startreserve => $startreserve
                   9659:                                             };
                   9660:             }
                   9661:         }
                   9662:     }
                   9663:     my @unsorted_reservable = keys(%reservable_now);
                   9664:     if (@unsorted_reservable > 0) {
                   9665:         @sorted_reservable = 
                   9666:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   9667:     }
                   9668:     my @unsorted_future = keys(%future_reservable);
                   9669:     if (@unsorted_future > 0) {
                   9670:         @sorted_future =
                   9671:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   9672:     }
                   9673:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   9674: }
1.780     raeburn  9675: 
                   9676: =pod
                   9677: 
1.1057    foxr     9678: =back
                   9679: 
1.549     albertel 9680: =head1 HTTP Helpers
                   9681: 
                   9682: =over 4
                   9683: 
1.648     raeburn  9684: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 9685: 
1.258     albertel 9686: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 9687: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 9688: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 9689: 
                   9690: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   9691: $possible_names is an ref to an array of form element names.  As an example:
                   9692: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 9693: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 9694: 
                   9695: =cut
1.1       albertel 9696: 
1.6       albertel 9697: sub get_unprocessed_cgi {
1.25      albertel 9698:   my ($query,$possible_names)= @_;
1.26      matthew  9699:   # $Apache::lonxml::debug=1;
1.356     albertel 9700:   foreach my $pair (split(/&/,$query)) {
                   9701:     my ($name, $value) = split(/=/,$pair);
1.369     www      9702:     $name = &unescape($name);
1.25      albertel 9703:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   9704:       $value =~ tr/+/ /;
                   9705:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 9706:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 9707:     }
1.16      harris41 9708:   }
1.6       albertel 9709: }
                   9710: 
1.112     bowersj2 9711: =pod
                   9712: 
1.648     raeburn  9713: =item * &cacheheader() 
1.112     bowersj2 9714: 
                   9715: returns cache-controlling header code
                   9716: 
                   9717: =cut
                   9718: 
1.7       albertel 9719: sub cacheheader {
1.258     albertel 9720:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 9721:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   9722:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 9723:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   9724:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 9725:     return $output;
1.7       albertel 9726: }
                   9727: 
1.112     bowersj2 9728: =pod
                   9729: 
1.648     raeburn  9730: =item * &no_cache($r) 
1.112     bowersj2 9731: 
                   9732: specifies header code to not have cache
                   9733: 
                   9734: =cut
                   9735: 
1.9       albertel 9736: sub no_cache {
1.216     albertel 9737:     my ($r) = @_;
                   9738:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 9739: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 9740:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   9741:     $r->no_cache(1);
                   9742:     $r->header_out("Expires" => $date);
                   9743:     $r->header_out("Pragma" => "no-cache");
1.123     www      9744: }
                   9745: 
                   9746: sub content_type {
1.181     albertel 9747:     my ($r,$type,$charset) = @_;
1.299     foxr     9748:     if ($r) {
                   9749: 	#  Note that printout.pl calls this with undef for $r.
                   9750: 	&no_cache($r);
                   9751:     }
1.258     albertel 9752:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 9753:     unless ($charset) {
                   9754: 	$charset=&Apache::lonlocal::current_encoding;
                   9755:     }
                   9756:     if ($charset) { $type.='; charset='.$charset; }
                   9757:     if ($r) {
                   9758: 	$r->content_type($type);
                   9759:     } else {
                   9760: 	print("Content-type: $type\n\n");
                   9761:     }
1.9       albertel 9762: }
1.25      albertel 9763: 
1.112     bowersj2 9764: =pod
                   9765: 
1.648     raeburn  9766: =item * &add_to_env($name,$value) 
1.112     bowersj2 9767: 
1.258     albertel 9768: adds $name to the %env hash with value
1.112     bowersj2 9769: $value, if $name already exists, the entry is converted to an array
                   9770: reference and $value is added to the array.
                   9771: 
                   9772: =cut
                   9773: 
1.25      albertel 9774: sub add_to_env {
                   9775:   my ($name,$value)=@_;
1.258     albertel 9776:   if (defined($env{$name})) {
                   9777:     if (ref($env{$name})) {
1.25      albertel 9778:       #already have multiple values
1.258     albertel 9779:       push(@{ $env{$name} },$value);
1.25      albertel 9780:     } else {
                   9781:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 9782:       my $first=$env{$name};
                   9783:       undef($env{$name});
                   9784:       push(@{ $env{$name} },$first,$value);
1.25      albertel 9785:     }
                   9786:   } else {
1.258     albertel 9787:     $env{$name}=$value;
1.25      albertel 9788:   }
1.31      albertel 9789: }
1.149     albertel 9790: 
                   9791: =pod
                   9792: 
1.648     raeburn  9793: =item * &get_env_multiple($name) 
1.149     albertel 9794: 
1.258     albertel 9795: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 9796: values may be defined and end up as an array ref.
                   9797: 
                   9798: returns an array of values
                   9799: 
                   9800: =cut
                   9801: 
                   9802: sub get_env_multiple {
                   9803:     my ($name) = @_;
                   9804:     my @values;
1.258     albertel 9805:     if (defined($env{$name})) {
1.149     albertel 9806:         # exists is it an array
1.258     albertel 9807:         if (ref($env{$name})) {
                   9808:             @values=@{ $env{$name} };
1.149     albertel 9809:         } else {
1.258     albertel 9810:             $values[0]=$env{$name};
1.149     albertel 9811:         }
                   9812:     }
                   9813:     return(@values);
                   9814: }
                   9815: 
1.660     raeburn  9816: sub ask_for_embedded_content {
                   9817:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  9818:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085    raeburn  9819:         %currsubfile,%unused,$rem);
1.1071    raeburn  9820:     my $counter = 0;
                   9821:     my $numnew = 0;
1.987     raeburn  9822:     my $numremref = 0;
                   9823:     my $numinvalid = 0;
                   9824:     my $numpathchg = 0;
                   9825:     my $numexisting = 0;
1.1071    raeburn  9826:     my $numunused = 0;
                   9827:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156    raeburn  9828:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  9829:     my $heading = &mt('Upload embedded files');
                   9830:     my $buttontext = &mt('Upload');
                   9831: 
1.1085    raeburn  9832:     if ($env{'request.course.id'}) {
1.1123    raeburn  9833:         if ($actionurl eq '/adm/dependencies') {
                   9834:             $navmap = Apache::lonnavmaps::navmap->new();
                   9835:         }
                   9836:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9837:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085    raeburn  9838:     }
1.1123    raeburn  9839:     if (($actionurl eq '/adm/portfolio') || 
                   9840:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  9841:         my $current_path='/';
                   9842:         if ($env{'form.currentpath'}) {
                   9843:             $current_path = $env{'form.currentpath'};
                   9844:         }
                   9845:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123    raeburn  9846:             $udom = $cdom;
                   9847:             $uname = $cnum;
1.984     raeburn  9848:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   9849:         } else {
                   9850:             $udom = $env{'user.domain'};
                   9851:             $uname = $env{'user.name'};
                   9852:             $url = '/userfiles/portfolio';
                   9853:         }
1.987     raeburn  9854:         $toplevel = $url.'/';
1.984     raeburn  9855:         $url .= $current_path;
                   9856:         $getpropath = 1;
1.987     raeburn  9857:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   9858:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      9859:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  9860:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  9861:         $toplevel = $url;
1.984     raeburn  9862:         if ($rest ne '') {
1.987     raeburn  9863:             $url .= $rest;
                   9864:         }
                   9865:     } elsif ($actionurl eq '/adm/coursedocs') {
                   9866:         if (ref($args) eq 'HASH') {
1.1071    raeburn  9867:             $url = $args->{'docs_url'};
                   9868:             $toplevel = $url;
1.1084    raeburn  9869:             if ($args->{'context'} eq 'paste') {
                   9870:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   9871:                 ($path) = 
                   9872:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9873:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9874:                 $fileloc =~ s{^/}{};
                   9875:             }
1.1071    raeburn  9876:         }
1.1084    raeburn  9877:     } elsif ($actionurl eq '/adm/dependencies')  {
1.1071    raeburn  9878:         if ($env{'request.course.id'} ne '') {
                   9879:             if (ref($args) eq 'HASH') {
                   9880:                 $url = $args->{'docs_url'};
                   9881:                 $title = $args->{'docs_title'};
1.1126    raeburn  9882:                 $toplevel = $url; 
                   9883:                 unless ($toplevel =~ m{^/}) {
                   9884:                     $toplevel = "/$url";
                   9885:                 }
1.1085    raeburn  9886:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126    raeburn  9887:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   9888:                     $path = $1;
                   9889:                 } else {
                   9890:                     ($path) =
                   9891:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9892:                 }
1.1071    raeburn  9893:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9894:                 $fileloc =~ s{^/}{};
                   9895:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   9896:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   9897:             }
1.987     raeburn  9898:         }
1.1123    raeburn  9899:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9900:         $udom = $cdom;
                   9901:         $uname = $cnum;
                   9902:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   9903:         $toplevel = $url;
                   9904:         $path = $url;
                   9905:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   9906:         $fileloc =~ s{^/}{};
1.987     raeburn  9907:     }
1.1126    raeburn  9908:     foreach my $file (keys(%{$allfiles})) {
                   9909:         my $embed_file;
                   9910:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   9911:             $embed_file = $1;
                   9912:         } else {
                   9913:             $embed_file = $file;
                   9914:         }
1.1158    raeburn  9915:         my ($absolutepath,$cleaned_file);
                   9916:         if ($embed_file =~ m{^\w+://}) {
                   9917:             $cleaned_file = $embed_file;
1.1147    raeburn  9918:             $newfiles{$cleaned_file} = 1;
                   9919:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  9920:         } else {
1.1158    raeburn  9921:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  9922:             if ($embed_file =~ m{^/}) {
                   9923:                 $absolutepath = $embed_file;
                   9924:             }
1.1147    raeburn  9925:             if ($cleaned_file =~ m{/}) {
                   9926:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  9927:                 $path = &check_for_traversal($path,$url,$toplevel);
                   9928:                 my $item = $fname;
                   9929:                 if ($path ne '') {
                   9930:                     $item = $path.'/'.$fname;
                   9931:                     $subdependencies{$path}{$fname} = 1;
                   9932:                 } else {
                   9933:                     $dependencies{$item} = 1;
                   9934:                 }
                   9935:                 if ($absolutepath) {
                   9936:                     $mapping{$item} = $absolutepath;
                   9937:                 } else {
                   9938:                     $mapping{$item} = $embed_file;
                   9939:                 }
                   9940:             } else {
                   9941:                 $dependencies{$embed_file} = 1;
                   9942:                 if ($absolutepath) {
1.1147    raeburn  9943:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  9944:                 } else {
1.1147    raeburn  9945:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  9946:                 }
                   9947:             }
1.984     raeburn  9948:         }
                   9949:     }
1.1071    raeburn  9950:     my $dirptr = 16384;
1.984     raeburn  9951:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  9952:         $currsubfile{$path} = {};
1.1123    raeburn  9953:         if (($actionurl eq '/adm/portfolio') || 
                   9954:             ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  9955:             my ($sublistref,$listerror) =
                   9956:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   9957:             if (ref($sublistref) eq 'ARRAY') {
                   9958:                 foreach my $line (@{$sublistref}) {
                   9959:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  9960:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  9961:                 }
1.984     raeburn  9962:             }
1.987     raeburn  9963:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9964:             if (opendir(my $dir,$url.'/'.$path)) {
                   9965:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  9966:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   9967:             }
1.1084    raeburn  9968:         } elsif (($actionurl eq '/adm/dependencies') ||
                   9969:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  9970:                   ($args->{'context'} eq 'paste')) ||
                   9971:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  9972:             if ($env{'request.course.id'} ne '') {
1.1123    raeburn  9973:                 my $dir;
                   9974:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9975:                     $dir = $fileloc;
                   9976:                 } else {
                   9977:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9978:                 }
1.1071    raeburn  9979:                 if ($dir ne '') {
                   9980:                     my ($sublistref,$listerror) =
                   9981:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   9982:                     if (ref($sublistref) eq 'ARRAY') {
                   9983:                         foreach my $line (@{$sublistref}) {
                   9984:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   9985:                                 undef,$mtime)=split(/\&/,$line,12);
                   9986:                             unless (($testdir&$dirptr) ||
                   9987:                                     ($file_name =~ /^\.\.?$/)) {
                   9988:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   9989:                             }
                   9990:                         }
                   9991:                     }
                   9992:                 }
1.984     raeburn  9993:             }
                   9994:         }
                   9995:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  9996:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  9997:                 my $item = $path.'/'.$file;
                   9998:                 unless ($mapping{$item} eq $item) {
                   9999:                     $pathchanges{$item} = 1;
                   10000:                 }
                   10001:                 $existing{$item} = 1;
                   10002:                 $numexisting ++;
                   10003:             } else {
                   10004:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  10005:             }
                   10006:         }
1.1071    raeburn  10007:         if ($actionurl eq '/adm/dependencies') {
                   10008:             foreach my $path (keys(%currsubfile)) {
                   10009:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   10010:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   10011:                          unless ($subdependencies{$path}{$file}) {
1.1085    raeburn  10012:                              next if (($rem ne '') &&
                   10013:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   10014:                                        (ref($navmap) &&
                   10015:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   10016:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10017:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  10018:                              $unused{$path.'/'.$file} = 1; 
                   10019:                          }
                   10020:                     }
                   10021:                 }
                   10022:             }
                   10023:         }
1.984     raeburn  10024:     }
1.987     raeburn  10025:     my %currfile;
1.1123    raeburn  10026:     if (($actionurl eq '/adm/portfolio') ||
                   10027:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  10028:         my ($dirlistref,$listerror) =
                   10029:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   10030:         if (ref($dirlistref) eq 'ARRAY') {
                   10031:             foreach my $line (@{$dirlistref}) {
                   10032:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   10033:                 $currfile{$file_name} = 1;
                   10034:             }
1.984     raeburn  10035:         }
1.987     raeburn  10036:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10037:         if (opendir(my $dir,$url)) {
1.987     raeburn  10038:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  10039:             map {$currfile{$_} = 1;} @dir_list;
                   10040:         }
1.1084    raeburn  10041:     } elsif (($actionurl eq '/adm/dependencies') ||
                   10042:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  10043:               ($args->{'context'} eq 'paste')) ||
                   10044:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10045:         if ($env{'request.course.id'} ne '') {
                   10046:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10047:             if ($dir ne '') {
                   10048:                 my ($dirlistref,$listerror) =
                   10049:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   10050:                 if (ref($dirlistref) eq 'ARRAY') {
                   10051:                     foreach my $line (@{$dirlistref}) {
                   10052:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   10053:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   10054:                         unless (($testdir&$dirptr) ||
                   10055:                                 ($file_name =~ /^\.\.?$/)) {
                   10056:                             $currfile{$file_name} = [$size,$mtime];
                   10057:                         }
                   10058:                     }
                   10059:                 }
                   10060:             }
                   10061:         }
1.984     raeburn  10062:     }
                   10063:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  10064:         if (exists($currfile{$file})) {
1.987     raeburn  10065:             unless ($mapping{$file} eq $file) {
                   10066:                 $pathchanges{$file} = 1;
                   10067:             }
                   10068:             $existing{$file} = 1;
                   10069:             $numexisting ++;
                   10070:         } else {
1.984     raeburn  10071:             $newfiles{$file} = 1;
                   10072:         }
                   10073:     }
1.1071    raeburn  10074:     foreach my $file (keys(%currfile)) {
                   10075:         unless (($file eq $filename) ||
                   10076:                 ($file eq $filename.'.bak') ||
                   10077:                 ($dependencies{$file})) {
1.1085    raeburn  10078:             if ($actionurl eq '/adm/dependencies') {
1.1126    raeburn  10079:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   10080:                     next if (($rem ne '') &&
                   10081:                              (($env{"httpref.$rem".$file} ne '') ||
                   10082:                               (ref($navmap) &&
                   10083:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   10084:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10085:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   10086:                 }
1.1085    raeburn  10087:             }
1.1071    raeburn  10088:             $unused{$file} = 1;
                   10089:         }
                   10090:     }
1.1084    raeburn  10091:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   10092:         ($args->{'context'} eq 'paste')) {
                   10093:         $counter = scalar(keys(%existing));
                   10094:         $numpathchg = scalar(keys(%pathchanges));
1.1123    raeburn  10095:         return ($output,$counter,$numpathchg,\%existing);
                   10096:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && 
                   10097:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   10098:         $counter = scalar(keys(%existing));
                   10099:         $numpathchg = scalar(keys(%pathchanges));
                   10100:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084    raeburn  10101:     }
1.984     raeburn  10102:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  10103:         if ($actionurl eq '/adm/dependencies') {
                   10104:             next if ($embed_file =~ m{^\w+://});
                   10105:         }
1.660     raeburn  10106:         $upload_output .= &start_data_table_row().
1.1123    raeburn  10107:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  10108:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  10109:         unless ($mapping{$embed_file} eq $embed_file) {
1.1123    raeburn  10110:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   10111:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  10112:         }
1.1123    raeburn  10113:         $upload_output .= '</td>';
1.1071    raeburn  10114:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1123    raeburn  10115:             $upload_output.='<td align="right">'.
                   10116:                             '<span class="LC_info LC_fontsize_medium">'.
                   10117:                             &mt("URL points to web address").'</span>';
1.987     raeburn  10118:             $numremref++;
1.660     raeburn  10119:         } elsif ($args->{'error_on_invalid_names'}
                   10120:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123    raeburn  10121:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   10122:                             &mt('Invalid characters').'</span>';
1.987     raeburn  10123:             $numinvalid++;
1.660     raeburn  10124:         } else {
1.1123    raeburn  10125:             $upload_output .= '<td>'.
                   10126:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  10127:                                                      $embed_file,\%mapping,
1.1071    raeburn  10128:                                                      $allfiles,$codebase,'upload');
                   10129:             $counter ++;
                   10130:             $numnew ++;
1.987     raeburn  10131:         }
                   10132:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   10133:     }
                   10134:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  10135:         if ($actionurl eq '/adm/dependencies') {
                   10136:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   10137:             $modify_output .= &start_data_table_row().
                   10138:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   10139:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   10140:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   10141:                               '<td>'.$size.'</td>'.
                   10142:                               '<td>'.$mtime.'</td>'.
                   10143:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   10144:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   10145:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   10146:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   10147:                               &embedded_file_element('upload_embedded',$counter,
                   10148:                                                      $embed_file,\%mapping,
                   10149:                                                      $allfiles,$codebase,'modify').
                   10150:                               '</div></td>'.
                   10151:                               &end_data_table_row()."\n";
                   10152:             $counter ++;
                   10153:         } else {
                   10154:             $upload_output .= &start_data_table_row().
1.1123    raeburn  10155:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   10156:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   10157:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  10158:                               &Apache::loncommon::end_data_table_row()."\n";
                   10159:         }
                   10160:     }
                   10161:     my $delidx = $counter;
                   10162:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   10163:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   10164:         $delete_output .= &start_data_table_row().
                   10165:                           '<td><img src="'.&icon($oldfile).'" />'.
                   10166:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   10167:                           '<td>'.$size.'</td>'.
                   10168:                           '<td>'.$mtime.'</td>'.
                   10169:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   10170:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   10171:                           &embedded_file_element('upload_embedded',$delidx,
                   10172:                                                  $oldfile,\%mapping,$allfiles,
                   10173:                                                  $codebase,'delete').'</td>'.
                   10174:                           &end_data_table_row()."\n"; 
                   10175:         $numunused ++;
                   10176:         $delidx ++;
1.987     raeburn  10177:     }
                   10178:     if ($upload_output) {
                   10179:         $upload_output = &start_data_table().
                   10180:                          $upload_output.
                   10181:                          &end_data_table()."\n";
                   10182:     }
1.1071    raeburn  10183:     if ($modify_output) {
                   10184:         $modify_output = &start_data_table().
                   10185:                          &start_data_table_header_row().
                   10186:                          '<th>'.&mt('File').'</th>'.
                   10187:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10188:                          '<th>'.&mt('Modified').'</th>'.
                   10189:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   10190:                          &end_data_table_header_row().
                   10191:                          $modify_output.
                   10192:                          &end_data_table()."\n";
                   10193:     }
                   10194:     if ($delete_output) {
                   10195:         $delete_output = &start_data_table().
                   10196:                          &start_data_table_header_row().
                   10197:                          '<th>'.&mt('File').'</th>'.
                   10198:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10199:                          '<th>'.&mt('Modified').'</th>'.
                   10200:                          '<th>'.&mt('Delete?').'</th>'.
                   10201:                          &end_data_table_header_row().
                   10202:                          $delete_output.
                   10203:                          &end_data_table()."\n";
                   10204:     }
1.987     raeburn  10205:     my $applies = 0;
                   10206:     if ($numremref) {
                   10207:         $applies ++;
                   10208:     }
                   10209:     if ($numinvalid) {
                   10210:         $applies ++;
                   10211:     }
                   10212:     if ($numexisting) {
                   10213:         $applies ++;
                   10214:     }
1.1071    raeburn  10215:     if ($counter || $numunused) {
1.987     raeburn  10216:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   10217:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  10218:                   $state.'<h3>'.$heading.'</h3>'; 
                   10219:         if ($actionurl eq '/adm/dependencies') {
                   10220:             if ($numnew) {
                   10221:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   10222:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   10223:                            $upload_output.'<br />'."\n";
                   10224:             }
                   10225:             if ($numexisting) {
                   10226:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   10227:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   10228:                            $modify_output.'<br />'."\n";
                   10229:                            $buttontext = &mt('Save changes');
                   10230:             }
                   10231:             if ($numunused) {
                   10232:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   10233:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   10234:                            $delete_output.'<br />'."\n";
                   10235:                            $buttontext = &mt('Save changes');
                   10236:             }
                   10237:         } else {
                   10238:             $output .= $upload_output.'<br />'."\n";
                   10239:         }
                   10240:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   10241:                    $counter.'" />'."\n";
                   10242:         if ($actionurl eq '/adm/dependencies') { 
                   10243:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   10244:                        $numnew.'" />'."\n";
                   10245:         } elsif ($actionurl eq '') {
1.987     raeburn  10246:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   10247:         }
                   10248:     } elsif ($applies) {
                   10249:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   10250:         if ($applies > 1) {
                   10251:             $output .=  
1.1123    raeburn  10252:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  10253:             if ($numremref) {
                   10254:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   10255:             }
                   10256:             if ($numinvalid) {
                   10257:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   10258:             }
                   10259:             if ($numexisting) {
                   10260:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   10261:             }
                   10262:             $output .= '</ul><br />';
                   10263:         } elsif ($numremref) {
                   10264:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   10265:         } elsif ($numinvalid) {
                   10266:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   10267:         } elsif ($numexisting) {
                   10268:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   10269:         }
                   10270:         $output .= $upload_output.'<br />';
                   10271:     }
                   10272:     my ($pathchange_output,$chgcount);
1.1071    raeburn  10273:     $chgcount = $counter;
1.987     raeburn  10274:     if (keys(%pathchanges) > 0) {
                   10275:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  10276:             if ($counter) {
1.987     raeburn  10277:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   10278:                                                   $embed_file,\%mapping,
1.1071    raeburn  10279:                                                   $allfiles,$codebase,'change');
1.987     raeburn  10280:             } else {
                   10281:                 $pathchange_output .= 
                   10282:                     &start_data_table_row().
                   10283:                     '<td><input type ="checkbox" name="namechange" value="'.
                   10284:                     $chgcount.'" checked="checked" /></td>'.
                   10285:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   10286:                     '<td>'.$embed_file.
                   10287:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  10288:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  10289:                     '</td>'.&end_data_table_row();
1.660     raeburn  10290:             }
1.987     raeburn  10291:             $numpathchg ++;
                   10292:             $chgcount ++;
1.660     raeburn  10293:         }
                   10294:     }
1.1127    raeburn  10295:     if (($counter) || ($numunused)) {
1.987     raeburn  10296:         if ($numpathchg) {
                   10297:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   10298:                        $numpathchg.'" />'."\n";
                   10299:         }
                   10300:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   10301:             ($actionurl eq '/adm/imsimport')) {
                   10302:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   10303:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   10304:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  10305:         } elsif ($actionurl eq '/adm/dependencies') {
                   10306:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  10307:         }
1.1123    raeburn  10308:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  10309:     } elsif ($numpathchg) {
                   10310:         my %pathchange = ();
                   10311:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   10312:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10313:             $output .= '<p>'.&mt('or').'</p>'; 
1.1123    raeburn  10314:         }
1.987     raeburn  10315:     }
1.1071    raeburn  10316:     return ($output,$counter,$numpathchg);
1.987     raeburn  10317: }
                   10318: 
1.1147    raeburn  10319: =pod
                   10320: 
                   10321: =item * clean_path($name)
                   10322: 
                   10323: Performs clean-up of directories, subdirectories and filename in an
                   10324: embedded object, referenced in an HTML file which is being uploaded
                   10325: to a course or portfolio, where 
                   10326: "Upload embedded images/multimedia files if HTML file" checkbox was
                   10327: checked.
                   10328: 
                   10329: Clean-up is similar to replacements in lonnet::clean_filename()
                   10330: except each / between sub-directory and next level is preserved.
                   10331: 
                   10332: =cut
                   10333: 
                   10334: sub clean_path {
                   10335:     my ($embed_file) = @_;
                   10336:     $embed_file =~s{^/+}{};
                   10337:     my @contents;
                   10338:     if ($embed_file =~ m{/}) {
                   10339:         @contents = split(/\//,$embed_file);
                   10340:     } else {
                   10341:         @contents = ($embed_file);
                   10342:     }
                   10343:     my $lastidx = scalar(@contents)-1;
                   10344:     for (my $i=0; $i<=$lastidx; $i++) { 
                   10345:         $contents[$i]=~s{\\}{/}g;
                   10346:         $contents[$i]=~s/\s+/\_/g;
                   10347:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   10348:         if ($i == $lastidx) {
                   10349:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   10350:         }
                   10351:     }
                   10352:     if ($lastidx > 0) {
                   10353:         return join('/',@contents);
                   10354:     } else {
                   10355:         return $contents[0];
                   10356:     }
                   10357: }
                   10358: 
1.987     raeburn  10359: sub embedded_file_element {
1.1071    raeburn  10360:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  10361:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   10362:                    (ref($codebase) eq 'HASH'));
                   10363:     my $output;
1.1071    raeburn  10364:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  10365:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   10366:     }
                   10367:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   10368:                &escape($embed_file).'" />';
                   10369:     unless (($context eq 'upload_embedded') && 
                   10370:             ($mapping->{$embed_file} eq $embed_file)) {
                   10371:         $output .='
                   10372:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   10373:     }
                   10374:     my $attrib;
                   10375:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   10376:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   10377:     }
                   10378:     $output .=
                   10379:         "\n\t\t".
                   10380:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   10381:         $attrib.'" />';
                   10382:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   10383:         $output .=
                   10384:             "\n\t\t".
                   10385:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   10386:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  10387:     }
1.987     raeburn  10388:     return $output;
1.660     raeburn  10389: }
                   10390: 
1.1071    raeburn  10391: sub get_dependency_details {
                   10392:     my ($currfile,$currsubfile,$embed_file) = @_;
                   10393:     my ($size,$mtime,$showsize,$showmtime);
                   10394:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   10395:         if ($embed_file =~ m{/}) {
                   10396:             my ($path,$fname) = split(/\//,$embed_file);
                   10397:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   10398:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   10399:             }
                   10400:         } else {
                   10401:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   10402:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   10403:             }
                   10404:         }
                   10405:         $showsize = $size/1024.0;
                   10406:         $showsize = sprintf("%.1f",$showsize);
                   10407:         if ($mtime > 0) {
                   10408:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   10409:         }
                   10410:     }
                   10411:     return ($showsize,$showmtime);
                   10412: }
                   10413: 
                   10414: sub ask_embedded_js {
                   10415:     return <<"END";
                   10416: <script type="text/javascript"">
                   10417: // <![CDATA[
                   10418: function toggleBrowse(counter) {
                   10419:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   10420:     var fileid = document.getElementById('embedded_item_'+counter);
                   10421:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   10422:     if (chkboxid.checked == true) {
                   10423:         uploaddivid.style.display='block';
                   10424:     } else {
                   10425:         uploaddivid.style.display='none';
                   10426:         fileid.value = '';
                   10427:     }
                   10428: }
                   10429: // ]]>
                   10430: </script>
                   10431: 
                   10432: END
                   10433: }
                   10434: 
1.661     raeburn  10435: sub upload_embedded {
                   10436:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  10437:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   10438:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  10439:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   10440:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   10441:         my $orig_uploaded_filename =
                   10442:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  10443:         foreach my $type ('orig','ref','attrib','codebase') {
                   10444:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   10445:                 $env{'form.embedded_'.$type.'_'.$i} =
                   10446:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   10447:             }
                   10448:         }
1.661     raeburn  10449:         my ($path,$fname) =
                   10450:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   10451:         # no path, whole string is fname
                   10452:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   10453:         $fname = &Apache::lonnet::clean_filename($fname);
                   10454:         # See if there is anything left
                   10455:         next if ($fname eq '');
                   10456: 
                   10457:         # Check if file already exists as a file or directory.
                   10458:         my ($state,$msg);
                   10459:         if ($context eq 'portfolio') {
                   10460:             my $port_path = $dirpath;
                   10461:             if ($group ne '') {
                   10462:                 $port_path = "groups/$group/$port_path";
                   10463:             }
1.987     raeburn  10464:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   10465:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  10466:                                               $dir_root,$port_path,$disk_quota,
                   10467:                                               $current_disk_usage,$uname,$udom);
                   10468:             if ($state eq 'will_exceed_quota'
1.984     raeburn  10469:                 || $state eq 'file_locked') {
1.661     raeburn  10470:                 $output .= $msg;
                   10471:                 next;
                   10472:             }
                   10473:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   10474:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   10475:             if ($state eq 'exists') {
                   10476:                 $output .= $msg;
                   10477:                 next;
                   10478:             }
                   10479:         }
                   10480:         # Check if extension is valid
                   10481:         if (($fname =~ /\.(\w+)$/) &&
                   10482:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155    bisitz   10483:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   10484:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  10485:             next;
                   10486:         } elsif (($fname =~ /\.(\w+)$/) &&
                   10487:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  10488:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  10489:             next;
                   10490:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120    bisitz   10491:             $output .= &mt('Filename not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'<br />';
1.661     raeburn  10492:             next;
                   10493:         }
                   10494:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123    raeburn  10495:         my $subdir = $path;
                   10496:         $subdir =~ s{/+$}{};
1.661     raeburn  10497:         if ($context eq 'portfolio') {
1.984     raeburn  10498:             my $result;
                   10499:             if ($state eq 'existingfile') {
                   10500:                 $result=
                   10501:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123    raeburn  10502:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  10503:             } else {
1.984     raeburn  10504:                 $result=
                   10505:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  10506:                                                     $dirpath.
1.1123    raeburn  10507:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  10508:                 if ($result !~ m|^/uploaded/|) {
                   10509:                     $output .= '<span class="LC_error">'
                   10510:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10511:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10512:                                .'</span><br />';
                   10513:                     next;
                   10514:                 } else {
1.987     raeburn  10515:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10516:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  10517:                 }
1.661     raeburn  10518:             }
1.1123    raeburn  10519:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126    raeburn  10520:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   10521:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  10522:             my $result =
1.1126    raeburn  10523:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  10524:             if ($result !~ m|^/uploaded/|) {
                   10525:                 $output .= '<span class="LC_error">'
                   10526:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10527:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10528:                            .'</span><br />';
                   10529:                     next;
                   10530:             } else {
                   10531:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10532:                            $path.$fname.'</span>').'<br />';
1.1125    raeburn  10533:                 if ($context eq 'syllabus') {
                   10534:                     &Apache::lonnet::make_public_indefinitely($result);
                   10535:                 }
1.987     raeburn  10536:             }
1.661     raeburn  10537:         } else {
                   10538: # Save the file
                   10539:             my $target = $env{'form.embedded_item_'.$i};
                   10540:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   10541:             my $dest = $fullpath.$fname;
                   10542:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  10543:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  10544:             my $count;
                   10545:             my $filepath = $dir_root;
1.1027    raeburn  10546:             foreach my $subdir (@parts) {
                   10547:                 $filepath .= "/$subdir";
                   10548:                 if (!-e $filepath) {
1.661     raeburn  10549:                     mkdir($filepath,0770);
                   10550:                 }
                   10551:             }
                   10552:             my $fh;
                   10553:             if (!open($fh,'>'.$dest)) {
                   10554:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   10555:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  10556:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   10557:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10558:                            '</span><br />';
                   10559:             } else {
                   10560:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   10561:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   10562:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  10563:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   10564:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10565:                               '</span><br />';
                   10566:                 } else {
1.987     raeburn  10567:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10568:                                $url.'</span>').'<br />';
                   10569:                     unless ($context eq 'testbank') {
                   10570:                         $footer .= &mt('View embedded file: [_1]',
                   10571:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   10572:                     }
                   10573:                 }
                   10574:                 close($fh);
                   10575:             }
                   10576:         }
                   10577:         if ($env{'form.embedded_ref_'.$i}) {
                   10578:             $pathchange{$i} = 1;
                   10579:         }
                   10580:     }
                   10581:     if ($output) {
                   10582:         $output = '<p>'.$output.'</p>';
                   10583:     }
                   10584:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   10585:     $returnflag = 'ok';
1.1071    raeburn  10586:     my $numpathchgs = scalar(keys(%pathchange));
                   10587:     if ($numpathchgs > 0) {
1.987     raeburn  10588:         if ($context eq 'portfolio') {
                   10589:             $output .= '<p>'.&mt('or').'</p>';
                   10590:         } elsif ($context eq 'testbank') {
1.1071    raeburn  10591:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   10592:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  10593:             $returnflag = 'modify_orightml';
                   10594:         }
                   10595:     }
1.1071    raeburn  10596:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  10597: }
                   10598: 
                   10599: sub modify_html_form {
                   10600:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   10601:     my $end = 0;
                   10602:     my $modifyform;
                   10603:     if ($context eq 'upload_embedded') {
                   10604:         return unless (ref($pathchange) eq 'HASH');
                   10605:         if ($env{'form.number_embedded_items'}) {
                   10606:             $end += $env{'form.number_embedded_items'};
                   10607:         }
                   10608:         if ($env{'form.number_pathchange_items'}) {
                   10609:             $end += $env{'form.number_pathchange_items'};
                   10610:         }
                   10611:         if ($end) {
                   10612:             for (my $i=0; $i<$end; $i++) {
                   10613:                 if ($i < $env{'form.number_embedded_items'}) {
                   10614:                     next unless($pathchange->{$i});
                   10615:                 }
                   10616:                 $modifyform .=
                   10617:                     &start_data_table_row().
                   10618:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   10619:                     'checked="checked" /></td>'.
                   10620:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   10621:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   10622:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   10623:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   10624:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   10625:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   10626:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   10627:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   10628:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   10629:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   10630:                     &end_data_table_row();
1.1071    raeburn  10631:             }
1.987     raeburn  10632:         }
                   10633:     } else {
                   10634:         $modifyform = $pathchgtable;
                   10635:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   10636:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   10637:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10638:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   10639:         }
                   10640:     }
                   10641:     if ($modifyform) {
1.1071    raeburn  10642:         if ($actionurl eq '/adm/dependencies') {
                   10643:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   10644:         }
1.987     raeburn  10645:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   10646:                '<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".
                   10647:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   10648:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   10649:                '</ol></p>'."\n".'<p>'.
                   10650:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   10651:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   10652:                &start_data_table()."\n".
                   10653:                &start_data_table_header_row().
                   10654:                '<th>'.&mt('Change?').'</th>'.
                   10655:                '<th>'.&mt('Current reference').'</th>'.
                   10656:                '<th>'.&mt('Required reference').'</th>'.
                   10657:                &end_data_table_header_row()."\n".
                   10658:                $modifyform.
                   10659:                &end_data_table().'<br />'."\n".$hiddenstate.
                   10660:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   10661:                '</form>'."\n";
                   10662:     }
                   10663:     return;
                   10664: }
                   10665: 
                   10666: sub modify_html_refs {
1.1123    raeburn  10667:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  10668:     my $container;
                   10669:     if ($context eq 'portfolio') {
                   10670:         $container = $env{'form.container'};
                   10671:     } elsif ($context eq 'coursedoc') {
                   10672:         $container = $env{'form.primaryurl'};
1.1071    raeburn  10673:     } elsif ($context eq 'manage_dependencies') {
                   10674:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   10675:         $container = "/$container";
1.1123    raeburn  10676:     } elsif ($context eq 'syllabus') {
                   10677:         $container = $url;
1.987     raeburn  10678:     } else {
1.1027    raeburn  10679:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  10680:     }
                   10681:     my (%allfiles,%codebase,$output,$content);
                   10682:     my @changes = &get_env_multiple('form.namechange');
1.1126    raeburn  10683:     unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071    raeburn  10684:         if (wantarray) {
                   10685:             return ('',0,0); 
                   10686:         } else {
                   10687:             return;
                   10688:         }
                   10689:     }
                   10690:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  10691:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  10692:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   10693:             if (wantarray) {
                   10694:                 return ('',0,0);
                   10695:             } else {
                   10696:                 return;
                   10697:             }
                   10698:         } 
1.987     raeburn  10699:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  10700:         if ($content eq '-1') {
                   10701:             if (wantarray) {
                   10702:                 return ('',0,0);
                   10703:             } else {
                   10704:                 return;
                   10705:             }
                   10706:         }
1.987     raeburn  10707:     } else {
1.1071    raeburn  10708:         unless ($container =~ /^\Q$dir_root\E/) {
                   10709:             if (wantarray) {
                   10710:                 return ('',0,0);
                   10711:             } else {
                   10712:                 return;
                   10713:             }
                   10714:         } 
1.987     raeburn  10715:         if (open(my $fh,"<$container")) {
                   10716:             $content = join('', <$fh>);
                   10717:             close($fh);
                   10718:         } else {
1.1071    raeburn  10719:             if (wantarray) {
                   10720:                 return ('',0,0);
                   10721:             } else {
                   10722:                 return;
                   10723:             }
1.987     raeburn  10724:         }
                   10725:     }
                   10726:     my ($count,$codebasecount) = (0,0);
                   10727:     my $mm = new File::MMagic;
                   10728:     my $mime_type = $mm->checktype_contents($content);
                   10729:     if ($mime_type eq 'text/html') {
                   10730:         my $parse_result = 
                   10731:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   10732:                                                     \%codebase,\$content);
                   10733:         if ($parse_result eq 'ok') {
                   10734:             foreach my $i (@changes) {
                   10735:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   10736:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   10737:                 if ($allfiles{$ref}) {
                   10738:                     my $newname =  $orig;
                   10739:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  10740:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  10741:                     if ($attrib_regexp =~ /:/) {
                   10742:                         $attrib_regexp =~ s/\:/|/g;
                   10743:                     }
                   10744:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10745:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10746:                         $count += $numchg;
1.1123    raeburn  10747:                         $allfiles{$newname} = $allfiles{$ref};
1.1148    raeburn  10748:                         delete($allfiles{$ref});
1.987     raeburn  10749:                     }
                   10750:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  10751:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  10752:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   10753:                         $codebasecount ++;
                   10754:                     }
                   10755:                 }
                   10756:             }
1.1123    raeburn  10757:             my $skiprewrites;
1.987     raeburn  10758:             if ($count || $codebasecount) {
                   10759:                 my $saveresult;
1.1071    raeburn  10760:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  10761:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  10762:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10763:                     if ($url eq $container) {
                   10764:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   10765:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10766:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  10767:                                             $fname.'</span>').'</p>';
1.987     raeburn  10768:                     } else {
                   10769:                          $output = '<p class="LC_error">'.
                   10770:                                    &mt('Error: update failed for: [_1].',
                   10771:                                    '<span class="LC_filename">'.
                   10772:                                    $container.'</span>').'</p>';
                   10773:                     }
1.1123    raeburn  10774:                     if ($context eq 'syllabus') {
                   10775:                         unless ($saveresult eq 'ok') {
                   10776:                             $skiprewrites = 1;
                   10777:                         }
                   10778:                     }
1.987     raeburn  10779:                 } else {
                   10780:                     if (open(my $fh,">$container")) {
                   10781:                         print $fh $content;
                   10782:                         close($fh);
                   10783:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10784:                                   $count,'<span class="LC_filename">'.
                   10785:                                   $container.'</span>').'</p>';
1.661     raeburn  10786:                     } else {
1.987     raeburn  10787:                          $output = '<p class="LC_error">'.
                   10788:                                    &mt('Error: could not update [_1].',
                   10789:                                    '<span class="LC_filename">'.
                   10790:                                    $container.'</span>').'</p>';
1.661     raeburn  10791:                     }
                   10792:                 }
                   10793:             }
1.1123    raeburn  10794:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   10795:                 my ($actionurl,$state);
                   10796:                 $actionurl = "/public/$udom/$uname/syllabus";
                   10797:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   10798:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   10799:                                               \%codebase,
                   10800:                                               {'context' => 'rewrites',
                   10801:                                                'ignore_remote_references' => 1,});
                   10802:                 if (ref($mapping) eq 'HASH') {
                   10803:                     my $rewrites = 0;
                   10804:                     foreach my $key (keys(%{$mapping})) {
                   10805:                         next if ($key =~ m{^https?://});
                   10806:                         my $ref = $mapping->{$key};
                   10807:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   10808:                         my $attrib;
                   10809:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   10810:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   10811:                         }
                   10812:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10813:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10814:                             $rewrites += $numchg;
                   10815:                         }
                   10816:                     }
                   10817:                     if ($rewrites) {
                   10818:                         my $saveresult; 
                   10819:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10820:                         if ($url eq $container) {
                   10821:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   10822:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   10823:                                             $count,'<span class="LC_filename">'.
                   10824:                                             $fname.'</span>').'</p>';
                   10825:                         } else {
                   10826:                             $output .= '<p class="LC_error">'.
                   10827:                                        &mt('Error: could not update links in [_1].',
                   10828:                                        '<span class="LC_filename">'.
                   10829:                                        $container.'</span>').'</p>';
                   10830: 
                   10831:                         }
                   10832:                     }
                   10833:                 }
                   10834:             }
1.987     raeburn  10835:         } else {
                   10836:             &logthis('Failed to parse '.$container.
                   10837:                      ' to modify references: '.$parse_result);
1.661     raeburn  10838:         }
                   10839:     }
1.1071    raeburn  10840:     if (wantarray) {
                   10841:         return ($output,$count,$codebasecount);
                   10842:     } else {
                   10843:         return $output;
                   10844:     }
1.661     raeburn  10845: }
                   10846: 
                   10847: sub check_for_existing {
                   10848:     my ($path,$fname,$element) = @_;
                   10849:     my ($state,$msg);
                   10850:     if (-d $path.'/'.$fname) {
                   10851:         $state = 'exists';
                   10852:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10853:     } elsif (-e $path.'/'.$fname) {
                   10854:         $state = 'exists';
                   10855:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10856:     }
                   10857:     if ($state eq 'exists') {
                   10858:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   10859:     }
                   10860:     return ($state,$msg);
                   10861: }
                   10862: 
                   10863: sub check_for_upload {
                   10864:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   10865:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  10866:     my $filesize = length($env{'form.'.$element});
                   10867:     if (!$filesize) {
                   10868:         my $msg = '<span class="LC_error">'.
                   10869:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   10870:                       '<span class="LC_filename">'.$fname.'</span>',
                   10871:                       $filesize).'<br />'.
1.1007    raeburn  10872:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  10873:                   '</span>';
                   10874:         return ('zero_bytes',$msg);
                   10875:     }
                   10876:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  10877:     my $getpropath = 1;
1.1021    raeburn  10878:     my ($dirlistref,$listerror) =
                   10879:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  10880:     my $found_file = 0;
                   10881:     my $locked_file = 0;
1.991     raeburn  10882:     my @lockers;
                   10883:     my $navmap;
                   10884:     if ($env{'request.course.id'}) {
                   10885:         $navmap = Apache::lonnavmaps::navmap->new();
                   10886:     }
1.1021    raeburn  10887:     if (ref($dirlistref) eq 'ARRAY') {
                   10888:         foreach my $line (@{$dirlistref}) {
                   10889:             my ($file_name,$rest)=split(/\&/,$line,2);
                   10890:             if ($file_name eq $fname){
                   10891:                 $file_name = $path.$file_name;
                   10892:                 if ($group ne '') {
                   10893:                     $file_name = $group.$file_name;
                   10894:                 }
                   10895:                 $found_file = 1;
                   10896:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   10897:                     foreach my $lock (@lockers) {
                   10898:                         if (ref($lock) eq 'ARRAY') {
                   10899:                             my ($symb,$crsid) = @{$lock};
                   10900:                             if ($crsid eq $env{'request.course.id'}) {
                   10901:                                 if (ref($navmap)) {
                   10902:                                     my $res = $navmap->getBySymb($symb);
                   10903:                                     foreach my $part (@{$res->parts()}) { 
                   10904:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   10905:                                         unless (($slot_status == $res->RESERVED) ||
                   10906:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   10907:                                             $locked_file = 1;
                   10908:                                         }
1.991     raeburn  10909:                                     }
1.1021    raeburn  10910:                                 } else {
                   10911:                                     $locked_file = 1;
1.991     raeburn  10912:                                 }
                   10913:                             } else {
                   10914:                                 $locked_file = 1;
                   10915:                             }
                   10916:                         }
1.1021    raeburn  10917:                    }
                   10918:                 } else {
                   10919:                     my @info = split(/\&/,$rest);
                   10920:                     my $currsize = $info[6]/1000;
                   10921:                     if ($currsize < $filesize) {
                   10922:                         my $extra = $filesize - $currsize;
                   10923:                         if (($current_disk_usage + $extra) > $disk_quota) {
1.1179    bisitz   10924:                             my $msg = '<p class="LC_warning">'.
1.1021    raeburn  10925:                                       &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',
1.1179    bisitz   10926:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                   10927:                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   10928:                                                    $disk_quota,$current_disk_usage).'</p>';
1.1021    raeburn  10929:                             return ('will_exceed_quota',$msg);
                   10930:                         }
1.984     raeburn  10931:                     }
                   10932:                 }
1.661     raeburn  10933:             }
                   10934:         }
                   10935:     }
                   10936:     if (($current_disk_usage + $filesize) > $disk_quota){
1.1179    bisitz   10937:         my $msg = '<p class="LC_warning">'.
                   10938:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.661     raeburn  10939:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   10940:         return ('will_exceed_quota',$msg);
                   10941:     } elsif ($found_file) {
                   10942:         if ($locked_file) {
1.1179    bisitz   10943:             my $msg = '<p class="LC_warning">';
1.661     raeburn  10944:             $msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>','<span class="LC_filename">'.$port_path.$env{'form.currentpath'}.'</span>');
1.1179    bisitz   10945:             $msg .= '</p>';
1.661     raeburn  10946:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   10947:             return ('file_locked',$msg);
                   10948:         } else {
1.1179    bisitz   10949:             my $msg = '<p class="LC_error">';
1.984     raeburn  10950:             $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.1179    bisitz   10951:             $msg .= '</p>';
1.984     raeburn  10952:             return ('existingfile',$msg);
1.661     raeburn  10953:         }
                   10954:     }
                   10955: }
                   10956: 
1.987     raeburn  10957: sub check_for_traversal {
                   10958:     my ($path,$url,$toplevel) = @_;
                   10959:     my @parts=split(/\//,$path);
                   10960:     my $cleanpath;
                   10961:     my $fullpath = $url;
                   10962:     for (my $i=0;$i<@parts;$i++) {
                   10963:         next if ($parts[$i] eq '.');
                   10964:         if ($parts[$i] eq '..') {
                   10965:             $fullpath =~ s{([^/]+/)$}{};
                   10966:         } else {
                   10967:             $fullpath .= $parts[$i].'/';
                   10968:         }
                   10969:     }
                   10970:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   10971:         $cleanpath = $1;
                   10972:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   10973:         my $curr_toprel = $1;
                   10974:         my @parts = split(/\//,$curr_toprel);
                   10975:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   10976:         my @urlparts = split(/\//,$url_toprel);
                   10977:         my $doubledots;
                   10978:         my $startdiff = -1;
                   10979:         for (my $i=0; $i<@urlparts; $i++) {
                   10980:             if ($startdiff == -1) {
                   10981:                 unless ($urlparts[$i] eq $parts[$i]) {
                   10982:                     $startdiff = $i;
                   10983:                     $doubledots .= '../';
                   10984:                 }
                   10985:             } else {
                   10986:                 $doubledots .= '../';
                   10987:             }
                   10988:         }
                   10989:         if ($startdiff > -1) {
                   10990:             $cleanpath = $doubledots;
                   10991:             for (my $i=$startdiff; $i<@parts; $i++) {
                   10992:                 $cleanpath .= $parts[$i].'/';
                   10993:             }
                   10994:         }
                   10995:     }
                   10996:     $cleanpath =~ s{(/)$}{};
                   10997:     return $cleanpath;
                   10998: }
1.31      albertel 10999: 
1.1053    raeburn  11000: sub is_archive_file {
                   11001:     my ($mimetype) = @_;
                   11002:     if (($mimetype eq 'application/octet-stream') ||
                   11003:         ($mimetype eq 'application/x-stuffit') ||
                   11004:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   11005:         return 1;
                   11006:     }
                   11007:     return;
                   11008: }
                   11009: 
                   11010: sub decompress_form {
1.1065    raeburn  11011:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  11012:     my %lt = &Apache::lonlocal::texthash (
                   11013:         this => 'This file is an archive file.',
1.1067    raeburn  11014:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  11015:         itsc => 'Its contents are as follows:',
1.1053    raeburn  11016:         youm => 'You may wish to extract its contents.',
                   11017:         extr => 'Extract contents',
1.1067    raeburn  11018:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   11019:         proa => 'Process automatically?',
1.1053    raeburn  11020:         yes  => 'Yes',
                   11021:         no   => 'No',
1.1067    raeburn  11022:         fold => 'Title for folder containing movie',
                   11023:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  11024:     );
1.1065    raeburn  11025:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  11026:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  11027:     my $info = &list_archive_contents($fileloc,\@paths);
                   11028:     if (@paths) {
                   11029:         foreach my $path (@paths) {
                   11030:             $path =~ s{^/}{};
1.1067    raeburn  11031:             if ($path =~ m{^([^/]+)/$}) {
                   11032:                 $topdir = $1;
                   11033:             }
1.1065    raeburn  11034:             if ($path =~ m{^([^/]+)/}) {
                   11035:                 $toplevel{$1} = $path;
                   11036:             } else {
                   11037:                 $toplevel{$path} = $path;
                   11038:             }
                   11039:         }
                   11040:     }
1.1067    raeburn  11041:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164    raeburn  11042:         my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067    raeburn  11043:                         "$topdir/media/",
                   11044:                         "$topdir/media/$topdir.mp4",
                   11045:                         "$topdir/media/FirstFrame.png",
                   11046:                         "$topdir/media/player.swf",
                   11047:                         "$topdir/media/swfobject.js",
                   11048:                         "$topdir/media/expressInstall.swf");
1.1164    raeburn  11049:         my @camtasia8 = ("$topdir/","$topdir/$topdir.html",
                   11050:                          "$topdir/$topdir.mp4",
                   11051:                          "$topdir/$topdir\_config.xml",
                   11052:                          "$topdir/$topdir\_controller.swf",
                   11053:                          "$topdir/$topdir\_embed.css",
                   11054:                          "$topdir/$topdir\_First_Frame.png",
                   11055:                          "$topdir/$topdir\_player.html",
                   11056:                          "$topdir/$topdir\_Thumbnails.png",
                   11057:                          "$topdir/playerProductInstall.swf",
                   11058:                          "$topdir/scripts/",
                   11059:                          "$topdir/scripts/config_xml.js",
                   11060:                          "$topdir/scripts/handlebars.js",
                   11061:                          "$topdir/scripts/jquery-1.7.1.min.js",
                   11062:                          "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                   11063:                          "$topdir/scripts/modernizr.js",
                   11064:                          "$topdir/scripts/player-min.js",
                   11065:                          "$topdir/scripts/swfobject.js",
                   11066:                          "$topdir/skins/",
                   11067:                          "$topdir/skins/configuration_express.xml",
                   11068:                          "$topdir/skins/express_show/",
                   11069:                          "$topdir/skins/express_show/player-min.css",
                   11070:                          "$topdir/skins/express_show/spritesheet.png");
                   11071:         my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067    raeburn  11072:         if (@diffs == 0) {
1.1164    raeburn  11073:             $is_camtasia = 6;
                   11074:         } else {
                   11075:             @diffs = &compare_arrays(\@paths,\@camtasia8);
                   11076:             if (@diffs == 0) {
                   11077:                 $is_camtasia = 8;
                   11078:             }
1.1067    raeburn  11079:         }
                   11080:     }
                   11081:     my $output;
                   11082:     if ($is_camtasia) {
                   11083:         $output = <<"ENDCAM";
                   11084: <script type="text/javascript" language="Javascript">
                   11085: // <![CDATA[
                   11086: 
                   11087: function camtasiaToggle() {
                   11088:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   11089:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164    raeburn  11090:             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067    raeburn  11091: 
                   11092:                 document.getElementById('camtasia_titles').style.display='block';
                   11093:             } else {
                   11094:                 document.getElementById('camtasia_titles').style.display='none';
                   11095:             }
                   11096:         }
                   11097:     }
                   11098:     return;
                   11099: }
                   11100: 
                   11101: // ]]>
                   11102: </script>
                   11103: <p>$lt{'camt'}</p>
                   11104: ENDCAM
1.1065    raeburn  11105:     } else {
1.1067    raeburn  11106:         $output = '<p>'.$lt{'this'};
                   11107:         if ($info eq '') {
                   11108:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   11109:         } else {
                   11110:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   11111:                        '<div><pre>'.$info.'</pre></div>';
                   11112:         }
1.1065    raeburn  11113:     }
1.1067    raeburn  11114:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  11115:     my $duplicates;
                   11116:     my $num = 0;
                   11117:     if (ref($dirlist) eq 'ARRAY') {
                   11118:         foreach my $item (@{$dirlist}) {
                   11119:             if (ref($item) eq 'ARRAY') {
                   11120:                 if (exists($toplevel{$item->[0]})) {
                   11121:                     $duplicates .= 
                   11122:                         &start_data_table_row().
                   11123:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11124:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   11125:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11126:                         'value="1" />'.&mt('Yes').'</label>'.
                   11127:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   11128:                         '<td>'.$item->[0].'</td>';
                   11129:                     if ($item->[2]) {
                   11130:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   11131:                     } else {
                   11132:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   11133:                     }
                   11134:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   11135:                                    '<td>'.
                   11136:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   11137:                                    '</td>'.
                   11138:                                    &end_data_table_row();
                   11139:                     $num ++;
                   11140:                 }
                   11141:             }
                   11142:         }
                   11143:     }
                   11144:     my $itemcount;
                   11145:     if (@paths > 0) {
                   11146:         $itemcount = scalar(@paths);
                   11147:     } else {
                   11148:         $itemcount = 1;
                   11149:     }
1.1067    raeburn  11150:     if ($is_camtasia) {
                   11151:         $output .= $lt{'auto'}.'<br />'.
                   11152:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164    raeburn  11153:                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067    raeburn  11154:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   11155:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   11156:                    $lt{'no'}.'</label></span><br />'.
                   11157:                    '<div id="camtasia_titles" style="display:block">'.
                   11158:                    &Apache::lonhtmlcommon::start_pick_box().
                   11159:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   11160:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   11161:                    &Apache::lonhtmlcommon::row_closure().
                   11162:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   11163:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   11164:                    &Apache::lonhtmlcommon::row_closure(1).
                   11165:                    &Apache::lonhtmlcommon::end_pick_box().
                   11166:                    '</div>';
                   11167:     }
1.1065    raeburn  11168:     $output .= 
                   11169:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  11170:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   11171:         "\n";
1.1065    raeburn  11172:     if ($duplicates ne '') {
                   11173:         $output .= '<p><span class="LC_warning">'.
                   11174:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   11175:                    &start_data_table().
                   11176:                    &start_data_table_header_row().
                   11177:                    '<th>'.&mt('Overwrite?').'</th>'.
                   11178:                    '<th>'.&mt('Name').'</th>'.
                   11179:                    '<th>'.&mt('Type').'</th>'.
                   11180:                    '<th>'.&mt('Size').'</th>'.
                   11181:                    '<th>'.&mt('Last modified').'</th>'.
                   11182:                    &end_data_table_header_row().
                   11183:                    $duplicates.
                   11184:                    &end_data_table().
                   11185:                    '</p>';
                   11186:     }
1.1067    raeburn  11187:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  11188:     if (ref($hiddenelements) eq 'HASH') {
                   11189:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   11190:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   11191:         }
                   11192:     }
                   11193:     $output .= <<"END";
1.1067    raeburn  11194: <br />
1.1053    raeburn  11195: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   11196: </form>
                   11197: $noextract
                   11198: END
                   11199:     return $output;
                   11200: }
                   11201: 
1.1065    raeburn  11202: sub decompression_utility {
                   11203:     my ($program) = @_;
                   11204:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   11205:     my $location;
                   11206:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   11207:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   11208:                          '/usr/sbin/') {
                   11209:             if (-x $dir.$program) {
                   11210:                 $location = $dir.$program;
                   11211:                 last;
                   11212:             }
                   11213:         }
                   11214:     }
                   11215:     return $location;
                   11216: }
                   11217: 
                   11218: sub list_archive_contents {
                   11219:     my ($file,$pathsref) = @_;
                   11220:     my (@cmd,$output);
                   11221:     my $needsregexp;
                   11222:     if ($file =~ /\.zip$/) {
                   11223:         @cmd = (&decompression_utility('unzip'),"-l");
                   11224:         $needsregexp = 1;
                   11225:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   11226:              ($file =~ /\.tgz$/)) {
                   11227:         @cmd = (&decompression_utility('tar'),"-ztf");
                   11228:     } elsif ($file =~ /\.tar\.bz2$/) {
                   11229:         @cmd = (&decompression_utility('tar'),"-jtf");
                   11230:     } elsif ($file =~ m|\.tar$|) {
                   11231:         @cmd = (&decompression_utility('tar'),"-tf");
                   11232:     }
                   11233:     if (@cmd) {
                   11234:         undef($!);
                   11235:         undef($@);
                   11236:         if (open(my $fh,"-|", @cmd, $file)) {
                   11237:             while (my $line = <$fh>) {
                   11238:                 $output .= $line;
                   11239:                 chomp($line);
                   11240:                 my $item;
                   11241:                 if ($needsregexp) {
                   11242:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   11243:                 } else {
                   11244:                     $item = $line;
                   11245:                 }
                   11246:                 if ($item ne '') {
                   11247:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   11248:                         push(@{$pathsref},$item);
                   11249:                     } 
                   11250:                 }
                   11251:             }
                   11252:             close($fh);
                   11253:         }
                   11254:     }
                   11255:     return $output;
                   11256: }
                   11257: 
1.1053    raeburn  11258: sub decompress_uploaded_file {
                   11259:     my ($file,$dir) = @_;
                   11260:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   11261:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   11262:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   11263:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   11264:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   11265:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   11266:     my $decompressed = $env{'cgi.decompressed'};
                   11267:     &Apache::lonnet::delenv('cgi.file');
                   11268:     &Apache::lonnet::delenv('cgi.dir');
                   11269:     &Apache::lonnet::delenv('cgi.decompressed');
                   11270:     return ($decompressed,$result);
                   11271: }
                   11272: 
1.1055    raeburn  11273: sub process_decompression {
                   11274:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   11275:     my ($dir,$error,$warning,$output);
1.1180    raeburn  11276:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120    bisitz   11277:         $error = &mt('Filename not a supported archive file type.').
                   11278:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  11279:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   11280:     } else {
                   11281:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11282:         if ($docuhome eq 'no_host') {
                   11283:             $error = &mt('Could not determine home server for course.');
                   11284:         } else {
                   11285:             my @ids=&Apache::lonnet::current_machine_ids();
                   11286:             my $currdir = "$dir_root/$destination";
                   11287:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11288:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   11289:                        "$dir_root/$destination";
                   11290:             } else {
                   11291:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   11292:                        "$dir_root/$docudom/$docuname/$destination";
                   11293:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   11294:                     $error = &mt('Archive file not found.');
                   11295:                 }
                   11296:             }
1.1065    raeburn  11297:             my (@to_overwrite,@to_skip);
                   11298:             if ($env{'form.archive_overwrite_total'} > 0) {
                   11299:                 my $total = $env{'form.archive_overwrite_total'};
                   11300:                 for (my $i=0; $i<$total; $i++) {
                   11301:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   11302:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   11303:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   11304:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   11305:                     }
                   11306:                 }
                   11307:             }
                   11308:             my $numskip = scalar(@to_skip);
                   11309:             if (($numskip > 0) && 
                   11310:                 ($numskip == $env{'form.archive_itemcount'})) {
                   11311:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   11312:             } elsif ($dir eq '') {
1.1055    raeburn  11313:                 $error = &mt('Directory containing archive file unavailable.');
                   11314:             } elsif (!$error) {
1.1065    raeburn  11315:                 my ($decompressed,$display);
                   11316:                 if ($numskip > 0) {
                   11317:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   11318:                     mkdir("$dir/$tempdir",0755);
                   11319:                     system("mv $dir/$file $dir/$tempdir/$file");
                   11320:                     ($decompressed,$display) = 
                   11321:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   11322:                     foreach my $item (@to_skip) {
                   11323:                         if (($item ne '') && ($item !~ /\.\./)) {
                   11324:                             if (-f "$dir/$tempdir/$item") { 
                   11325:                                 unlink("$dir/$tempdir/$item");
                   11326:                             } elsif (-d "$dir/$tempdir/$item") {
                   11327:                                 system("rm -rf $dir/$tempdir/$item");
                   11328:                             }
                   11329:                         }
                   11330:                     }
                   11331:                     system("mv $dir/$tempdir/* $dir");
                   11332:                     rmdir("$dir/$tempdir");   
                   11333:                 } else {
                   11334:                     ($decompressed,$display) = 
                   11335:                         &decompress_uploaded_file($file,$dir);
                   11336:                 }
1.1055    raeburn  11337:                 if ($decompressed eq 'ok') {
1.1065    raeburn  11338:                     $output = '<p class="LC_info">'.
                   11339:                               &mt('Files extracted successfully from archive.').
                   11340:                               '</p>'."\n";
1.1055    raeburn  11341:                     my ($warning,$result,@contents);
                   11342:                     my ($newdirlistref,$newlisterror) =
                   11343:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   11344:                                                  $docuname,1);
                   11345:                     my (%is_dir,%changes,@newitems);
                   11346:                     my $dirptr = 16384;
1.1065    raeburn  11347:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  11348:                         foreach my $dir_line (@{$newdirlistref}) {
                   11349:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  11350:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   11351:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  11352:                                 push(@newitems,$item);
                   11353:                                 if ($dirptr&$testdir) {
                   11354:                                     $is_dir{$item} = 1;
                   11355:                                 }
                   11356:                                 $changes{$item} = 1;
                   11357:                             }
                   11358:                         }
                   11359:                     }
                   11360:                     if (keys(%changes) > 0) {
                   11361:                         foreach my $item (sort(@newitems)) {
                   11362:                             if ($changes{$item}) {
                   11363:                                 push(@contents,$item);
                   11364:                             }
                   11365:                         }
                   11366:                     }
                   11367:                     if (@contents > 0) {
1.1067    raeburn  11368:                         my $wantform;
                   11369:                         unless ($env{'form.autoextract_camtasia'}) {
                   11370:                             $wantform = 1;
                   11371:                         }
1.1056    raeburn  11372:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  11373:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   11374:                                                                 $currdir,\%is_dir,
                   11375:                                                                 \%children,\%parent,
1.1056    raeburn  11376:                                                                 \@contents,\%dirorder,
                   11377:                                                                 \%titles,$wantform);
1.1055    raeburn  11378:                         if ($datatable ne '') {
                   11379:                             $output .= &archive_options_form('decompressed',$datatable,
                   11380:                                                              $count,$hiddenelem);
1.1065    raeburn  11381:                             my $startcount = 6;
1.1055    raeburn  11382:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  11383:                                                            \%titles,\%children);
1.1055    raeburn  11384:                         }
1.1067    raeburn  11385:                         if ($env{'form.autoextract_camtasia'}) {
1.1164    raeburn  11386:                             my $version = $env{'form.autoextract_camtasia'};
1.1067    raeburn  11387:                             my %displayed;
                   11388:                             my $total = 1;
                   11389:                             $env{'form.archive_directory'} = [];
                   11390:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   11391:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   11392:                                 $path =~ s{/$}{};
                   11393:                                 my $item;
                   11394:                                 if ($path ne '') {
                   11395:                                     $item = "$path/$titles{$i}";
                   11396:                                 } else {
                   11397:                                     $item = $titles{$i};
                   11398:                                 }
                   11399:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   11400:                                 if ($item eq $contents[0]) {
                   11401:                                     push(@{$env{'form.archive_directory'}},$i);
                   11402:                                     $env{'form.archive_'.$i} = 'display';
                   11403:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   11404:                                     $displayed{'folder'} = $i;
1.1164    raeburn  11405:                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                   11406:                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { 
1.1067    raeburn  11407:                                     $env{'form.archive_'.$i} = 'display';
                   11408:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   11409:                                     $displayed{'web'} = $i;
                   11410:                                 } else {
1.1164    raeburn  11411:                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                   11412:                                         ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                   11413:                                              ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067    raeburn  11414:                                         push(@{$env{'form.archive_directory'}},$i);
                   11415:                                     }
                   11416:                                     $env{'form.archive_'.$i} = 'dependency';
                   11417:                                 }
                   11418:                                 $total ++;
                   11419:                             }
                   11420:                             for (my $i=1; $i<$total; $i++) {
                   11421:                                 next if ($i == $displayed{'web'});
                   11422:                                 next if ($i == $displayed{'folder'});
                   11423:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   11424:                             }
                   11425:                             $env{'form.phase'} = 'decompress_cleanup';
                   11426:                             $env{'form.archivedelete'} = 1;
                   11427:                             $env{'form.archive_count'} = $total-1;
                   11428:                             $output .=
                   11429:                                 &process_extracted_files('coursedocs',$docudom,
                   11430:                                                          $docuname,$destination,
                   11431:                                                          $dir_root,$hiddenelem);
                   11432:                         }
1.1055    raeburn  11433:                     } else {
                   11434:                         $warning = &mt('No new items extracted from archive file.');
                   11435:                     }
                   11436:                 } else {
                   11437:                     $output = $display;
                   11438:                     $error = &mt('An error occurred during extraction from the archive file.');
                   11439:                 }
                   11440:             }
                   11441:         }
                   11442:     }
                   11443:     if ($error) {
                   11444:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11445:                    $error.'</p>'."\n";
                   11446:     }
                   11447:     if ($warning) {
                   11448:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11449:     }
                   11450:     return $output;
                   11451: }
                   11452: 
                   11453: sub get_extracted {
1.1056    raeburn  11454:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   11455:         $titles,$wantform) = @_;
1.1055    raeburn  11456:     my $count = 0;
                   11457:     my $depth = 0;
                   11458:     my $datatable;
1.1056    raeburn  11459:     my @hierarchy;
1.1055    raeburn  11460:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  11461:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   11462:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  11463:     foreach my $item (@{$contents}) {
                   11464:         $count ++;
1.1056    raeburn  11465:         @{$dirorder->{$count}} = @hierarchy;
                   11466:         $titles->{$count} = $item;
1.1055    raeburn  11467:         &archive_hierarchy($depth,$count,$parent,$children);
                   11468:         if ($wantform) {
                   11469:             $datatable .= &archive_row($is_dir->{$item},$item,
                   11470:                                        $currdir,$depth,$count);
                   11471:         }
                   11472:         if ($is_dir->{$item}) {
                   11473:             $depth ++;
1.1056    raeburn  11474:             push(@hierarchy,$count);
                   11475:             $parent->{$depth} = $count;
1.1055    raeburn  11476:             $datatable .=
                   11477:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  11478:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   11479:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  11480:             $depth --;
1.1056    raeburn  11481:             pop(@hierarchy);
1.1055    raeburn  11482:         }
                   11483:     }
                   11484:     return ($count,$datatable);
                   11485: }
                   11486: 
                   11487: sub recurse_extracted_archive {
1.1056    raeburn  11488:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   11489:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  11490:     my $result='';
1.1056    raeburn  11491:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   11492:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   11493:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  11494:         return $result;
                   11495:     }
                   11496:     my $dirptr = 16384;
                   11497:     my ($newdirlistref,$newlisterror) =
                   11498:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   11499:     if (ref($newdirlistref) eq 'ARRAY') {
                   11500:         foreach my $dir_line (@{$newdirlistref}) {
                   11501:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   11502:             unless ($item =~ /^\.+$/) {
                   11503:                 $$count ++;
1.1056    raeburn  11504:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   11505:                 $titles->{$$count} = $item;
1.1055    raeburn  11506:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  11507: 
1.1055    raeburn  11508:                 my $is_dir;
                   11509:                 if ($dirptr&$testdir) {
                   11510:                     $is_dir = 1;
                   11511:                 }
                   11512:                 if ($wantform) {
                   11513:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   11514:                 }
                   11515:                 if ($is_dir) {
                   11516:                     $$depth ++;
1.1056    raeburn  11517:                     push(@{$hierarchy},$$count);
                   11518:                     $parent->{$$depth} = $$count;
1.1055    raeburn  11519:                     $result .=
                   11520:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   11521:                                                    $docuname,$depth,$count,
1.1056    raeburn  11522:                                                    $hierarchy,$dirorder,$children,
                   11523:                                                    $parent,$titles,$wantform);
1.1055    raeburn  11524:                     $$depth --;
1.1056    raeburn  11525:                     pop(@{$hierarchy});
1.1055    raeburn  11526:                 }
                   11527:             }
                   11528:         }
                   11529:     }
                   11530:     return $result;
                   11531: }
                   11532: 
                   11533: sub archive_hierarchy {
                   11534:     my ($depth,$count,$parent,$children) =@_;
                   11535:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   11536:         if (exists($parent->{$depth})) {
                   11537:              $children->{$parent->{$depth}} .= $count.':';
                   11538:         }
                   11539:     }
                   11540:     return;
                   11541: }
                   11542: 
                   11543: sub archive_row {
                   11544:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   11545:     my ($name) = ($item =~ m{([^/]+)$});
                   11546:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  11547:                                        'display'    => 'Add as file',
1.1055    raeburn  11548:                                        'dependency' => 'Include as dependency',
                   11549:                                        'discard'    => 'Discard',
                   11550:                                       );
                   11551:     if ($is_dir) {
1.1059    raeburn  11552:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  11553:     }
1.1056    raeburn  11554:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   11555:     my $offset = 0;
1.1055    raeburn  11556:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  11557:         $offset ++;
1.1065    raeburn  11558:         if ($action ne 'display') {
                   11559:             $offset ++;
                   11560:         }  
1.1055    raeburn  11561:         $output .= '<td><span class="LC_nobreak">'.
                   11562:                    '<label><input type="radio" name="archive_'.$count.
                   11563:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   11564:         my $text = $choices{$action};
                   11565:         if ($is_dir) {
                   11566:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   11567:             if ($action eq 'display') {
1.1059    raeburn  11568:                 $text = &mt('Add as folder');
1.1055    raeburn  11569:             }
1.1056    raeburn  11570:         } else {
                   11571:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   11572: 
                   11573:         }
                   11574:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   11575:         if ($action eq 'dependency') {
                   11576:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   11577:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   11578:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   11579:                        '<option value=""></option>'."\n".
                   11580:                        '</select>'."\n".
                   11581:                        '</div>';
1.1059    raeburn  11582:         } elsif ($action eq 'display') {
                   11583:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   11584:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   11585:                        '</div>';
1.1055    raeburn  11586:         }
1.1056    raeburn  11587:         $output .= '</td>';
1.1055    raeburn  11588:     }
                   11589:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   11590:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   11591:     for (my $i=0; $i<$depth; $i++) {
                   11592:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   11593:     }
                   11594:     if ($is_dir) {
                   11595:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   11596:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   11597:     } else {
                   11598:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   11599:     }
                   11600:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   11601:                &end_data_table_row();
                   11602:     return $output;
                   11603: }
                   11604: 
                   11605: sub archive_options_form {
1.1065    raeburn  11606:     my ($form,$display,$count,$hiddenelem) = @_;
                   11607:     my %lt = &Apache::lonlocal::texthash(
                   11608:                perm => 'Permanently remove archive file?',
                   11609:                hows => 'How should each extracted item be incorporated in the course?',
                   11610:                cont => 'Content actions for all',
                   11611:                addf => 'Add as folder/file',
                   11612:                incd => 'Include as dependency for a displayed file',
                   11613:                disc => 'Discard',
                   11614:                no   => 'No',
                   11615:                yes  => 'Yes',
                   11616:                save => 'Save',
                   11617:     );
                   11618:     my $output = <<"END";
                   11619: <form name="$form" method="post" action="">
                   11620: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   11621: <label>
                   11622:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   11623: </label>
                   11624: &nbsp;
                   11625: <label>
                   11626:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   11627: </span>
                   11628: </p>
                   11629: <input type="hidden" name="phase" value="decompress_cleanup" />
                   11630: <br />$lt{'hows'}
                   11631: <div class="LC_columnSection">
                   11632:   <fieldset>
                   11633:     <legend>$lt{'cont'}</legend>
                   11634:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   11635:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   11636:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   11637:   </fieldset>
                   11638: </div>
                   11639: END
                   11640:     return $output.
1.1055    raeburn  11641:            &start_data_table()."\n".
1.1065    raeburn  11642:            $display."\n".
1.1055    raeburn  11643:            &end_data_table()."\n".
                   11644:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   11645:            $hiddenelem.
1.1065    raeburn  11646:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  11647:            '</form>';
                   11648: }
                   11649: 
                   11650: sub archive_javascript {
1.1056    raeburn  11651:     my ($startcount,$numitems,$titles,$children) = @_;
                   11652:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  11653:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  11654:     my $scripttag = <<START;
                   11655: <script type="text/javascript">
                   11656: // <![CDATA[
                   11657: 
                   11658: function checkAll(form,prefix) {
                   11659:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   11660:     for (var i=0; i < form.elements.length; i++) {
                   11661:         var id = form.elements[i].id;
                   11662:         if ((id != '') && (id != undefined)) {
                   11663:             if (idstr.test(id)) {
                   11664:                 if (form.elements[i].type == 'radio') {
                   11665:                     form.elements[i].checked = true;
1.1056    raeburn  11666:                     var nostart = i-$startcount;
1.1059    raeburn  11667:                     var offset = nostart%7;
                   11668:                     var count = (nostart-offset)/7;    
1.1056    raeburn  11669:                     dependencyCheck(form,count,offset);
1.1055    raeburn  11670:                 }
                   11671:             }
                   11672:         }
                   11673:     }
                   11674: }
                   11675: 
                   11676: function propagateCheck(form,count) {
                   11677:     if (count > 0) {
1.1059    raeburn  11678:         var startelement = $startcount + ((count-1) * 7);
                   11679:         for (var j=1; j<6; j++) {
                   11680:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  11681:                 var item = startelement + j; 
                   11682:                 if (form.elements[item].type == 'radio') {
                   11683:                     if (form.elements[item].checked) {
                   11684:                         containerCheck(form,count,j);
                   11685:                         break;
                   11686:                     }
1.1055    raeburn  11687:                 }
                   11688:             }
                   11689:         }
                   11690:     }
                   11691: }
                   11692: 
                   11693: numitems = $numitems
1.1056    raeburn  11694: var titles = new Array(numitems);
                   11695: var parents = new Array(numitems);
1.1055    raeburn  11696: for (var i=0; i<numitems; i++) {
1.1056    raeburn  11697:     parents[i] = new Array;
1.1055    raeburn  11698: }
1.1059    raeburn  11699: var maintitle = '$maintitle';
1.1055    raeburn  11700: 
                   11701: START
                   11702: 
1.1056    raeburn  11703:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   11704:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  11705:         for (my $i=0; $i<@contents; $i ++) {
                   11706:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   11707:         }
                   11708:     }
                   11709: 
1.1056    raeburn  11710:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   11711:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   11712:     }
                   11713: 
1.1055    raeburn  11714:     $scripttag .= <<END;
                   11715: 
                   11716: function containerCheck(form,count,offset) {
                   11717:     if (count > 0) {
1.1056    raeburn  11718:         dependencyCheck(form,count,offset);
1.1059    raeburn  11719:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  11720:         form.elements[item].checked = true;
                   11721:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11722:             if (parents[count].length > 0) {
                   11723:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  11724:                     containerCheck(form,parents[count][j],offset);
                   11725:                 }
                   11726:             }
                   11727:         }
                   11728:     }
                   11729: }
                   11730: 
                   11731: function dependencyCheck(form,count,offset) {
                   11732:     if (count > 0) {
1.1059    raeburn  11733:         var chosen = (offset+$startcount)+7*(count-1);
                   11734:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  11735:         var currtype = form.elements[depitem].type;
                   11736:         if (form.elements[chosen].value == 'dependency') {
                   11737:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   11738:             form.elements[depitem].options.length = 0;
                   11739:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085    raeburn  11740:             for (var i=1; i<=numitems; i++) {
                   11741:                 if (i == count) {
                   11742:                     continue;
                   11743:                 }
1.1059    raeburn  11744:                 var startelement = $startcount + (i-1) * 7;
                   11745:                 for (var j=1; j<6; j++) {
                   11746:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  11747:                         var item = startelement + j;
                   11748:                         if (form.elements[item].type == 'radio') {
                   11749:                             if (form.elements[item].checked) {
                   11750:                                 if (form.elements[item].value == 'display') {
                   11751:                                     var n = form.elements[depitem].options.length;
                   11752:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   11753:                                 }
                   11754:                             }
                   11755:                         }
                   11756:                     }
                   11757:                 }
                   11758:             }
                   11759:         } else {
                   11760:             document.getElementById('arc_depon_'+count).style.display='none';
                   11761:             form.elements[depitem].options.length = 0;
                   11762:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   11763:         }
1.1059    raeburn  11764:         titleCheck(form,count,offset);
1.1056    raeburn  11765:     }
                   11766: }
                   11767: 
                   11768: function propagateSelect(form,count,offset) {
                   11769:     if (count > 0) {
1.1065    raeburn  11770:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  11771:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   11772:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11773:             if (parents[count].length > 0) {
                   11774:                 for (var j=0; j<parents[count].length; j++) {
                   11775:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  11776:                 }
                   11777:             }
                   11778:         }
                   11779:     }
                   11780: }
1.1056    raeburn  11781: 
                   11782: function containerSelect(form,count,offset,picked) {
                   11783:     if (count > 0) {
1.1065    raeburn  11784:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  11785:         if (form.elements[item].type == 'radio') {
                   11786:             if (form.elements[item].value == 'dependency') {
                   11787:                 if (form.elements[item+1].type == 'select-one') {
                   11788:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   11789:                         if (form.elements[item+1].options[i].value == picked) {
                   11790:                             form.elements[item+1].selectedIndex = i;
                   11791:                             break;
                   11792:                         }
                   11793:                     }
                   11794:                 }
                   11795:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11796:                     if (parents[count].length > 0) {
                   11797:                         for (var j=0; j<parents[count].length; j++) {
                   11798:                             containerSelect(form,parents[count][j],offset,picked);
                   11799:                         }
                   11800:                     }
                   11801:                 }
                   11802:             }
                   11803:         }
                   11804:     }
                   11805: }
                   11806: 
1.1059    raeburn  11807: function titleCheck(form,count,offset) {
                   11808:     if (count > 0) {
                   11809:         var chosen = (offset+$startcount)+7*(count-1);
                   11810:         var depitem = $startcount + ((count-1) * 7) + 2;
                   11811:         var currtype = form.elements[depitem].type;
                   11812:         if (form.elements[chosen].value == 'display') {
                   11813:             document.getElementById('arc_title_'+count).style.display='block';
                   11814:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   11815:                 document.getElementById('archive_title_'+count).value=maintitle;
                   11816:             }
                   11817:         } else {
                   11818:             document.getElementById('arc_title_'+count).style.display='none';
                   11819:             if (currtype == 'text') { 
                   11820:                 document.getElementById('archive_title_'+count).value='';
                   11821:             }
                   11822:         }
                   11823:     }
                   11824:     return;
                   11825: }
                   11826: 
1.1055    raeburn  11827: // ]]>
                   11828: </script>
                   11829: END
                   11830:     return $scripttag;
                   11831: }
                   11832: 
                   11833: sub process_extracted_files {
1.1067    raeburn  11834:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  11835:     my $numitems = $env{'form.archive_count'};
                   11836:     return unless ($numitems);
                   11837:     my @ids=&Apache::lonnet::current_machine_ids();
                   11838:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  11839:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  11840:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11841:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11842:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   11843:         $pathtocheck = "$dir_root/$destination";
                   11844:         $dir = $dir_root;
                   11845:         $ishome = 1;
                   11846:     } else {
                   11847:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   11848:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   11849:         $dir = "$dir_root/$docudom/$docuname";    
                   11850:     }
                   11851:     my $currdir = "$dir_root/$destination";
                   11852:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   11853:     if ($env{'form.folderpath'}) {
                   11854:         my @items = split('&',$env{'form.folderpath'});
                   11855:         $folders{'0'} = $items[-2];
1.1099    raeburn  11856:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   11857:             $containers{'0'}='page';
                   11858:         } else {  
                   11859:             $containers{'0'}='sequence';
                   11860:         }
1.1055    raeburn  11861:     }
                   11862:     my @archdirs = &get_env_multiple('form.archive_directory');
                   11863:     if ($numitems) {
                   11864:         for (my $i=1; $i<=$numitems; $i++) {
                   11865:             my $path = $env{'form.archive_content_'.$i};
                   11866:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   11867:                 my $item = $1;
                   11868:                 $toplevelitems{$item} = $i;
                   11869:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   11870:                     $is_dir{$item} = 1;
                   11871:                 }
                   11872:             }
                   11873:         }
                   11874:     }
1.1067    raeburn  11875:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  11876:     if (keys(%toplevelitems) > 0) {
                   11877:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  11878:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   11879:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  11880:     }
1.1066    raeburn  11881:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  11882:     if ($numitems) {
                   11883:         for (my $i=1; $i<=$numitems; $i++) {
1.1086    raeburn  11884:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  11885:             my $path = $env{'form.archive_content_'.$i};
                   11886:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11887:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   11888:                     if ($prefix ne '' && $path ne '') {
                   11889:                         if (-e $prefix.$path) {
1.1066    raeburn  11890:                             if ((@archdirs > 0) && 
                   11891:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   11892:                                 $todeletedir{$prefix.$path} = 1;
                   11893:                             } else {
                   11894:                                 $todelete{$prefix.$path} = 1;
                   11895:                             }
1.1055    raeburn  11896:                         }
                   11897:                     }
                   11898:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  11899:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  11900:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  11901:                     $docstitle = $env{'form.archive_title_'.$i};
                   11902:                     if ($docstitle eq '') {
                   11903:                         $docstitle = $title;
                   11904:                     }
1.1055    raeburn  11905:                     $outer = 0;
1.1056    raeburn  11906:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11907:                         if (@{$dirorder{$i}} > 0) {
                   11908:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  11909:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   11910:                                     $outer = $item;
                   11911:                                     last;
                   11912:                                 }
                   11913:                             }
                   11914:                         }
                   11915:                     }
                   11916:                     my ($errtext,$fatal) = 
                   11917:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   11918:                                                '/'.$folders{$outer}.'.'.
                   11919:                                                $containers{$outer});
                   11920:                     next if ($fatal);
                   11921:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   11922:                         if ($context eq 'coursedocs') {
1.1056    raeburn  11923:                             $mapinner{$i} = time;
1.1055    raeburn  11924:                             $folders{$i} = 'default_'.$mapinner{$i};
                   11925:                             $containers{$i} = 'sequence';
                   11926:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11927:                                       $folders{$i}.'.'.$containers{$i};
                   11928:                             my $newidx = &LONCAPA::map::getresidx();
                   11929:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11930:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11931:                             push(@LONCAPA::map::order,$newidx);
                   11932:                             my ($outtext,$errtext) =
                   11933:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11934:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  11935:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  11936:                             $newseqid{$i} = $newidx;
1.1067    raeburn  11937:                             unless ($errtext) {
                   11938:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   11939:                             }
1.1055    raeburn  11940:                         }
                   11941:                     } else {
                   11942:                         if ($context eq 'coursedocs') {
                   11943:                             my $newidx=&LONCAPA::map::getresidx();
                   11944:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11945:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   11946:                                       $title;
                   11947:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   11948:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   11949:                             }
                   11950:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11951:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   11952:                             }
                   11953:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11954:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  11955:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  11956:                                 unless ($ishome) {
                   11957:                                     my $fetch = "$newdest{$i}/$title";
                   11958:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   11959:                                     $prompttofetch{$fetch} = 1;
                   11960:                                 }
1.1055    raeburn  11961:                             }
                   11962:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11963:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11964:                             push(@LONCAPA::map::order, $newidx);
                   11965:                             my ($outtext,$errtext)=
                   11966:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11967:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  11968:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  11969:                             unless ($errtext) {
                   11970:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   11971:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   11972:                                 }
                   11973:                             }
1.1055    raeburn  11974:                         }
                   11975:                     }
1.1086    raeburn  11976:                 }
                   11977:             } else {
                   11978:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   11979:             }
                   11980:         }
                   11981:         for (my $i=1; $i<=$numitems; $i++) {
                   11982:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   11983:             my $path = $env{'form.archive_content_'.$i};
                   11984:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11985:                 my ($title) = ($path =~ m{/([^/]+)$});
                   11986:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   11987:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   11988:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11989:                         my ($itemidx,$fullpath,$relpath);
                   11990:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   11991:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  11992:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086    raeburn  11993:                                 if ($dirorder{$i}->[$j] eq $container) {
                   11994:                                     $itemidx = $j;
1.1056    raeburn  11995:                                 }
                   11996:                             }
1.1086    raeburn  11997:                         }
                   11998:                         if ($itemidx eq '') {
                   11999:                             $itemidx =  0;
                   12000:                         } 
                   12001:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   12002:                             if ($mapinner{$referrer{$i}}) {
                   12003:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   12004:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12005:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12006:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12007:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12008:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12009:                                             if (!-e $fullpath) {
                   12010:                                                 mkdir($fullpath,0755);
1.1056    raeburn  12011:                                             }
                   12012:                                         }
1.1086    raeburn  12013:                                     } else {
                   12014:                                         last;
1.1056    raeburn  12015:                                     }
1.1086    raeburn  12016:                                 }
                   12017:                             }
                   12018:                         } elsif ($newdest{$referrer{$i}}) {
                   12019:                             $fullpath = $newdest{$referrer{$i}};
                   12020:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12021:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   12022:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   12023:                                     last;
                   12024:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12025:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12026:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12027:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12028:                                         if (!-e $fullpath) {
                   12029:                                             mkdir($fullpath,0755);
1.1056    raeburn  12030:                                         }
                   12031:                                     }
1.1086    raeburn  12032:                                 } else {
                   12033:                                     last;
1.1056    raeburn  12034:                                 }
1.1055    raeburn  12035:                             }
                   12036:                         }
1.1086    raeburn  12037:                         if ($fullpath ne '') {
                   12038:                             if (-e "$prefix$path") {
                   12039:                                 system("mv $prefix$path $fullpath/$title");
                   12040:                             }
                   12041:                             if (-e "$fullpath/$title") {
                   12042:                                 my $showpath;
                   12043:                                 if ($relpath ne '') {
                   12044:                                     $showpath = "$relpath/$title";
                   12045:                                 } else {
                   12046:                                     $showpath = "/$title";
                   12047:                                 } 
                   12048:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   12049:                             } 
                   12050:                             unless ($ishome) {
                   12051:                                 my $fetch = "$fullpath/$title";
                   12052:                                 $fetch =~ s/^\Q$prefix$dir\E//; 
                   12053:                                 $prompttofetch{$fetch} = 1;
                   12054:                             }
                   12055:                         }
1.1055    raeburn  12056:                     }
1.1086    raeburn  12057:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   12058:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   12059:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  12060:                 }
                   12061:             } else {
                   12062:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   12063:             }
                   12064:         }
                   12065:         if (keys(%todelete)) {
                   12066:             foreach my $key (keys(%todelete)) {
                   12067:                 unlink($key);
1.1066    raeburn  12068:             }
                   12069:         }
                   12070:         if (keys(%todeletedir)) {
                   12071:             foreach my $key (keys(%todeletedir)) {
                   12072:                 rmdir($key);
                   12073:             }
                   12074:         }
                   12075:         foreach my $dir (sort(keys(%is_dir))) {
                   12076:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   12077:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  12078:             }
                   12079:         }
1.1067    raeburn  12080:         if ($result ne '') {
                   12081:             $output .= '<ul>'."\n".
                   12082:                        $result."\n".
                   12083:                        '</ul>';
                   12084:         }
                   12085:         unless ($ishome) {
                   12086:             my $replicationfail;
                   12087:             foreach my $item (keys(%prompttofetch)) {
                   12088:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   12089:                 unless ($fetchresult eq 'ok') {
                   12090:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   12091:                 }
                   12092:             }
                   12093:             if ($replicationfail) {
                   12094:                 $output .= '<p class="LC_error">'.
                   12095:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   12096:                            $replicationfail.
                   12097:                            '</ul></p>';
                   12098:             }
                   12099:         }
1.1055    raeburn  12100:     } else {
                   12101:         $warning = &mt('No items found in archive.');
                   12102:     }
                   12103:     if ($error) {
                   12104:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12105:                    $error.'</p>'."\n";
                   12106:     }
                   12107:     if ($warning) {
                   12108:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12109:     }
                   12110:     return $output;
                   12111: }
                   12112: 
1.1066    raeburn  12113: sub cleanup_empty_dirs {
                   12114:     my ($path) = @_;
                   12115:     if (($path ne '') && (-d $path)) {
                   12116:         if (opendir(my $dirh,$path)) {
                   12117:             my @dircontents = grep(!/^\./,readdir($dirh));
                   12118:             my $numitems = 0;
                   12119:             foreach my $item (@dircontents) {
                   12120:                 if (-d "$path/$item") {
1.1111    raeburn  12121:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  12122:                     if (-e "$path/$item") {
                   12123:                         $numitems ++;
                   12124:                     }
                   12125:                 } else {
                   12126:                     $numitems ++;
                   12127:                 }
                   12128:             }
                   12129:             if ($numitems == 0) {
                   12130:                 rmdir($path);
                   12131:             }
                   12132:             closedir($dirh);
                   12133:         }
                   12134:     }
                   12135:     return;
                   12136: }
                   12137: 
1.41      ng       12138: =pod
1.45      matthew  12139: 
1.1162    raeburn  12140: =item * &get_folder_hierarchy()
1.1068    raeburn  12141: 
                   12142: Provides hierarchy of names of folders/sub-folders containing the current
                   12143: item,
                   12144: 
                   12145: Inputs: 3
                   12146:      - $navmap - navmaps object
                   12147: 
                   12148:      - $map - url for map (either the trigger itself, or map containing
                   12149:                            the resource, which is the trigger).
                   12150: 
                   12151:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   12152: 
                   12153: Outputs: 1 @pathitems - array of folder/subfolder names.
                   12154: 
                   12155: =cut
                   12156: 
                   12157: sub get_folder_hierarchy {
                   12158:     my ($navmap,$map,$showitem) = @_;
                   12159:     my @pathitems;
                   12160:     if (ref($navmap)) {
                   12161:         my $mapres = $navmap->getResourceByUrl($map);
                   12162:         if (ref($mapres)) {
                   12163:             my $pcslist = $mapres->map_hierarchy();
                   12164:             if ($pcslist ne '') {
                   12165:                 my @pcs = split(/,/,$pcslist);
                   12166:                 foreach my $pc (@pcs) {
                   12167:                     if ($pc == 1) {
1.1129    raeburn  12168:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  12169:                     } else {
                   12170:                         my $res = $navmap->getByMapPc($pc);
                   12171:                         if (ref($res)) {
                   12172:                             my $title = $res->compTitle();
                   12173:                             $title =~ s/\W+/_/g;
                   12174:                             if ($title ne '') {
                   12175:                                 push(@pathitems,$title);
                   12176:                             }
                   12177:                         }
                   12178:                     }
                   12179:                 }
                   12180:             }
1.1071    raeburn  12181:             if ($showitem) {
                   12182:                 if ($mapres->{ID} eq '0.0') {
1.1129    raeburn  12183:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  12184:                 } else {
                   12185:                     my $maptitle = $mapres->compTitle();
                   12186:                     $maptitle =~ s/\W+/_/g;
                   12187:                     if ($maptitle ne '') {
                   12188:                         push(@pathitems,$maptitle);
                   12189:                     }
1.1068    raeburn  12190:                 }
                   12191:             }
                   12192:         }
                   12193:     }
                   12194:     return @pathitems;
                   12195: }
                   12196: 
                   12197: =pod
                   12198: 
1.1015    raeburn  12199: =item * &get_turnedin_filepath()
                   12200: 
                   12201: Determines path in a user's portfolio file for storage of files uploaded
                   12202: to a specific essayresponse or dropbox item.
                   12203: 
                   12204: Inputs: 3 required + 1 optional.
                   12205: $symb is symb for resource, $uname and $udom are for current user (required).
                   12206: $caller is optional (can be "submission", if routine is called when storing
                   12207: an upoaded file when "Submit Answer" button was pressed).
                   12208: 
                   12209: Returns array containing $path and $multiresp. 
                   12210: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   12211: than one file upload item.  Callers of routine should append partid as a 
                   12212: subdirectory to $path in cases where $multiresp is 1.
                   12213: 
                   12214: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   12215: 
                   12216: =cut
                   12217: 
                   12218: sub get_turnedin_filepath {
                   12219:     my ($symb,$uname,$udom,$caller) = @_;
                   12220:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   12221:     my $turnindir;
                   12222:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   12223:     $turnindir = $userhash{'turnindir'};
                   12224:     my ($path,$multiresp);
                   12225:     if ($turnindir eq '') {
                   12226:         if ($caller eq 'submission') {
                   12227:             $turnindir = &mt('turned in');
                   12228:             $turnindir =~ s/\W+/_/g;
                   12229:             my %newhash = (
                   12230:                             'turnindir' => $turnindir,
                   12231:                           );
                   12232:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   12233:         }
                   12234:     }
                   12235:     if ($turnindir ne '') {
                   12236:         $path = '/'.$turnindir.'/';
                   12237:         my ($multipart,$turnin,@pathitems);
                   12238:         my $navmap = Apache::lonnavmaps::navmap->new();
                   12239:         if (defined($navmap)) {
                   12240:             my $mapres = $navmap->getResourceByUrl($map);
                   12241:             if (ref($mapres)) {
                   12242:                 my $pcslist = $mapres->map_hierarchy();
                   12243:                 if ($pcslist ne '') {
                   12244:                     foreach my $pc (split(/,/,$pcslist)) {
                   12245:                         my $res = $navmap->getByMapPc($pc);
                   12246:                         if (ref($res)) {
                   12247:                             my $title = $res->compTitle();
                   12248:                             $title =~ s/\W+/_/g;
                   12249:                             if ($title ne '') {
1.1149    raeburn  12250:                                 if (($pc > 1) && (length($title) > 12)) {
                   12251:                                     $title = substr($title,0,12);
                   12252:                                 }
1.1015    raeburn  12253:                                 push(@pathitems,$title);
                   12254:                             }
                   12255:                         }
                   12256:                     }
                   12257:                 }
                   12258:                 my $maptitle = $mapres->compTitle();
                   12259:                 $maptitle =~ s/\W+/_/g;
                   12260:                 if ($maptitle ne '') {
1.1149    raeburn  12261:                     if (length($maptitle) > 12) {
                   12262:                         $maptitle = substr($maptitle,0,12);
                   12263:                     }
1.1015    raeburn  12264:                     push(@pathitems,$maptitle);
                   12265:                 }
                   12266:                 unless ($env{'request.state'} eq 'construct') {
                   12267:                     my $res = $navmap->getBySymb($symb);
                   12268:                     if (ref($res)) {
                   12269:                         my $partlist = $res->parts();
                   12270:                         my $totaluploads = 0;
                   12271:                         if (ref($partlist) eq 'ARRAY') {
                   12272:                             foreach my $part (@{$partlist}) {
                   12273:                                 my @types = $res->responseType($part);
                   12274:                                 my @ids = $res->responseIds($part);
                   12275:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   12276:                                     if ($types[$i] eq 'essay') {
                   12277:                                         my $partid = $part.'_'.$ids[$i];
                   12278:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   12279:                                             $totaluploads ++;
                   12280:                                         }
                   12281:                                     }
                   12282:                                 }
                   12283:                             }
                   12284:                             if ($totaluploads > 1) {
                   12285:                                 $multiresp = 1;
                   12286:                             }
                   12287:                         }
                   12288:                     }
                   12289:                 }
                   12290:             } else {
                   12291:                 return;
                   12292:             }
                   12293:         } else {
                   12294:             return;
                   12295:         }
                   12296:         my $restitle=&Apache::lonnet::gettitle($symb);
                   12297:         $restitle =~ s/\W+/_/g;
                   12298:         if ($restitle eq '') {
                   12299:             $restitle = ($resurl =~ m{/[^/]+$});
                   12300:             if ($restitle eq '') {
                   12301:                 $restitle = time;
                   12302:             }
                   12303:         }
1.1149    raeburn  12304:         if (length($restitle) > 12) {
                   12305:             $restitle = substr($restitle,0,12);
                   12306:         }
1.1015    raeburn  12307:         push(@pathitems,$restitle);
                   12308:         $path .= join('/',@pathitems);
                   12309:     }
                   12310:     return ($path,$multiresp);
                   12311: }
                   12312: 
                   12313: =pod
                   12314: 
1.464     albertel 12315: =back
1.41      ng       12316: 
1.112     bowersj2 12317: =head1 CSV Upload/Handling functions
1.38      albertel 12318: 
1.41      ng       12319: =over 4
                   12320: 
1.648     raeburn  12321: =item * &upfile_store($r)
1.41      ng       12322: 
                   12323: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 12324: needs $env{'form.upfile'}
1.41      ng       12325: returns $datatoken to be put into hidden field
                   12326: 
                   12327: =cut
1.31      albertel 12328: 
                   12329: sub upfile_store {
                   12330:     my $r=shift;
1.258     albertel 12331:     $env{'form.upfile'}=~s/\r/\n/gs;
                   12332:     $env{'form.upfile'}=~s/\f/\n/gs;
                   12333:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   12334:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 12335: 
1.258     albertel 12336:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   12337: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 12338:     {
1.158     raeburn  12339:         my $datafile = $r->dir_config('lonDaemons').
                   12340:                            '/tmp/'.$datatoken.'.tmp';
                   12341:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 12342:             print $fh $env{'form.upfile'};
1.158     raeburn  12343:             close($fh);
                   12344:         }
1.31      albertel 12345:     }
                   12346:     return $datatoken;
                   12347: }
                   12348: 
1.56      matthew  12349: =pod
                   12350: 
1.648     raeburn  12351: =item * &load_tmp_file($r)
1.41      ng       12352: 
                   12353: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 12354: needs $env{'form.datatoken'},
                   12355: sets $env{'form.upfile'} to the contents of the file
1.41      ng       12356: 
                   12357: =cut
1.31      albertel 12358: 
                   12359: sub load_tmp_file {
                   12360:     my $r=shift;
                   12361:     my @studentdata=();
                   12362:     {
1.158     raeburn  12363:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 12364:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  12365:         if ( open(my $fh,"<$studentfile") ) {
                   12366:             @studentdata=<$fh>;
                   12367:             close($fh);
                   12368:         }
1.31      albertel 12369:     }
1.258     albertel 12370:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 12371: }
                   12372: 
1.56      matthew  12373: =pod
                   12374: 
1.648     raeburn  12375: =item * &upfile_record_sep()
1.41      ng       12376: 
                   12377: Separate uploaded file into records
                   12378: returns array of records,
1.258     albertel 12379: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       12380: 
                   12381: =cut
1.31      albertel 12382: 
                   12383: sub upfile_record_sep {
1.258     albertel 12384:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 12385:     } else {
1.248     albertel 12386: 	my @records;
1.258     albertel 12387: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 12388: 	    if ($line=~/^\s*$/) { next; }
                   12389: 	    push(@records,$line);
                   12390: 	}
                   12391: 	return @records;
1.31      albertel 12392:     }
                   12393: }
                   12394: 
1.56      matthew  12395: =pod
                   12396: 
1.648     raeburn  12397: =item * &record_sep($record)
1.41      ng       12398: 
1.258     albertel 12399: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       12400: 
                   12401: =cut
                   12402: 
1.263     www      12403: sub takeleft {
                   12404:     my $index=shift;
                   12405:     return substr('0000'.$index,-4,4);
                   12406: }
                   12407: 
1.31      albertel 12408: sub record_sep {
                   12409:     my $record=shift;
                   12410:     my %components=();
1.258     albertel 12411:     if ($env{'form.upfiletype'} eq 'xml') {
                   12412:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 12413:         my $i=0;
1.356     albertel 12414:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 12415:             $field=~s/^(\"|\')//;
                   12416:             $field=~s/(\"|\')$//;
1.263     www      12417:             $components{&takeleft($i)}=$field;
1.31      albertel 12418:             $i++;
                   12419:         }
1.258     albertel 12420:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 12421:         my $i=0;
1.356     albertel 12422:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 12423:             $field=~s/^(\"|\')//;
                   12424:             $field=~s/(\"|\')$//;
1.263     www      12425:             $components{&takeleft($i)}=$field;
1.31      albertel 12426:             $i++;
                   12427:         }
                   12428:     } else {
1.561     www      12429:         my $separator=',';
1.480     banghart 12430:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      12431:             $separator=';';
1.480     banghart 12432:         }
1.31      albertel 12433:         my $i=0;
1.561     www      12434: # the character we are looking for to indicate the end of a quote or a record 
                   12435:         my $looking_for=$separator;
                   12436: # do not add the characters to the fields
                   12437:         my $ignore=0;
                   12438: # we just encountered a separator (or the beginning of the record)
                   12439:         my $just_found_separator=1;
                   12440: # store the field we are working on here
                   12441:         my $field='';
                   12442: # work our way through all characters in record
                   12443:         foreach my $character ($record=~/(.)/g) {
                   12444:             if ($character eq $looking_for) {
                   12445:                if ($character ne $separator) {
                   12446: # Found the end of a quote, again looking for separator
                   12447:                   $looking_for=$separator;
                   12448:                   $ignore=1;
                   12449:                } else {
                   12450: # Found a separator, store away what we got
                   12451:                   $components{&takeleft($i)}=$field;
                   12452: 	          $i++;
                   12453:                   $just_found_separator=1;
                   12454:                   $ignore=0;
                   12455:                   $field='';
                   12456:                }
                   12457:                next;
                   12458:             }
                   12459: # single or double quotation marks after a separator indicate beginning of a quote
                   12460: # we are now looking for the end of the quote and need to ignore separators
                   12461:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   12462:                $looking_for=$character;
                   12463:                next;
                   12464:             }
                   12465: # ignore would be true after we reached the end of a quote
                   12466:             if ($ignore) { next; }
                   12467:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   12468:             $field.=$character;
                   12469:             $just_found_separator=0; 
1.31      albertel 12470:         }
1.561     www      12471: # catch the very last entry, since we never encountered the separator
                   12472:         $components{&takeleft($i)}=$field;
1.31      albertel 12473:     }
                   12474:     return %components;
                   12475: }
                   12476: 
1.144     matthew  12477: ######################################################
                   12478: ######################################################
                   12479: 
1.56      matthew  12480: =pod
                   12481: 
1.648     raeburn  12482: =item * &upfile_select_html()
1.41      ng       12483: 
1.144     matthew  12484: Return HTML code to select a file from the users machine and specify 
                   12485: the file type.
1.41      ng       12486: 
                   12487: =cut
                   12488: 
1.144     matthew  12489: ######################################################
                   12490: ######################################################
1.31      albertel 12491: sub upfile_select_html {
1.144     matthew  12492:     my %Types = (
                   12493:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 12494:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  12495:                  space => &mt('Space separated'),
                   12496:                  tab   => &mt('Tabulator separated'),
                   12497: #                 xml   => &mt('HTML/XML'),
                   12498:                  );
                   12499:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  12500:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  12501:     foreach my $type (sort(keys(%Types))) {
                   12502:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   12503:     }
                   12504:     $Str .= "</select>\n";
                   12505:     return $Str;
1.31      albertel 12506: }
                   12507: 
1.301     albertel 12508: sub get_samples {
                   12509:     my ($records,$toget) = @_;
                   12510:     my @samples=({});
                   12511:     my $got=0;
                   12512:     foreach my $rec (@$records) {
                   12513: 	my %temp = &record_sep($rec);
                   12514: 	if (! grep(/\S/, values(%temp))) { next; }
                   12515: 	if (%temp) {
                   12516: 	    $samples[$got]=\%temp;
                   12517: 	    $got++;
                   12518: 	    if ($got == $toget) { last; }
                   12519: 	}
                   12520:     }
                   12521:     return \@samples;
                   12522: }
                   12523: 
1.144     matthew  12524: ######################################################
                   12525: ######################################################
                   12526: 
1.56      matthew  12527: =pod
                   12528: 
1.648     raeburn  12529: =item * &csv_print_samples($r,$records)
1.41      ng       12530: 
                   12531: Prints a table of sample values from each column uploaded $r is an
                   12532: Apache Request ref, $records is an arrayref from
                   12533: &Apache::loncommon::upfile_record_sep
                   12534: 
                   12535: =cut
                   12536: 
1.144     matthew  12537: ######################################################
                   12538: ######################################################
1.31      albertel 12539: sub csv_print_samples {
                   12540:     my ($r,$records) = @_;
1.662     bisitz   12541:     my $samples = &get_samples($records,5);
1.301     albertel 12542: 
1.594     raeburn  12543:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   12544:               &start_data_table_header_row());
1.356     albertel 12545:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   12546:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  12547:     $r->print(&end_data_table_header_row());
1.301     albertel 12548:     foreach my $hash (@$samples) {
1.594     raeburn  12549: 	$r->print(&start_data_table_row());
1.356     albertel 12550: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 12551: 	    $r->print('<td>');
1.356     albertel 12552: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 12553: 	    $r->print('</td>');
                   12554: 	}
1.594     raeburn  12555: 	$r->print(&end_data_table_row());
1.31      albertel 12556:     }
1.594     raeburn  12557:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 12558: }
                   12559: 
1.144     matthew  12560: ######################################################
                   12561: ######################################################
                   12562: 
1.56      matthew  12563: =pod
                   12564: 
1.648     raeburn  12565: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       12566: 
                   12567: Prints a table to create associations between values and table columns.
1.144     matthew  12568: 
1.41      ng       12569: $r is an Apache Request ref,
                   12570: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  12571: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       12572: 
                   12573: =cut
                   12574: 
1.144     matthew  12575: ######################################################
                   12576: ######################################################
1.31      albertel 12577: sub csv_print_select_table {
                   12578:     my ($r,$records,$d) = @_;
1.301     albertel 12579:     my $i=0;
                   12580:     my $samples = &get_samples($records,1);
1.144     matthew  12581:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  12582: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  12583:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  12584:               '<th>'.&mt('Column').'</th>'.
                   12585:               &end_data_table_header_row()."\n");
1.356     albertel 12586:     foreach my $array_ref (@$d) {
                   12587: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  12588: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 12589: 
1.875     bisitz   12590: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  12591: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 12592: 	$r->print('<option value="none"></option>');
1.356     albertel 12593: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   12594: 	    $r->print('<option value="'.$sample.'"'.
                   12595:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   12596:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 12597: 	}
1.594     raeburn  12598: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 12599: 	$i++;
                   12600:     }
1.594     raeburn  12601:     $r->print(&end_data_table());
1.31      albertel 12602:     $i--;
                   12603:     return $i;
                   12604: }
1.56      matthew  12605: 
1.144     matthew  12606: ######################################################
                   12607: ######################################################
                   12608: 
1.56      matthew  12609: =pod
1.31      albertel 12610: 
1.648     raeburn  12611: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       12612: 
                   12613: Prints a table of sample values from the upload and can make associate samples to internal names.
                   12614: 
                   12615: $r is an Apache Request ref,
                   12616: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   12617: $d is an array of 2 element arrays (internal name, displayed name)
                   12618: 
                   12619: =cut
                   12620: 
1.144     matthew  12621: ######################################################
                   12622: ######################################################
1.31      albertel 12623: sub csv_samples_select_table {
                   12624:     my ($r,$records,$d) = @_;
                   12625:     my $i=0;
1.144     matthew  12626:     #
1.662     bisitz   12627:     my $max_samples = 5;
                   12628:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  12629:     $r->print(&start_data_table().
                   12630:               &start_data_table_header_row().'<th>'.
                   12631:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   12632:               &end_data_table_header_row());
1.301     albertel 12633: 
                   12634:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  12635: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  12636: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 12637: 	foreach my $option (@$d) {
                   12638: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  12639: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 12640:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  12641:                       $display.'</option>');
1.31      albertel 12642: 	}
                   12643: 	$r->print('</select></td><td>');
1.662     bisitz   12644: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 12645: 	    if (defined($samples->[$line]{$key})) { 
                   12646: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   12647: 	    }
                   12648: 	}
1.594     raeburn  12649: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 12650: 	$i++;
                   12651:     }
1.594     raeburn  12652:     $r->print(&end_data_table());
1.31      albertel 12653:     $i--;
                   12654:     return($i);
1.115     matthew  12655: }
                   12656: 
1.144     matthew  12657: ######################################################
                   12658: ######################################################
                   12659: 
1.115     matthew  12660: =pod
                   12661: 
1.648     raeburn  12662: =item * &clean_excel_name($name)
1.115     matthew  12663: 
                   12664: Returns a replacement for $name which does not contain any illegal characters.
                   12665: 
                   12666: =cut
                   12667: 
1.144     matthew  12668: ######################################################
                   12669: ######################################################
1.115     matthew  12670: sub clean_excel_name {
                   12671:     my ($name) = @_;
                   12672:     $name =~ s/[:\*\?\/\\]//g;
                   12673:     if (length($name) > 31) {
                   12674:         $name = substr($name,0,31);
                   12675:     }
                   12676:     return $name;
1.25      albertel 12677: }
1.84      albertel 12678: 
1.85      albertel 12679: =pod
                   12680: 
1.648     raeburn  12681: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 12682: 
                   12683: Returns either 1 or undef
                   12684: 
                   12685: 1 if the part is to be hidden, undef if it is to be shown
                   12686: 
                   12687: Arguments are:
                   12688: 
                   12689: $id the id of the part to be checked
                   12690: $symb, optional the symb of the resource to check
                   12691: $udom, optional the domain of the user to check for
                   12692: $uname, optional the username of the user to check for
                   12693: 
                   12694: =cut
1.84      albertel 12695: 
                   12696: sub check_if_partid_hidden {
                   12697:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 12698:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 12699: 					 $symb,$udom,$uname);
1.141     albertel 12700:     my $truth=1;
                   12701:     #if the string starts with !, then the list is the list to show not hide
                   12702:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 12703:     my @hiddenlist=split(/,/,$hiddenparts);
                   12704:     foreach my $checkid (@hiddenlist) {
1.141     albertel 12705: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 12706:     }
1.141     albertel 12707:     return !$truth;
1.84      albertel 12708: }
1.127     matthew  12709: 
1.138     matthew  12710: 
                   12711: ############################################################
                   12712: ############################################################
                   12713: 
                   12714: =pod
                   12715: 
1.157     matthew  12716: =back 
                   12717: 
1.138     matthew  12718: =head1 cgi-bin script and graphing routines
                   12719: 
1.157     matthew  12720: =over 4
                   12721: 
1.648     raeburn  12722: =item * &get_cgi_id()
1.138     matthew  12723: 
                   12724: Inputs: none
                   12725: 
                   12726: Returns an id which can be used to pass environment variables
                   12727: to various cgi-bin scripts.  These environment variables will
                   12728: be removed from the users environment after a given time by
                   12729: the routine &Apache::lonnet::transfer_profile_to_env.
                   12730: 
                   12731: =cut
                   12732: 
                   12733: ############################################################
                   12734: ############################################################
1.152     albertel 12735: my $uniq=0;
1.136     matthew  12736: sub get_cgi_id {
1.154     albertel 12737:     $uniq=($uniq+1)%100000;
1.280     albertel 12738:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  12739: }
                   12740: 
1.127     matthew  12741: ############################################################
                   12742: ############################################################
                   12743: 
                   12744: =pod
                   12745: 
1.648     raeburn  12746: =item * &DrawBarGraph()
1.127     matthew  12747: 
1.138     matthew  12748: Facilitates the plotting of data in a (stacked) bar graph.
                   12749: Puts plot definition data into the users environment in order for 
                   12750: graph.png to plot it.  Returns an <img> tag for the plot.
                   12751: The bars on the plot are labeled '1','2',...,'n'.
                   12752: 
                   12753: Inputs:
                   12754: 
                   12755: =over 4
                   12756: 
                   12757: =item $Title: string, the title of the plot
                   12758: 
                   12759: =item $xlabel: string, text describing the X-axis of the plot
                   12760: 
                   12761: =item $ylabel: string, text describing the Y-axis of the plot
                   12762: 
                   12763: =item $Max: scalar, the maximum Y value to use in the plot
                   12764: If $Max is < any data point, the graph will not be rendered.
                   12765: 
1.140     matthew  12766: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  12767: they are plotted.  If undefined, default values will be used.
                   12768: 
1.178     matthew  12769: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   12770: 
1.138     matthew  12771: =item @Values: An array of array references.  Each array reference holds data
                   12772: to be plotted in a stacked bar chart.
                   12773: 
1.239     matthew  12774: =item If the final element of @Values is a hash reference the key/value
                   12775: pairs will be added to the graph definition.
                   12776: 
1.138     matthew  12777: =back
                   12778: 
                   12779: Returns:
                   12780: 
                   12781: An <img> tag which references graph.png and the appropriate identifying
                   12782: information for the plot.
                   12783: 
1.127     matthew  12784: =cut
                   12785: 
                   12786: ############################################################
                   12787: ############################################################
1.134     matthew  12788: sub DrawBarGraph {
1.178     matthew  12789:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  12790:     #
                   12791:     if (! defined($colors)) {
                   12792:         $colors = ['#33ff00', 
                   12793:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   12794:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   12795:                   ]; 
                   12796:     }
1.228     matthew  12797:     my $extra_settings = {};
                   12798:     if (ref($Values[-1]) eq 'HASH') {
                   12799:         $extra_settings = pop(@Values);
                   12800:     }
1.127     matthew  12801:     #
1.136     matthew  12802:     my $identifier = &get_cgi_id();
                   12803:     my $id = 'cgi.'.$identifier;        
1.129     matthew  12804:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  12805:         return '';
                   12806:     }
1.225     matthew  12807:     #
                   12808:     my @Labels;
                   12809:     if (defined($labels)) {
                   12810:         @Labels = @$labels;
                   12811:     } else {
                   12812:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   12813:             push (@Labels,$i+1);
                   12814:         }
                   12815:     }
                   12816:     #
1.129     matthew  12817:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  12818:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  12819:     my %ValuesHash;
                   12820:     my $NumSets=1;
                   12821:     foreach my $array (@Values) {
                   12822:         next if (! ref($array));
1.136     matthew  12823:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  12824:             join(',',@$array);
1.129     matthew  12825:     }
1.127     matthew  12826:     #
1.136     matthew  12827:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  12828:     if ($NumBars < 3) {
                   12829:         $width = 120+$NumBars*32;
1.220     matthew  12830:         $xskip = 1;
1.225     matthew  12831:         $bar_width = 30;
                   12832:     } elsif ($NumBars < 5) {
                   12833:         $width = 120+$NumBars*20;
                   12834:         $xskip = 1;
                   12835:         $bar_width = 20;
1.220     matthew  12836:     } elsif ($NumBars < 10) {
1.136     matthew  12837:         $width = 120+$NumBars*15;
                   12838:         $xskip = 1;
                   12839:         $bar_width = 15;
                   12840:     } elsif ($NumBars <= 25) {
                   12841:         $width = 120+$NumBars*11;
                   12842:         $xskip = 5;
                   12843:         $bar_width = 8;
                   12844:     } elsif ($NumBars <= 50) {
                   12845:         $width = 120+$NumBars*8;
                   12846:         $xskip = 5;
                   12847:         $bar_width = 4;
                   12848:     } else {
                   12849:         $width = 120+$NumBars*8;
                   12850:         $xskip = 5;
                   12851:         $bar_width = 4;
                   12852:     }
                   12853:     #
1.137     matthew  12854:     $Max = 1 if ($Max < 1);
                   12855:     if ( int($Max) < $Max ) {
                   12856:         $Max++;
                   12857:         $Max = int($Max);
                   12858:     }
1.127     matthew  12859:     $Title  = '' if (! defined($Title));
                   12860:     $xlabel = '' if (! defined($xlabel));
                   12861:     $ylabel = '' if (! defined($ylabel));
1.369     www      12862:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   12863:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   12864:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  12865:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  12866:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   12867:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   12868:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   12869:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12870:     $ValuesHash{$id.'.height'}   = $height;
                   12871:     $ValuesHash{$id.'.width'}    = $width;
                   12872:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   12873:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   12874:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  12875:     #
1.228     matthew  12876:     # Deal with other parameters
                   12877:     while (my ($key,$value) = each(%$extra_settings)) {
                   12878:         $ValuesHash{$id.'.'.$key} = $value;
                   12879:     }
                   12880:     #
1.646     raeburn  12881:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  12882:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12883: }
                   12884: 
                   12885: ############################################################
                   12886: ############################################################
                   12887: 
                   12888: =pod
                   12889: 
1.648     raeburn  12890: =item * &DrawXYGraph()
1.137     matthew  12891: 
1.138     matthew  12892: Facilitates the plotting of data in an XY graph.
                   12893: Puts plot definition data into the users environment in order for 
                   12894: graph.png to plot it.  Returns an <img> tag for the plot.
                   12895: 
                   12896: Inputs:
                   12897: 
                   12898: =over 4
                   12899: 
                   12900: =item $Title: string, the title of the plot
                   12901: 
                   12902: =item $xlabel: string, text describing the X-axis of the plot
                   12903: 
                   12904: =item $ylabel: string, text describing the Y-axis of the plot
                   12905: 
                   12906: =item $Max: scalar, the maximum Y value to use in the plot
                   12907: If $Max is < any data point, the graph will not be rendered.
                   12908: 
                   12909: =item $colors: Array ref containing the hex color codes for the data to be 
                   12910: plotted in.  If undefined, default values will be used.
                   12911: 
                   12912: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12913: 
                   12914: =item $Ydata: Array ref containing Array refs.  
1.185     www      12915: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  12916: 
                   12917: =item %Values: hash indicating or overriding any default values which are 
                   12918: passed to graph.png.  
                   12919: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12920: 
                   12921: =back
                   12922: 
                   12923: Returns:
                   12924: 
                   12925: An <img> tag which references graph.png and the appropriate identifying
                   12926: information for the plot.
                   12927: 
1.137     matthew  12928: =cut
                   12929: 
                   12930: ############################################################
                   12931: ############################################################
                   12932: sub DrawXYGraph {
                   12933:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   12934:     #
                   12935:     # Create the identifier for the graph
                   12936:     my $identifier = &get_cgi_id();
                   12937:     my $id = 'cgi.'.$identifier;
                   12938:     #
                   12939:     $Title  = '' if (! defined($Title));
                   12940:     $xlabel = '' if (! defined($xlabel));
                   12941:     $ylabel = '' if (! defined($ylabel));
                   12942:     my %ValuesHash = 
                   12943:         (
1.369     www      12944:          $id.'.title'  => &escape($Title),
                   12945:          $id.'.xlabel' => &escape($xlabel),
                   12946:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  12947:          $id.'.y_max_value'=> $Max,
                   12948:          $id.'.labels'     => join(',',@$Xlabels),
                   12949:          $id.'.PlotType'   => 'XY',
                   12950:          );
                   12951:     #
                   12952:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12953:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12954:     }
                   12955:     #
                   12956:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   12957:         return '';
                   12958:     }
                   12959:     my $NumSets=1;
1.138     matthew  12960:     foreach my $array (@{$Ydata}){
1.137     matthew  12961:         next if (! ref($array));
                   12962:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   12963:     }
1.138     matthew  12964:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  12965:     #
                   12966:     # Deal with other parameters
                   12967:     while (my ($key,$value) = each(%Values)) {
                   12968:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  12969:     }
                   12970:     #
1.646     raeburn  12971:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  12972:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12973: }
                   12974: 
                   12975: ############################################################
                   12976: ############################################################
                   12977: 
                   12978: =pod
                   12979: 
1.648     raeburn  12980: =item * &DrawXYYGraph()
1.138     matthew  12981: 
                   12982: Facilitates the plotting of data in an XY graph with two Y axes.
                   12983: Puts plot definition data into the users environment in order for 
                   12984: graph.png to plot it.  Returns an <img> tag for the plot.
                   12985: 
                   12986: Inputs:
                   12987: 
                   12988: =over 4
                   12989: 
                   12990: =item $Title: string, the title of the plot
                   12991: 
                   12992: =item $xlabel: string, text describing the X-axis of the plot
                   12993: 
                   12994: =item $ylabel: string, text describing the Y-axis of the plot
                   12995: 
                   12996: =item $colors: Array ref containing the hex color codes for the data to be 
                   12997: plotted in.  If undefined, default values will be used.
                   12998: 
                   12999: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13000: 
                   13001: =item $Ydata1: The first data set
                   13002: 
                   13003: =item $Min1: The minimum value of the left Y-axis
                   13004: 
                   13005: =item $Max1: The maximum value of the left Y-axis
                   13006: 
                   13007: =item $Ydata2: The second data set
                   13008: 
                   13009: =item $Min2: The minimum value of the right Y-axis
                   13010: 
                   13011: =item $Max2: The maximum value of the left Y-axis
                   13012: 
                   13013: =item %Values: hash indicating or overriding any default values which are 
                   13014: passed to graph.png.  
                   13015: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13016: 
                   13017: =back
                   13018: 
                   13019: Returns:
                   13020: 
                   13021: An <img> tag which references graph.png and the appropriate identifying
                   13022: information for the plot.
1.136     matthew  13023: 
                   13024: =cut
                   13025: 
                   13026: ############################################################
                   13027: ############################################################
1.137     matthew  13028: sub DrawXYYGraph {
                   13029:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   13030:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  13031:     #
                   13032:     # Create the identifier for the graph
                   13033:     my $identifier = &get_cgi_id();
                   13034:     my $id = 'cgi.'.$identifier;
                   13035:     #
                   13036:     $Title  = '' if (! defined($Title));
                   13037:     $xlabel = '' if (! defined($xlabel));
                   13038:     $ylabel = '' if (! defined($ylabel));
                   13039:     my %ValuesHash = 
                   13040:         (
1.369     www      13041:          $id.'.title'  => &escape($Title),
                   13042:          $id.'.xlabel' => &escape($xlabel),
                   13043:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  13044:          $id.'.labels' => join(',',@$Xlabels),
                   13045:          $id.'.PlotType' => 'XY',
                   13046:          $id.'.NumSets' => 2,
1.137     matthew  13047:          $id.'.two_axes' => 1,
                   13048:          $id.'.y1_max_value' => $Max1,
                   13049:          $id.'.y1_min_value' => $Min1,
                   13050:          $id.'.y2_max_value' => $Max2,
                   13051:          $id.'.y2_min_value' => $Min2,
1.136     matthew  13052:          );
                   13053:     #
1.137     matthew  13054:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13055:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13056:     }
                   13057:     #
                   13058:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   13059:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  13060:         return '';
                   13061:     }
                   13062:     my $NumSets=1;
1.137     matthew  13063:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  13064:         next if (! ref($array));
                   13065:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  13066:     }
                   13067:     #
                   13068:     # Deal with other parameters
                   13069:     while (my ($key,$value) = each(%Values)) {
                   13070:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  13071:     }
                   13072:     #
1.646     raeburn  13073:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 13074:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  13075: }
                   13076: 
                   13077: ############################################################
                   13078: ############################################################
                   13079: 
                   13080: =pod
                   13081: 
1.157     matthew  13082: =back 
                   13083: 
1.139     matthew  13084: =head1 Statistics helper routines?  
                   13085: 
                   13086: Bad place for them but what the hell.
                   13087: 
1.157     matthew  13088: =over 4
                   13089: 
1.648     raeburn  13090: =item * &chartlink()
1.139     matthew  13091: 
                   13092: Returns a link to the chart for a specific student.  
                   13093: 
                   13094: Inputs:
                   13095: 
                   13096: =over 4
                   13097: 
                   13098: =item $linktext: The text of the link
                   13099: 
                   13100: =item $sname: The students username
                   13101: 
                   13102: =item $sdomain: The students domain
                   13103: 
                   13104: =back
                   13105: 
1.157     matthew  13106: =back
                   13107: 
1.139     matthew  13108: =cut
                   13109: 
                   13110: ############################################################
                   13111: ############################################################
                   13112: sub chartlink {
                   13113:     my ($linktext, $sname, $sdomain) = @_;
                   13114:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      13115:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 13116:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  13117:        '">'.$linktext.'</a>';
1.153     matthew  13118: }
                   13119: 
                   13120: #######################################################
                   13121: #######################################################
                   13122: 
                   13123: =pod
                   13124: 
                   13125: =head1 Course Environment Routines
1.157     matthew  13126: 
                   13127: =over 4
1.153     matthew  13128: 
1.648     raeburn  13129: =item * &restore_course_settings()
1.153     matthew  13130: 
1.648     raeburn  13131: =item * &store_course_settings()
1.153     matthew  13132: 
                   13133: Restores/Store indicated form parameters from the course environment.
                   13134: Will not overwrite existing values of the form parameters.
                   13135: 
                   13136: Inputs: 
                   13137: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   13138: 
                   13139: a hash ref describing the data to be stored.  For example:
                   13140:    
                   13141: %Save_Parameters = ('Status' => 'scalar',
                   13142:     'chartoutputmode' => 'scalar',
                   13143:     'chartoutputdata' => 'scalar',
                   13144:     'Section' => 'array',
1.373     raeburn  13145:     'Group' => 'array',
1.153     matthew  13146:     'StudentData' => 'array',
                   13147:     'Maps' => 'array');
                   13148: 
                   13149: Returns: both routines return nothing
                   13150: 
1.631     raeburn  13151: =back
                   13152: 
1.153     matthew  13153: =cut
                   13154: 
                   13155: #######################################################
                   13156: #######################################################
                   13157: sub store_course_settings {
1.496     albertel 13158:     return &store_settings($env{'request.course.id'},@_);
                   13159: }
                   13160: 
                   13161: sub store_settings {
1.153     matthew  13162:     # save to the environment
                   13163:     # appenv the same items, just to be safe
1.300     albertel 13164:     my $udom  = $env{'user.domain'};
                   13165:     my $uname = $env{'user.name'};
1.496     albertel 13166:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13167:     my %SaveHash;
                   13168:     my %AppHash;
                   13169:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 13170:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 13171:         my $envname = 'environment.'.$basename;
1.258     albertel 13172:         if (exists($env{'form.'.$setting})) {
1.153     matthew  13173:             # Save this value away
                   13174:             if ($type eq 'scalar' &&
1.258     albertel 13175:                 (! exists($env{$envname}) || 
                   13176:                  $env{$envname} ne $env{'form.'.$setting})) {
                   13177:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   13178:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  13179:             } elsif ($type eq 'array') {
                   13180:                 my $stored_form;
1.258     albertel 13181:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  13182:                     $stored_form = join(',',
                   13183:                                         map {
1.369     www      13184:                                             &escape($_);
1.258     albertel 13185:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  13186:                 } else {
                   13187:                     $stored_form = 
1.369     www      13188:                         &escape($env{'form.'.$setting});
1.153     matthew  13189:                 }
                   13190:                 # Determine if the array contents are the same.
1.258     albertel 13191:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  13192:                     $SaveHash{$basename} = $stored_form;
                   13193:                     $AppHash{$envname}   = $stored_form;
                   13194:                 }
                   13195:             }
                   13196:         }
                   13197:     }
                   13198:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 13199:                                           $udom,$uname);
1.153     matthew  13200:     if ($put_result !~ /^(ok|delayed)/) {
                   13201:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   13202:                                  'got error:'.$put_result);
                   13203:     }
                   13204:     # Make sure these settings stick around in this session, too
1.646     raeburn  13205:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  13206:     return;
                   13207: }
                   13208: 
                   13209: sub restore_course_settings {
1.499     albertel 13210:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 13211: }
                   13212: 
                   13213: sub restore_settings {
                   13214:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13215:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 13216:         next if (exists($env{'form.'.$setting}));
1.496     albertel 13217:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  13218:             '.'.$setting;
1.258     albertel 13219:         if (exists($env{$envname})) {
1.153     matthew  13220:             if ($type eq 'scalar') {
1.258     albertel 13221:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  13222:             } elsif ($type eq 'array') {
1.258     albertel 13223:                 $env{'form.'.$setting} = [ 
1.153     matthew  13224:                                            map { 
1.369     www      13225:                                                &unescape($_); 
1.258     albertel 13226:                                            } split(',',$env{$envname})
1.153     matthew  13227:                                            ];
                   13228:             }
                   13229:         }
                   13230:     }
1.127     matthew  13231: }
                   13232: 
1.618     raeburn  13233: #######################################################
                   13234: #######################################################
                   13235: 
                   13236: =pod
                   13237: 
                   13238: =head1 Domain E-mail Routines  
                   13239: 
                   13240: =over 4
                   13241: 
1.648     raeburn  13242: =item * &build_recipient_list()
1.618     raeburn  13243: 
1.1144    raeburn  13244: Build recipient lists for following types of e-mail:
1.766     raeburn  13245: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144    raeburn  13246: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   13247: module change checking, student/employee ID conflict checks, as
                   13248: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   13249: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  13250: 
                   13251: Inputs:
1.619     raeburn  13252: defmail (scalar - email address of default recipient), 
1.1144    raeburn  13253: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   13254: requestsmail, updatesmail, or idconflictsmail).
                   13255: 
1.619     raeburn  13256: defdom (domain for which to retrieve configuration settings),
1.1144    raeburn  13257: 
1.619     raeburn  13258: origmail (scalar - email address of recipient from loncapa.conf, 
                   13259: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  13260: 
1.655     raeburn  13261: Returns: comma separated list of addresses to which to send e-mail.
                   13262: 
                   13263: =back
1.618     raeburn  13264: 
                   13265: =cut
                   13266: 
                   13267: ############################################################
                   13268: ############################################################
                   13269: sub build_recipient_list {
1.619     raeburn  13270:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  13271:     my @recipients;
                   13272:     my $otheremails;
                   13273:     my %domconfig =
                   13274:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   13275:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  13276:         if (exists($domconfig{'contacts'}{$mailing})) {
                   13277:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   13278:                 my @contacts = ('adminemail','supportemail');
                   13279:                 foreach my $item (@contacts) {
                   13280:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   13281:                         my $addr = $domconfig{'contacts'}{$item}; 
                   13282:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13283:                             push(@recipients,$addr);
                   13284:                         }
1.619     raeburn  13285:                     }
1.766     raeburn  13286:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  13287:                 }
                   13288:             }
1.766     raeburn  13289:         } elsif ($origmail ne '') {
                   13290:             push(@recipients,$origmail);
1.618     raeburn  13291:         }
1.619     raeburn  13292:     } elsif ($origmail ne '') {
                   13293:         push(@recipients,$origmail);
1.618     raeburn  13294:     }
1.688     raeburn  13295:     if (defined($defmail)) {
                   13296:         if ($defmail ne '') {
                   13297:             push(@recipients,$defmail);
                   13298:         }
1.618     raeburn  13299:     }
                   13300:     if ($otheremails) {
1.619     raeburn  13301:         my @others;
                   13302:         if ($otheremails =~ /,/) {
                   13303:             @others = split(/,/,$otheremails);
1.618     raeburn  13304:         } else {
1.619     raeburn  13305:             push(@others,$otheremails);
                   13306:         }
                   13307:         foreach my $addr (@others) {
                   13308:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13309:                 push(@recipients,$addr);
                   13310:             }
1.618     raeburn  13311:         }
                   13312:     }
1.619     raeburn  13313:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  13314:     return $recipientlist;
                   13315: }
                   13316: 
1.127     matthew  13317: ############################################################
                   13318: ############################################################
1.154     albertel 13319: 
1.655     raeburn  13320: =pod
                   13321: 
                   13322: =head1 Course Catalog Routines
                   13323: 
                   13324: =over 4
                   13325: 
                   13326: =item * &gather_categories()
                   13327: 
                   13328: Converts category definitions - keys of categories hash stored in  
                   13329: coursecategories in configuration.db on the primary library server in a 
                   13330: domain - to an array.  Also generates javascript and idx hash used to 
                   13331: generate Domain Coordinator interface for editing Course Categories.
                   13332: 
                   13333: Inputs:
1.663     raeburn  13334: 
1.655     raeburn  13335: categories (reference to hash of category definitions).
1.663     raeburn  13336: 
1.655     raeburn  13337: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13338:       categories and subcategories).
1.663     raeburn  13339: 
1.655     raeburn  13340: idx (reference to hash of counters used in Domain Coordinator interface for 
                   13341:       editing Course Categories).
1.663     raeburn  13342: 
1.655     raeburn  13343: jsarray (reference to array of categories used to create Javascript arrays for
                   13344:          Domain Coordinator interface for editing Course Categories).
                   13345: 
                   13346: Returns: nothing
                   13347: 
                   13348: Side effects: populates cats, idx and jsarray. 
                   13349: 
                   13350: =cut
                   13351: 
                   13352: sub gather_categories {
                   13353:     my ($categories,$cats,$idx,$jsarray) = @_;
                   13354:     my %counters;
                   13355:     my $num = 0;
                   13356:     foreach my $item (keys(%{$categories})) {
                   13357:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   13358:         if ($container eq '' && $depth == 0) {
                   13359:             $cats->[$depth][$categories->{$item}] = $cat;
                   13360:         } else {
                   13361:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   13362:         }
                   13363:         my ($escitem,$tail) = split(/:/,$item,2);
                   13364:         if ($counters{$tail} eq '') {
                   13365:             $counters{$tail} = $num;
                   13366:             $num ++;
                   13367:         }
                   13368:         if (ref($idx) eq 'HASH') {
                   13369:             $idx->{$item} = $counters{$tail};
                   13370:         }
                   13371:         if (ref($jsarray) eq 'ARRAY') {
                   13372:             push(@{$jsarray->[$counters{$tail}]},$item);
                   13373:         }
                   13374:     }
                   13375:     return;
                   13376: }
                   13377: 
                   13378: =pod
                   13379: 
                   13380: =item * &extract_categories()
                   13381: 
                   13382: Used to generate breadcrumb trails for course categories.
                   13383: 
                   13384: Inputs:
1.663     raeburn  13385: 
1.655     raeburn  13386: categories (reference to hash of category definitions).
1.663     raeburn  13387: 
1.655     raeburn  13388: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13389:       categories and subcategories).
1.663     raeburn  13390: 
1.655     raeburn  13391: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  13392: 
1.655     raeburn  13393: allitems (reference to hash - key is category key 
                   13394:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13395: 
1.655     raeburn  13396: idx (reference to hash of counters used in Domain Coordinator interface for
                   13397:       editing Course Categories).
1.663     raeburn  13398: 
1.655     raeburn  13399: jsarray (reference to array of categories used to create Javascript arrays for
                   13400:          Domain Coordinator interface for editing Course Categories).
                   13401: 
1.665     raeburn  13402: subcats (reference to hash of arrays containing all subcategories within each 
                   13403:          category, -recursive)
                   13404: 
1.655     raeburn  13405: Returns: nothing
                   13406: 
                   13407: Side effects: populates trails and allitems hash references.
                   13408: 
                   13409: =cut
                   13410: 
                   13411: sub extract_categories {
1.665     raeburn  13412:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  13413:     if (ref($categories) eq 'HASH') {
                   13414:         &gather_categories($categories,$cats,$idx,$jsarray);
                   13415:         if (ref($cats->[0]) eq 'ARRAY') {
                   13416:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   13417:                 my $name = $cats->[0][$i];
                   13418:                 my $item = &escape($name).'::0';
                   13419:                 my $trailstr;
                   13420:                 if ($name eq 'instcode') {
                   13421:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  13422:                 } elsif ($name eq 'communities') {
                   13423:                     $trailstr = &mt('Communities');
1.655     raeburn  13424:                 } else {
                   13425:                     $trailstr = $name;
                   13426:                 }
                   13427:                 if ($allitems->{$item} eq '') {
                   13428:                     push(@{$trails},$trailstr);
                   13429:                     $allitems->{$item} = scalar(@{$trails})-1;
                   13430:                 }
                   13431:                 my @parents = ($name);
                   13432:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   13433:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   13434:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  13435:                         if (ref($subcats) eq 'HASH') {
                   13436:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   13437:                         }
                   13438:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   13439:                     }
                   13440:                 } else {
                   13441:                     if (ref($subcats) eq 'HASH') {
                   13442:                         $subcats->{$item} = [];
1.655     raeburn  13443:                     }
                   13444:                 }
                   13445:             }
                   13446:         }
                   13447:     }
                   13448:     return;
                   13449: }
                   13450: 
                   13451: =pod
                   13452: 
1.1162    raeburn  13453: =item * &recurse_categories()
1.655     raeburn  13454: 
                   13455: Recursively used to generate breadcrumb trails for course categories.
                   13456: 
                   13457: Inputs:
1.663     raeburn  13458: 
1.655     raeburn  13459: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13460:       categories and subcategories).
1.663     raeburn  13461: 
1.655     raeburn  13462: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  13463: 
                   13464: category (current course category, for which breadcrumb trail is being generated).
                   13465: 
                   13466: trails (reference to array of breadcrumb trails for each category).
                   13467: 
1.655     raeburn  13468: allitems (reference to hash - key is category key
                   13469:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13470: 
1.655     raeburn  13471: parents (array containing containers directories for current category, 
                   13472:          back to top level). 
                   13473: 
                   13474: Returns: nothing
                   13475: 
                   13476: Side effects: populates trails and allitems hash references
                   13477: 
                   13478: =cut
                   13479: 
                   13480: sub recurse_categories {
1.665     raeburn  13481:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  13482:     my $shallower = $depth - 1;
                   13483:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   13484:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   13485:             my $name = $cats->[$depth]{$category}[$k];
                   13486:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13487:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13488:             if ($allitems->{$item} eq '') {
                   13489:                 push(@{$trails},$trailstr);
                   13490:                 $allitems->{$item} = scalar(@{$trails})-1;
                   13491:             }
                   13492:             my $deeper = $depth+1;
                   13493:             push(@{$parents},$category);
1.665     raeburn  13494:             if (ref($subcats) eq 'HASH') {
                   13495:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   13496:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   13497:                     my $higher;
                   13498:                     if ($j > 0) {
                   13499:                         $higher = &escape($parents->[$j]).':'.
                   13500:                                   &escape($parents->[$j-1]).':'.$j;
                   13501:                     } else {
                   13502:                         $higher = &escape($parents->[$j]).'::'.$j;
                   13503:                     }
                   13504:                     push(@{$subcats->{$higher}},$subcat);
                   13505:                 }
                   13506:             }
                   13507:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   13508:                                 $subcats);
1.655     raeburn  13509:             pop(@{$parents});
                   13510:         }
                   13511:     } else {
                   13512:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13513:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13514:         if ($allitems->{$item} eq '') {
                   13515:             push(@{$trails},$trailstr);
                   13516:             $allitems->{$item} = scalar(@{$trails})-1;
                   13517:         }
                   13518:     }
                   13519:     return;
                   13520: }
                   13521: 
1.663     raeburn  13522: =pod
                   13523: 
1.1162    raeburn  13524: =item * &assign_categories_table()
1.663     raeburn  13525: 
                   13526: Create a datatable for display of hierarchical categories in a domain,
                   13527: with checkboxes to allow a course to be categorized. 
                   13528: 
                   13529: Inputs:
                   13530: 
                   13531: cathash - reference to hash of categories defined for the domain (from
                   13532:           configuration.db)
                   13533: 
                   13534: currcat - scalar with an & separated list of categories assigned to a course. 
                   13535: 
1.919     raeburn  13536: type    - scalar contains course type (Course or Community).
                   13537: 
1.663     raeburn  13538: Returns: $output (markup to be displayed) 
                   13539: 
                   13540: =cut
                   13541: 
                   13542: sub assign_categories_table {
1.919     raeburn  13543:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  13544:     my $output;
                   13545:     if (ref($cathash) eq 'HASH') {
                   13546:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   13547:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   13548:         $maxdepth = scalar(@cats);
                   13549:         if (@cats > 0) {
                   13550:             my $itemcount = 0;
                   13551:             if (ref($cats[0]) eq 'ARRAY') {
                   13552:                 my @currcategories;
                   13553:                 if ($currcat ne '') {
                   13554:                     @currcategories = split('&',$currcat);
                   13555:                 }
1.919     raeburn  13556:                 my $table;
1.663     raeburn  13557:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   13558:                     my $parent = $cats[0][$i];
1.919     raeburn  13559:                     next if ($parent eq 'instcode');
                   13560:                     if ($type eq 'Community') {
                   13561:                         next unless ($parent eq 'communities');
                   13562:                     } else {
                   13563:                         next if ($parent eq 'communities');
                   13564:                     }
1.663     raeburn  13565:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13566:                     my $item = &escape($parent).'::0';
                   13567:                     my $checked = '';
                   13568:                     if (@currcategories > 0) {
                   13569:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   13570:                             $checked = ' checked="checked"';
1.663     raeburn  13571:                         }
                   13572:                     }
1.919     raeburn  13573:                     my $parent_title = $parent;
                   13574:                     if ($parent eq 'communities') {
                   13575:                         $parent_title = &mt('Communities');
                   13576:                     }
                   13577:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   13578:                               '<input type="checkbox" name="usecategory" value="'.
                   13579:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   13580:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  13581:                     my $depth = 1;
                   13582:                     push(@path,$parent);
1.919     raeburn  13583:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  13584:                     pop(@path);
1.919     raeburn  13585:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  13586:                     $itemcount ++;
                   13587:                 }
1.919     raeburn  13588:                 if ($itemcount) {
                   13589:                     $output = &Apache::loncommon::start_data_table().
                   13590:                               $table.
                   13591:                               &Apache::loncommon::end_data_table();
                   13592:                 }
1.663     raeburn  13593:             }
                   13594:         }
                   13595:     }
                   13596:     return $output;
                   13597: }
                   13598: 
                   13599: =pod
                   13600: 
1.1162    raeburn  13601: =item * &assign_category_rows()
1.663     raeburn  13602: 
                   13603: Create a datatable row for display of nested categories in a domain,
                   13604: with checkboxes to allow a course to be categorized,called recursively.
                   13605: 
                   13606: Inputs:
                   13607: 
                   13608: itemcount - track row number for alternating colors
                   13609: 
                   13610: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   13611:       categories and subcategories.
                   13612: 
                   13613: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   13614: 
                   13615: parent - parent of current category item
                   13616: 
                   13617: path - Array containing all categories back up through the hierarchy from the
                   13618:        current category to the top level.
                   13619: 
                   13620: currcategories - reference to array of current categories assigned to the course
                   13621: 
                   13622: Returns: $output (markup to be displayed).
                   13623: 
                   13624: =cut
                   13625: 
                   13626: sub assign_category_rows {
                   13627:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   13628:     my ($text,$name,$item,$chgstr);
                   13629:     if (ref($cats) eq 'ARRAY') {
                   13630:         my $maxdepth = scalar(@{$cats});
                   13631:         if (ref($cats->[$depth]) eq 'HASH') {
                   13632:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   13633:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   13634:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145    raeburn  13635:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  13636:                 for (my $j=0; $j<$numchildren; $j++) {
                   13637:                     $name = $cats->[$depth]{$parent}[$j];
                   13638:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   13639:                     my $deeper = $depth+1;
                   13640:                     my $checked = '';
                   13641:                     if (ref($currcategories) eq 'ARRAY') {
                   13642:                         if (@{$currcategories} > 0) {
                   13643:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   13644:                                 $checked = ' checked="checked"';
1.663     raeburn  13645:                             }
                   13646:                         }
                   13647:                     }
1.664     raeburn  13648:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   13649:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  13650:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   13651:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   13652:                              '</td><td>';
1.663     raeburn  13653:                     if (ref($path) eq 'ARRAY') {
                   13654:                         push(@{$path},$name);
                   13655:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   13656:                         pop(@{$path});
                   13657:                     }
                   13658:                     $text .= '</td></tr>';
                   13659:                 }
                   13660:                 $text .= '</table></td>';
                   13661:             }
                   13662:         }
                   13663:     }
                   13664:     return $text;
                   13665: }
                   13666: 
1.1181    raeburn  13667: =pod
                   13668: 
                   13669: =back
                   13670: 
                   13671: =cut
                   13672: 
1.655     raeburn  13673: ############################################################
                   13674: ############################################################
                   13675: 
                   13676: 
1.443     albertel 13677: sub commit_customrole {
1.664     raeburn  13678:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  13679:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 13680:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   13681:                          ($end?', ending '.localtime($end):'').': <b>'.
                   13682:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  13683:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 13684:                  '</b><br />';
                   13685:     return $output;
                   13686: }
                   13687: 
                   13688: sub commit_standardrole {
1.1116    raeburn  13689:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  13690:     my ($output,$logmsg,$linefeed);
                   13691:     if ($context eq 'auto') {
                   13692:         $linefeed = "\n";
                   13693:     } else {
                   13694:         $linefeed = "<br />\n";
                   13695:     }  
1.443     albertel 13696:     if ($three eq 'st') {
1.541     raeburn  13697:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116    raeburn  13698:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  13699:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  13700:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   13701:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 13702:         } else {
1.541     raeburn  13703:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 13704:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13705:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   13706:             if ($context eq 'auto') {
                   13707:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   13708:             } else {
                   13709:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   13710:                &mt('Add to classlist').': <b>ok</b>';
                   13711:             }
                   13712:             $output .= $linefeed;
1.443     albertel 13713:         }
                   13714:     } else {
                   13715:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   13716:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13717:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  13718:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  13719:         if ($context eq 'auto') {
                   13720:             $output .= $result.$linefeed;
                   13721:         } else {
                   13722:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   13723:         }
1.443     albertel 13724:     }
                   13725:     return $output;
                   13726: }
                   13727: 
                   13728: sub commit_studentrole {
1.1116    raeburn  13729:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   13730:         $credits) = @_;
1.626     raeburn  13731:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  13732:     if ($context eq 'auto') {
                   13733:         $linefeed = "\n";
                   13734:     } else {
                   13735:         $linefeed = '<br />'."\n";
                   13736:     }
1.443     albertel 13737:     if (defined($one) && defined($two)) {
                   13738:         my $cid=$one.'_'.$two;
                   13739:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   13740:         my $secchange = 0;
                   13741:         my $expire_role_result;
                   13742:         my $modify_section_result;
1.628     raeburn  13743:         if ($oldsec ne '-1') { 
                   13744:             if ($oldsec ne $sec) {
1.443     albertel 13745:                 $secchange = 1;
1.628     raeburn  13746:                 my $now = time;
1.443     albertel 13747:                 my $uurl='/'.$cid;
                   13748:                 $uurl=~s/\_/\//g;
                   13749:                 if ($oldsec) {
                   13750:                     $uurl.='/'.$oldsec;
                   13751:                 }
1.626     raeburn  13752:                 $oldsecurl = $uurl;
1.628     raeburn  13753:                 $expire_role_result = 
1.652     raeburn  13754:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  13755:                 if ($env{'request.course.sec'} ne '') { 
                   13756:                     if ($expire_role_result eq 'refused') {
                   13757:                         my @roles = ('st');
                   13758:                         my @statuses = ('previous');
                   13759:                         my @roledoms = ($one);
                   13760:                         my $withsec = 1;
                   13761:                         my %roleshash = 
                   13762:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   13763:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   13764:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   13765:                             my ($oldstart,$oldend) = 
                   13766:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   13767:                             if ($oldend > 0 && $oldend <= $now) {
                   13768:                                 $expire_role_result = 'ok';
                   13769:                             }
                   13770:                         }
                   13771:                     }
                   13772:                 }
1.443     albertel 13773:                 $result = $expire_role_result;
                   13774:             }
                   13775:         }
                   13776:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116    raeburn  13777:             $modify_section_result = 
                   13778:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   13779:                                                            undef,undef,undef,$sec,
                   13780:                                                            $end,$start,'','',$cid,
                   13781:                                                            '',$context,$credits);
1.443     albertel 13782:             if ($modify_section_result =~ /^ok/) {
                   13783:                 if ($secchange == 1) {
1.628     raeburn  13784:                     if ($sec eq '') {
                   13785:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   13786:                     } else {
                   13787:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   13788:                     }
1.443     albertel 13789:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  13790:                     if ($sec eq '') {
                   13791:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   13792:                     } else {
                   13793:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13794:                     }
1.443     albertel 13795:                 } else {
1.628     raeburn  13796:                     if ($sec eq '') {
                   13797:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   13798:                     } else {
                   13799:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13800:                     }
1.443     albertel 13801:                 }
                   13802:             } else {
1.1115    raeburn  13803:                 if ($secchange) { 
1.628     raeburn  13804:                     $$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;
                   13805:                 } else {
                   13806:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   13807:                 }
1.443     albertel 13808:             }
                   13809:             $result = $modify_section_result;
                   13810:         } elsif ($secchange == 1) {
1.628     raeburn  13811:             if ($oldsec eq '') {
1.1103    raeburn  13812:                 $$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  13813:             } else {
                   13814:                 $$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;
                   13815:             }
1.626     raeburn  13816:             if ($expire_role_result eq 'refused') {
                   13817:                 my $newsecurl = '/'.$cid;
                   13818:                 $newsecurl =~ s/\_/\//g;
                   13819:                 if ($sec ne '') {
                   13820:                     $newsecurl.='/'.$sec;
                   13821:                 }
                   13822:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   13823:                     if ($sec eq '') {
                   13824:                         $$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;
                   13825:                     } else {
                   13826:                         $$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;
                   13827:                     }
                   13828:                 }
                   13829:             }
1.443     albertel 13830:         }
                   13831:     } else {
1.626     raeburn  13832:         $$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 13833:         $result = "error: incomplete course id\n";
                   13834:     }
                   13835:     return $result;
                   13836: }
                   13837: 
1.1108    raeburn  13838: sub show_role_extent {
                   13839:     my ($scope,$context,$role) = @_;
                   13840:     $scope =~ s{^/}{};
                   13841:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   13842:     push(@courseroles,'co');
                   13843:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   13844:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   13845:         $scope =~ s{/}{_};
                   13846:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   13847:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   13848:         my ($audom,$auname) = split(/\//,$scope);
                   13849:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   13850:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   13851:     } else {
                   13852:         $scope =~ s{/$}{};
                   13853:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   13854:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   13855:     }
                   13856: }
                   13857: 
1.443     albertel 13858: ############################################################
                   13859: ############################################################
                   13860: 
1.566     albertel 13861: sub check_clone {
1.578     raeburn  13862:     my ($args,$linefeed) = @_;
1.566     albertel 13863:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   13864:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   13865:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   13866:     my $clonemsg;
                   13867:     my $can_clone = 0;
1.944     raeburn  13868:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  13869:     if ($lctype ne 'community') {
                   13870:         $lctype = 'course';
                   13871:     }
1.566     albertel 13872:     if ($clonehome eq 'no_host') {
1.944     raeburn  13873:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13874:             $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'});
                   13875:         } else {
                   13876:             $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'});
                   13877:         }     
1.566     albertel 13878:     } else {
                   13879: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  13880:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13881:             if ($clonedesc{'type'} ne 'Community') {
                   13882:                  $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'});
                   13883:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13884:             }
                   13885:         }
1.882     raeburn  13886: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   13887:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 13888: 	    $can_clone = 1;
                   13889: 	} else {
                   13890: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   13891: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   13892: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  13893:             if (grep(/^\*$/,@cloners)) {
                   13894:                 $can_clone = 1;
                   13895:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   13896:                 $can_clone = 1;
                   13897:             } else {
1.908     raeburn  13898:                 my $ccrole = 'cc';
1.944     raeburn  13899:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13900:                     $ccrole = 'co';
                   13901:                 }
1.578     raeburn  13902: 	        my %roleshash =
                   13903: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   13904: 					 $args->{'ccdomain'},
1.908     raeburn  13905:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  13906: 					 [$args->{'clonedomain'}]);
1.908     raeburn  13907: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  13908:                     $can_clone = 1;
                   13909:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   13910:                     $can_clone = 1;
                   13911:                 } else {
1.944     raeburn  13912:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13913:                         $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'});
                   13914:                     } else {
                   13915:                         $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'});
                   13916:                     }
1.578     raeburn  13917: 	        }
1.566     albertel 13918: 	    }
1.578     raeburn  13919:         }
1.566     albertel 13920:     }
                   13921:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13922: }
                   13923: 
1.444     albertel 13924: sub construct_course {
1.1166    raeburn  13925:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444     albertel 13926:     my $outcome;
1.541     raeburn  13927:     my $linefeed =  '<br />'."\n";
                   13928:     if ($context eq 'auto') {
                   13929:         $linefeed = "\n";
                   13930:     }
1.566     albertel 13931: 
                   13932: #
                   13933: # Are we cloning?
                   13934: #
                   13935:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13936:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  13937: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 13938: 	if ($context ne 'auto') {
1.578     raeburn  13939:             if ($clonemsg ne '') {
                   13940: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   13941:             }
1.566     albertel 13942: 	}
                   13943: 	$outcome .= $clonemsg.$linefeed;
                   13944: 
                   13945:         if (!$can_clone) {
                   13946: 	    return (0,$outcome);
                   13947: 	}
                   13948:     }
                   13949: 
1.444     albertel 13950: #
                   13951: # Open course
                   13952: #
                   13953:     my $crstype = lc($args->{'crstype'});
                   13954:     my %cenv=();
                   13955:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   13956:                                              $args->{'cdescr'},
                   13957:                                              $args->{'curl'},
                   13958:                                              $args->{'course_home'},
                   13959:                                              $args->{'nonstandard'},
                   13960:                                              $args->{'crscode'},
                   13961:                                              $args->{'ccuname'}.':'.
                   13962:                                              $args->{'ccdomain'},
1.882     raeburn  13963:                                              $args->{'crstype'},
1.885     raeburn  13964:                                              $cnum,$context,$category);
1.444     albertel 13965: 
                   13966:     # Note: The testing routines depend on this being output; see 
                   13967:     # Utils::Course. This needs to at least be output as a comment
                   13968:     # if anyone ever decides to not show this, and Utils::Course::new
                   13969:     # will need to be suitably modified.
1.541     raeburn  13970:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  13971:     if ($$courseid =~ /^error:/) {
                   13972:         return (0,$outcome);
                   13973:     }
                   13974: 
1.444     albertel 13975: #
                   13976: # Check if created correctly
                   13977: #
1.479     albertel 13978:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 13979:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  13980:     if ($crsuhome eq 'no_host') {
                   13981:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   13982:         return (0,$outcome);
                   13983:     }
1.541     raeburn  13984:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 13985: 
1.444     albertel 13986: #
1.566     albertel 13987: # Do the cloning
                   13988: #   
                   13989:     if ($can_clone && $cloneid) {
                   13990: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   13991: 	if ($context ne 'auto') {
                   13992: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   13993: 	}
                   13994: 	$outcome .= $clonemsg.$linefeed;
                   13995: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 13996: # Copy all files
1.637     www      13997: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 13998: # Restore URL
1.566     albertel 13999: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 14000: # Restore title
1.566     albertel 14001: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  14002: # Restore creation date, creator and creation context.
                   14003:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   14004:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   14005:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 14006: # Mark as cloned
1.566     albertel 14007: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      14008: # Need to clone grading mode
                   14009:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   14010:         $cenv{'grading'}=$newenv{'grading'};
                   14011: # Do not clone these environment entries
                   14012:         &Apache::lonnet::del('environment',
                   14013:                   ['default_enrollment_start_date',
                   14014:                    'default_enrollment_end_date',
                   14015:                    'question.email',
                   14016:                    'policy.email',
                   14017:                    'comment.email',
                   14018:                    'pch.users.denied',
1.725     raeburn  14019:                    'plc.users.denied',
                   14020:                    'hidefromcat',
1.1121    raeburn  14021:                    'checkforpriv',
1.1166    raeburn  14022:                    'categories',
                   14023:                    'internal.uniquecode'],
1.638     www      14024:                    $$crsudom,$$crsunum);
1.1170    raeburn  14025:         if ($args->{'textbook'}) {
                   14026:             $cenv{'internal.textbook'} = $args->{'textbook'};
                   14027:         }
1.444     albertel 14028:     }
1.566     albertel 14029: 
1.444     albertel 14030: #
                   14031: # Set environment (will override cloned, if existing)
                   14032: #
                   14033:     my @sections = ();
                   14034:     my @xlists = ();
                   14035:     if ($args->{'crstype'}) {
                   14036:         $cenv{'type'}=$args->{'crstype'};
                   14037:     }
                   14038:     if ($args->{'crsid'}) {
                   14039:         $cenv{'courseid'}=$args->{'crsid'};
                   14040:     }
                   14041:     if ($args->{'crscode'}) {
                   14042:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   14043:     }
                   14044:     if ($args->{'crsquota'} ne '') {
                   14045:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   14046:     } else {
                   14047:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   14048:     }
                   14049:     if ($args->{'ccuname'}) {
                   14050:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   14051:                                         ':'.$args->{'ccdomain'};
                   14052:     } else {
                   14053:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   14054:     }
1.1116    raeburn  14055:     if ($args->{'defaultcredits'}) {
                   14056:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   14057:     }
1.444     albertel 14058:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   14059:     if ($args->{'crssections'}) {
                   14060:         $cenv{'internal.sectionnums'} = '';
                   14061:         if ($args->{'crssections'} =~ m/,/) {
                   14062:             @sections = split/,/,$args->{'crssections'};
                   14063:         } else {
                   14064:             $sections[0] = $args->{'crssections'};
                   14065:         }
                   14066:         if (@sections > 0) {
                   14067:             foreach my $item (@sections) {
                   14068:                 my ($sec,$gp) = split/:/,$item;
                   14069:                 my $class = $args->{'crscode'}.$sec;
                   14070:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   14071:                 $cenv{'internal.sectionnums'} .= $item.',';
                   14072:                 unless ($addcheck eq 'ok') {
                   14073:                     push @badclasses, $class;
                   14074:                 }
                   14075:             }
                   14076:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   14077:         }
                   14078:     }
                   14079: # do not hide course coordinator from staff listing, 
                   14080: # even if privileged
                   14081:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121    raeburn  14082: # add course coordinator's domain to domains to check for privileged users
                   14083: # if different to course domain
                   14084:     if ($$crsudom ne $args->{'ccdomain'}) {
                   14085:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   14086:     }
1.444     albertel 14087: # add crosslistings
                   14088:     if ($args->{'crsxlist'}) {
                   14089:         $cenv{'internal.crosslistings'}='';
                   14090:         if ($args->{'crsxlist'} =~ m/,/) {
                   14091:             @xlists = split/,/,$args->{'crsxlist'};
                   14092:         } else {
                   14093:             $xlists[0] = $args->{'crsxlist'};
                   14094:         }
                   14095:         if (@xlists > 0) {
                   14096:             foreach my $item (@xlists) {
                   14097:                 my ($xl,$gp) = split/:/,$item;
                   14098:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   14099:                 $cenv{'internal.crosslistings'} .= $item.',';
                   14100:                 unless ($addcheck eq 'ok') {
                   14101:                     push @badclasses, $xl;
                   14102:                 }
                   14103:             }
                   14104:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   14105:         }
                   14106:     }
                   14107:     if ($args->{'autoadds'}) {
                   14108:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   14109:     }
                   14110:     if ($args->{'autodrops'}) {
                   14111:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   14112:     }
                   14113: # check for notification of enrollment changes
                   14114:     my @notified = ();
                   14115:     if ($args->{'notify_owner'}) {
                   14116:         if ($args->{'ccuname'} ne '') {
                   14117:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   14118:         }
                   14119:     }
                   14120:     if ($args->{'notify_dc'}) {
                   14121:         if ($uname ne '') { 
1.630     raeburn  14122:             push(@notified,$uname.':'.$udom);
1.444     albertel 14123:         }
                   14124:     }
                   14125:     if (@notified > 0) {
                   14126:         my $notifylist;
                   14127:         if (@notified > 1) {
                   14128:             $notifylist = join(',',@notified);
                   14129:         } else {
                   14130:             $notifylist = $notified[0];
                   14131:         }
                   14132:         $cenv{'internal.notifylist'} = $notifylist;
                   14133:     }
                   14134:     if (@badclasses > 0) {
                   14135:         my %lt=&Apache::lonlocal::texthash(
                   14136:                 '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',
                   14137:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   14138:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   14139:         );
1.541     raeburn  14140:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   14141:                            ' ('.$lt{'adby'}.')';
                   14142:         if ($context eq 'auto') {
                   14143:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 14144:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  14145:             foreach my $item (@badclasses) {
                   14146:                 if ($context eq 'auto') {
                   14147:                     $outcome .= " - $item\n";
                   14148:                 } else {
                   14149:                     $outcome .= "<li>$item</li>\n";
                   14150:                 }
                   14151:             }
                   14152:             if ($context eq 'auto') {
                   14153:                 $outcome .= $linefeed;
                   14154:             } else {
1.566     albertel 14155:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  14156:             }
                   14157:         } 
1.444     albertel 14158:     }
                   14159:     if ($args->{'no_end_date'}) {
                   14160:         $args->{'endaccess'} = 0;
                   14161:     }
                   14162:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   14163:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   14164:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   14165:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   14166:     if ($args->{'showphotos'}) {
                   14167:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   14168:     }
                   14169:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   14170:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   14171:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   14172:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  14173:             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'); 
                   14174:             if ($context eq 'auto') {
                   14175:                 $outcome .= $krb_msg;
                   14176:             } else {
1.566     albertel 14177:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  14178:             }
                   14179:             $outcome .= $linefeed;
1.444     albertel 14180:         }
                   14181:     }
                   14182:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   14183:        if ($args->{'setpolicy'}) {
                   14184:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14185:        }
                   14186:        if ($args->{'setcontent'}) {
                   14187:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14188:        }
                   14189:     }
                   14190:     if ($args->{'reshome'}) {
                   14191: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   14192: 	$cenv{'reshome'}=~s/\/+$/\//;
                   14193:     }
                   14194: #
                   14195: # course has keyed access
                   14196: #
                   14197:     if ($args->{'setkeys'}) {
                   14198:        $cenv{'keyaccess'}='yes';
                   14199:     }
                   14200: # if specified, key authority is not course, but user
                   14201: # only active if keyaccess is yes
                   14202:     if ($args->{'keyauth'}) {
1.487     albertel 14203: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   14204: 	$user = &LONCAPA::clean_username($user);
                   14205: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     14206: 	if ($user ne '' && $domain ne '') {
1.487     albertel 14207: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 14208: 	}
                   14209:     }
                   14210: 
1.1166    raeburn  14211: #
1.1167    raeburn  14212: #  generate and store uniquecode (available to course requester), if course should have one.
1.1166    raeburn  14213: #
                   14214:     if ($args->{'uniquecode'}) {
                   14215:         my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
                   14216:         if ($code) {
                   14217:             $cenv{'internal.uniquecode'} = $code;
1.1167    raeburn  14218:             my %crsinfo =
                   14219:                 &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
                   14220:             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   14221:                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   14222:                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
                   14223:             } 
1.1166    raeburn  14224:             if (ref($coderef)) {
                   14225:                 $$coderef = $code;
                   14226:             }
                   14227:         }
                   14228:     }
                   14229: 
1.444     albertel 14230:     if ($args->{'disresdis'}) {
                   14231:         $cenv{'pch.roles.denied'}='st';
                   14232:     }
                   14233:     if ($args->{'disablechat'}) {
                   14234:         $cenv{'plc.roles.denied'}='st';
                   14235:     }
                   14236: 
                   14237:     # Record we've not yet viewed the Course Initialization Helper for this 
                   14238:     # course
                   14239:     $cenv{'course.helper.not.run'} = 1;
                   14240:     #
                   14241:     # Use new Randomseed
                   14242:     #
                   14243:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   14244:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   14245:     #
                   14246:     # The encryption code and receipt prefix for this course
                   14247:     #
                   14248:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   14249:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   14250:     #
                   14251:     # By default, use standard grading
                   14252:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   14253: 
1.541     raeburn  14254:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   14255:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14256: #
                   14257: # Open all assignments
                   14258: #
                   14259:     if ($args->{'openall'}) {
                   14260:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   14261:        my %storecontent = ($storeunder         => time,
                   14262:                            $storeunder.'.type' => 'date_start');
                   14263:        
                   14264:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  14265:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14266:    }
                   14267: #
                   14268: # Set first page
                   14269: #
                   14270:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   14271: 	    || ($cloneid)) {
1.445     albertel 14272: 	use LONCAPA::map;
1.444     albertel 14273: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 14274: 
                   14275: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   14276:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   14277: 
1.444     albertel 14278:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   14279:         my $title; my $url;
                   14280:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   14281: 	    $title=&mt('Syllabus');
1.444     albertel 14282:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   14283:         } else {
1.963     raeburn  14284:             $title=&mt('Table of Contents');
1.444     albertel 14285:             $url='/adm/navmaps';
                   14286:         }
1.445     albertel 14287: 
                   14288:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   14289: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   14290: 
                   14291: 	if ($errtext) { $fatal=2; }
1.541     raeburn  14292:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 14293:     }
1.566     albertel 14294: 
                   14295:     return (1,$outcome);
1.444     albertel 14296: }
                   14297: 
1.1166    raeburn  14298: sub make_unique_code {
                   14299:     my ($cdom,$cnum) = @_;
                   14300:     # get lock on uniquecodes db
                   14301:     my $lockhash = {
                   14302:                       $cnum."\0".'uniquecodes' => $env{'user.name'}.
                   14303:                                                   ':'.$env{'user.domain'},
                   14304:                    };
                   14305:     my $tries = 0;
                   14306:     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   14307:     my ($code,$error);
                   14308:   
                   14309:     while (($gotlock ne 'ok') && ($tries<3)) {
                   14310:         $tries ++;
                   14311:         sleep 1;
                   14312:         $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   14313:     }
                   14314:     if ($gotlock eq 'ok') {
                   14315:         my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
                   14316:         my $gotcode;
                   14317:         my $attempts = 0;
                   14318:         while ((!$gotcode) && ($attempts < 100)) {
                   14319:             $code = &generate_code();
                   14320:             if (!exists($currcodes{$code})) {
                   14321:                 $gotcode = 1;
                   14322:                 unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                   14323:                     $error = 'nostore';
                   14324:                 }
                   14325:             }
                   14326:             $attempts ++;
                   14327:         }
                   14328:         my @del_lock = ($cnum."\0".'uniquecodes');
                   14329:         my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
                   14330:     } else {
                   14331:         $error = 'nolock';
                   14332:     }
                   14333:     return ($code,$error);
                   14334: }
                   14335: 
                   14336: sub generate_code {
                   14337:     my $code;
                   14338:     my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
                   14339:     for (my $i=0; $i<6; $i++) {
                   14340:         my $lettnum = int (rand 2);
                   14341:         my $item = '';
                   14342:         if ($lettnum) {
                   14343:             $item = $letts[int( rand(18) )];
                   14344:         } else {
                   14345:             $item = 1+int( rand(8) );
                   14346:         }
                   14347:         $code .= $item;
                   14348:     }
                   14349:     return $code;
                   14350: }
                   14351: 
1.444     albertel 14352: ############################################################
                   14353: ############################################################
                   14354: 
1.953     droeschl 14355: #SD
                   14356: # only Community and Course, or anything else?
1.378     raeburn  14357: sub course_type {
                   14358:     my ($cid) = @_;
                   14359:     if (!defined($cid)) {
                   14360:         $cid = $env{'request.course.id'};
                   14361:     }
1.404     albertel 14362:     if (defined($env{'course.'.$cid.'.type'})) {
                   14363:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  14364:     } else {
                   14365:         return 'Course';
1.377     raeburn  14366:     }
                   14367: }
1.156     albertel 14368: 
1.406     raeburn  14369: sub group_term {
                   14370:     my $crstype = &course_type();
                   14371:     my %names = (
                   14372:                   'Course' => 'group',
1.865     raeburn  14373:                   'Community' => 'group',
1.406     raeburn  14374:                 );
                   14375:     return $names{$crstype};
                   14376: }
                   14377: 
1.902     raeburn  14378: sub course_types {
1.1165    raeburn  14379:     my @types = ('official','unofficial','community','textbook');
1.902     raeburn  14380:     my %typename = (
                   14381:                          official   => 'Official course',
                   14382:                          unofficial => 'Unofficial course',
                   14383:                          community  => 'Community',
1.1165    raeburn  14384:                          textbook   => 'Textbook course',
1.902     raeburn  14385:                    );
                   14386:     return (\@types,\%typename);
                   14387: }
                   14388: 
1.156     albertel 14389: sub icon {
                   14390:     my ($file)=@_;
1.505     albertel 14391:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 14392:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 14393:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 14394:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   14395: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   14396: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14397: 	            $curfext.".gif") {
                   14398: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14399: 		$curfext.".gif";
                   14400: 	}
                   14401:     }
1.249     albertel 14402:     return &lonhttpdurl($iconname);
1.154     albertel 14403: } 
1.84      albertel 14404: 
1.575     albertel 14405: sub lonhttpdurl {
1.692     www      14406: #
                   14407: # Had been used for "small fry" static images on separate port 8080.
                   14408: # Modify here if lightweight http functionality desired again.
                   14409: # Currently eliminated due to increasing firewall issues.
                   14410: #
1.575     albertel 14411:     my ($url)=@_;
1.692     www      14412:     return $url;
1.215     albertel 14413: }
                   14414: 
1.213     albertel 14415: sub connection_aborted {
                   14416:     my ($r)=@_;
                   14417:     $r->print(" ");$r->rflush();
                   14418:     my $c = $r->connection;
                   14419:     return $c->aborted();
                   14420: }
                   14421: 
1.221     foxr     14422: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     14423: #    strings as 'strings'.
                   14424: sub escape_single {
1.221     foxr     14425:     my ($input) = @_;
1.223     albertel 14426:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     14427:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   14428:     return $input;
                   14429: }
1.223     albertel 14430: 
1.222     foxr     14431: #  Same as escape_single, but escape's "'s  This 
                   14432: #  can be used for  "strings"
                   14433: sub escape_double {
                   14434:     my ($input) = @_;
                   14435:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   14436:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   14437:     return $input;
                   14438: }
1.223     albertel 14439:  
1.222     foxr     14440: #   Escapes the last element of a full URL.
                   14441: sub escape_url {
                   14442:     my ($url)   = @_;
1.238     raeburn  14443:     my @urlslices = split(/\//, $url,-1);
1.369     www      14444:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 14445:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     14446: }
1.462     albertel 14447: 
1.820     raeburn  14448: sub compare_arrays {
                   14449:     my ($arrayref1,$arrayref2) = @_;
                   14450:     my (@difference,%count);
                   14451:     @difference = ();
                   14452:     %count = ();
                   14453:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   14454:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   14455:         foreach my $element (keys(%count)) {
                   14456:             if ($count{$element} == 1) {
                   14457:                 push(@difference,$element);
                   14458:             }
                   14459:         }
                   14460:     }
                   14461:     return @difference;
                   14462: }
                   14463: 
1.817     bisitz   14464: # -------------------------------------------------------- Initialize user login
1.462     albertel 14465: sub init_user_environment {
1.463     albertel 14466:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 14467:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   14468: 
                   14469:     my $public=($username eq 'public' && $domain eq 'public');
                   14470: 
                   14471: # See if old ID present, if so, remove
                   14472: 
1.1062    raeburn  14473:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 14474:     my $now=time;
                   14475: 
                   14476:     if ($public) {
                   14477: 	my $max_public=100;
                   14478: 	my $oldest;
                   14479: 	my $oldest_time=0;
                   14480: 	for(my $next=1;$next<=$max_public;$next++) {
                   14481: 	    if (-e $lonids."/publicuser_$next.id") {
                   14482: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   14483: 		if ($mtime<$oldest_time || !$oldest_time) {
                   14484: 		    $oldest_time=$mtime;
                   14485: 		    $oldest=$next;
                   14486: 		}
                   14487: 	    } else {
                   14488: 		$cookie="publicuser_$next";
                   14489: 		last;
                   14490: 	    }
                   14491: 	}
                   14492: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   14493:     } else {
1.463     albertel 14494: 	# if this isn't a robot, kill any existing non-robot sessions
                   14495: 	if (!$args->{'robot'}) {
                   14496: 	    opendir(DIR,$lonids);
                   14497: 	    while ($filename=readdir(DIR)) {
                   14498: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   14499: 		    unlink($lonids.'/'.$filename);
                   14500: 		}
1.462     albertel 14501: 	    }
1.463     albertel 14502: 	    closedir(DIR);
1.462     albertel 14503: 	}
                   14504: # Give them a new cookie
1.463     albertel 14505: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      14506: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 14507: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 14508:     
                   14509: # Initialize roles
                   14510: 
1.1062    raeburn  14511: 	($userroles,$firstaccenv,$timerintenv) = 
                   14512:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 14513:     }
                   14514: # ------------------------------------ Check browser type and MathML capability
                   14515: 
                   14516:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1141    raeburn  14517:         $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r);
1.462     albertel 14518: 
                   14519: # ------------------------------------------------------------- Get environment
                   14520: 
                   14521:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   14522:     my ($tmp) = keys(%userenv);
                   14523:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   14524:     } else {
                   14525: 	undef(%userenv);
                   14526:     }
                   14527:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   14528: 	$form->{'interface'}=$userenv{'interface'};
                   14529:     }
                   14530:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   14531: 
                   14532: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   14533:     foreach my $option ('interface','localpath','localres') {
                   14534:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 14535:     }
                   14536: # --------------------------------------------------------- Write first profile
                   14537: 
                   14538:     {
                   14539: 	my %initial_env = 
                   14540: 	    ("user.name"          => $username,
                   14541: 	     "user.domain"        => $domain,
                   14542: 	     "user.home"          => $authhost,
                   14543: 	     "browser.type"       => $clientbrowser,
                   14544: 	     "browser.version"    => $clientversion,
                   14545: 	     "browser.mathml"     => $clientmathml,
                   14546: 	     "browser.unicode"    => $clientunicode,
                   14547: 	     "browser.os"         => $clientos,
1.1137    raeburn  14548:              "browser.mobile"     => $clientmobile,
1.1141    raeburn  14549:              "browser.info"       => $clientinfo,
1.462     albertel 14550: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   14551: 	     "request.course.fn"  => '',
                   14552: 	     "request.course.uri" => '',
                   14553: 	     "request.course.sec" => '',
                   14554: 	     "request.role"       => 'cm',
                   14555: 	     "request.role.adv"   => $env{'user.adv'},
                   14556: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   14557: 
                   14558:         if ($form->{'localpath'}) {
                   14559: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   14560: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   14561:         }
                   14562: 	
                   14563: 	if ($form->{'interface'}) {
                   14564: 	    $form->{'interface'}=~s/\W//gs;
                   14565: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   14566: 	    $env{'browser.interface'}=$form->{'interface'};
                   14567: 	}
                   14568: 
1.1157    raeburn  14569:         if ($form->{'iptoken'}) {
                   14570:             my $lonhost = $r->dir_config('lonHostID');
                   14571:             $initial_env{"user.noloadbalance"} = $lonhost;
                   14572:             $env{'user.noloadbalance'} = $lonhost;
                   14573:         }
                   14574: 
1.981     raeburn  14575:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  14576:         my %domdef;
                   14577:         unless ($domain eq 'public') {
                   14578:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   14579:         }
1.980     raeburn  14580: 
1.1081    raeburn  14581:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  14582:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  14583:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   14584:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  14585:         }
                   14586: 
1.1165    raeburn  14587:         foreach my $crstype ('official','unofficial','community','textbook') {
1.765     raeburn  14588:             $userenv{'canrequest.'.$crstype} =
                   14589:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  14590:                                                   'reload','requestcourses',
                   14591:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  14592:         }
                   14593: 
1.1092    raeburn  14594:         $userenv{'canrequest.author'} =
                   14595:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   14596:                                         'reload','requestauthor',
                   14597:                                         \%userenv,\%domdef,\%is_adv);
                   14598:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   14599:                                              $domain,$username);
                   14600:         my $reqstatus = $reqauthor{'author_status'};
                   14601:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { 
                   14602:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   14603:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   14604:                                                   $reqauthor{'author'}{'timestamp'};
                   14605:             }
                   14606:         }
                   14607: 
1.462     albertel 14608: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  14609: 
1.462     albertel 14610: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   14611: 		 &GDBM_WRCREAT(),0640)) {
                   14612: 	    &_add_to_env(\%disk_env,\%initial_env);
                   14613: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   14614: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  14615:             if (ref($firstaccenv) eq 'HASH') {
                   14616:                 &_add_to_env(\%disk_env,$firstaccenv);
                   14617:             }
                   14618:             if (ref($timerintenv) eq 'HASH') {
                   14619:                 &_add_to_env(\%disk_env,$timerintenv);
                   14620:             }
1.463     albertel 14621: 	    if (ref($args->{'extra_env'})) {
                   14622: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   14623: 	    }
1.462     albertel 14624: 	    untie(%disk_env);
                   14625: 	} else {
1.705     tempelho 14626: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   14627: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 14628: 	    return 'error: '.$!;
                   14629: 	}
                   14630:     }
                   14631:     $env{'request.role'}='cm';
                   14632:     $env{'request.role.adv'}=$env{'user.adv'};
                   14633:     $env{'browser.type'}=$clientbrowser;
                   14634: 
                   14635:     return $cookie;
                   14636: 
                   14637: }
                   14638: 
                   14639: sub _add_to_env {
                   14640:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  14641:     if (ref($env_data) eq 'HASH') {
                   14642:         while (my ($key,$value) = each(%$env_data)) {
                   14643: 	    $idf->{$prefix.$key} = $value;
                   14644: 	    $env{$prefix.$key}   = $value;
                   14645:         }
1.462     albertel 14646:     }
                   14647: }
                   14648: 
1.685     tempelho 14649: # --- Get the symbolic name of a problem and the url
                   14650: sub get_symb {
                   14651:     my ($request,$silent) = @_;
1.726     raeburn  14652:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 14653:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   14654:     if ($symb eq '') {
                   14655:         if (!$silent) {
1.1071    raeburn  14656:             if (ref($request)) { 
                   14657:                 $request->print("Unable to handle ambiguous references:$url:.");
                   14658:             }
1.685     tempelho 14659:             return ();
                   14660:         }
                   14661:     }
                   14662:     &Apache::lonenc::check_decrypt(\$symb);
                   14663:     return ($symb);
                   14664: }
                   14665: 
                   14666: # --------------------------------------------------------------Get annotation
                   14667: 
                   14668: sub get_annotation {
                   14669:     my ($symb,$enc) = @_;
                   14670: 
                   14671:     my $key = $symb;
                   14672:     if (!$enc) {
                   14673:         $key =
                   14674:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   14675:     }
                   14676:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   14677:     return $annotation{$key};
                   14678: }
                   14679: 
                   14680: sub clean_symb {
1.731     raeburn  14681:     my ($symb,$delete_enc) = @_;
1.685     tempelho 14682: 
                   14683:     &Apache::lonenc::check_decrypt(\$symb);
                   14684:     my $enc = $env{'request.enc'};
1.731     raeburn  14685:     if ($delete_enc) {
1.730     raeburn  14686:         delete($env{'request.enc'});
                   14687:     }
1.685     tempelho 14688: 
                   14689:     return ($symb,$enc);
                   14690: }
1.462     albertel 14691: 
1.1181    raeburn  14692: ############################################################
                   14693: ############################################################
                   14694: 
                   14695: =pod
                   14696: 
                   14697: =head1 Routines for building display used to search for courses
                   14698: 
                   14699: 
                   14700: =over 4
                   14701: 
                   14702: =item * &build_filters()
                   14703: 
                   14704: Create markup for a table used to set filters to use when selecting
1.1182    raeburn  14705: courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
                   14706: and quotacheck.pl
                   14707: 
1.1181    raeburn  14708: 
                   14709: Inputs:
                   14710: 
                   14711: filterlist - anonymous array of fields to include as potential filters 
                   14712: 
                   14713: crstype - course type
                   14714: 
                   14715: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                   14716:               to pop-open a course selector (will contain "extra element"). 
                   14717: 
                   14718: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
                   14719: 
                   14720: filter - anonymous hash of criteria and their values
                   14721: 
                   14722: action - form action
                   14723: 
                   14724: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
                   14725: 
1.1182    raeburn  14726: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181    raeburn  14727: 
                   14728: cloneruname - username of owner of new course who wants to clone
                   14729: 
                   14730: clonerudom - domain of owner of new course who wants to clone
                   14731: 
                   14732: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community) 
                   14733: 
                   14734: codetitlesref - reference to array of titles of components in institutional codes (official courses)
                   14735: 
                   14736: codedom - domain
                   14737: 
                   14738: formname - value of form element named "form". 
                   14739: 
                   14740: fixeddom - domain, if fixed.
                   14741: 
                   14742: prevphase - value to assign to form element named "phase" when going back to the previous screen  
                   14743: 
                   14744: cnameelement - name of form element in form on opener page which will receive title of selected course 
                   14745: 
                   14746: cnumelement - name of form element in form on opener page which will receive courseID  of selected course
                   14747: 
                   14748: cdomelement - name of form element in form on opener page which will receive domain of selected course
                   14749: 
                   14750: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
                   14751: 
                   14752: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
                   14753: 
                   14754: clonewarning - warning message about missing information for intended course owner when DC creates a course
                   14755: 
1.1182    raeburn  14756: 
1.1181    raeburn  14757: Returns: $output - HTML for display of search criteria, and hidden form elements.
                   14758: 
1.1182    raeburn  14759: 
1.1181    raeburn  14760: Side Effects: None
                   14761: 
                   14762: =cut
                   14763: 
                   14764: # ---------------------------------------------- search for courses based on last activity etc.
                   14765: 
                   14766: sub build_filters {
                   14767:     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
                   14768:         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
                   14769:         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
                   14770:         $cnameelement,$cnumelement,$cdomelement,$setroles,
                   14771:         $clonetext,$clonewarning) = @_;
1.1182    raeburn  14772:     my ($list,$jscript);
1.1181    raeburn  14773:     my $onchange = 'javascript:updateFilters(this)';
                   14774:     my ($domainselectform,$sincefilterform,$createdfilterform,
                   14775:         $ownerdomselectform,$persondomselectform,$instcodeform,
                   14776:         $typeselectform,$instcodetitle);
                   14777:     if ($formname eq '') {
                   14778:         $formname = $caller;
                   14779:     }
                   14780:     foreach my $item (@{$filterlist}) {
                   14781:         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   14782:                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
                   14783:             if ($item eq 'domainfilter') {
                   14784:                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
                   14785:             } elsif ($item eq 'coursefilter') {
                   14786:                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
                   14787:             } elsif ($item eq 'ownerfilter') {
                   14788:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   14789:             } elsif ($item eq 'ownerdomfilter') {
                   14790:                 $filter->{'ownerdomfilter'} =
                   14791:                     &LONCAPA::clean_domain($filter->{$item});
                   14792:                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                   14793:                                                        'ownerdomfilter',1);
                   14794:             } elsif ($item eq 'personfilter') {
                   14795:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   14796:             } elsif ($item eq 'persondomfilter') {
                   14797:                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                   14798:                                                         'persondomfilter',1);
                   14799:             } else {
                   14800:                 $filter->{$item} =~ s/\W//g;
                   14801:             }
                   14802:             if (!$filter->{$item}) {
                   14803:                 $filter->{$item} = '';
                   14804:             }
                   14805:         }
                   14806:         if ($item eq 'domainfilter') {
                   14807:             my $allow_blank = 1;
                   14808:             if ($formname eq 'portform') {
                   14809:                 $allow_blank=0;
                   14810:             } elsif ($formname eq 'studentform') {
                   14811:                 $allow_blank=0;
                   14812:             }
                   14813:             if ($fixeddom) {
                   14814:                 $domainselectform = '<input type="hidden" name="domainfilter"'.
                   14815:                                     ' value="'.$codedom.'" />'.
                   14816:                                     &Apache::lonnet::domain($codedom,'description');
                   14817:             } else {
                   14818:                 $domainselectform = &select_dom_form($filter->{$item},
                   14819:                                                      'domainfilter',
                   14820:                                                       $allow_blank,'',$onchange);
                   14821:             }
                   14822:         } else {
                   14823:             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
                   14824:         }
                   14825:     }
                   14826: 
                   14827:     # last course activity filter and selection
                   14828:     $sincefilterform = &timebased_select_form('sincefilter',$filter);
                   14829: 
                   14830:     # course created filter and selection
                   14831:     if (exists($filter->{'createdfilter'})) {
                   14832:         $createdfilterform = &timebased_select_form('createdfilter',$filter);
                   14833:     }
                   14834: 
                   14835:     my %lt = &Apache::lonlocal::texthash(
                   14836:                 'cac' => "$crstype Activity",
                   14837:                 'ccr' => "$crstype Created",
                   14838:                 'cde' => "$crstype Title",
                   14839:                 'cdo' => "$crstype Domain",
                   14840:                 'ins' => 'Institutional Code',
                   14841:                 'inc' => 'Institutional Categorization',
                   14842:                 'cow' => "$crstype Owner/Co-owner",
                   14843:                 'cop' => "$crstype Personnel Includes",
                   14844:                 'cog' => 'Type',
                   14845:              );
                   14846: 
                   14847:     if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   14848:         my $typeval = 'Course';
                   14849:         if ($crstype eq 'Community') {
                   14850:             $typeval = 'Community';
                   14851:         }
                   14852:         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
                   14853:     } else {
                   14854:         $typeselectform =  '<select name="type" size="1"';
                   14855:         if ($onchange) {
                   14856:             $typeselectform .= ' onchange="'.$onchange.'"';
                   14857:         }
                   14858:         $typeselectform .= '>'."\n";
                   14859:         foreach my $posstype ('Course','Community') {
                   14860:             $typeselectform.='<option value="'.$posstype.'"'.
                   14861:                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
                   14862:         }
                   14863:         $typeselectform.="</select>";
                   14864:     }
                   14865: 
                   14866:     my ($cloneableonlyform,$cloneabletitle);
                   14867:     if (exists($filter->{'cloneableonly'})) {
                   14868:         my $cloneableon = '';
                   14869:         my $cloneableoff = ' checked="checked"';
                   14870:         if ($filter->{'cloneableonly'}) {
                   14871:             $cloneableon = $cloneableoff;
                   14872:             $cloneableoff = '';
                   14873:         }
                   14874:         $cloneableonlyform = '<span class="LC_nobreak"><label><input type="radio" name="cloneableonly" value="1" '.$cloneableon.'/>&nbsp;'.&mt('Required').'</label>'.('&nbsp;'x3).'<label><input type="radio" name="cloneableonly" value="" '.$cloneableoff.' />&nbsp;'.&mt('No restriction').'</label></span>';
                   14875:         if ($formname eq 'ccrs') {
                   14876:             $cloneabletitle = &mt('Cloneable for').' '.$cloneruname.':'.$clonerudom;
                   14877:         } else {
                   14878:             $cloneabletitle = &mt('Cloneable by you');
                   14879:         }
                   14880:     }
                   14881:     my $officialjs;
                   14882:     if ($crstype eq 'Course') {
                   14883:         if (exists($filter->{'instcodefilter'})) {
1.1182    raeburn  14884: #            if (($fixeddom) || ($formname eq 'requestcrs') ||
                   14885: #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
                   14886:             if ($codedom) { 
1.1181    raeburn  14887:                 $officialjs = 1;
                   14888:                 ($instcodeform,$jscript,$$numtitlesref) =
                   14889:                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                   14890:                                                                   $officialjs,$codetitlesref);
                   14891:                 if ($jscript) {
1.1182    raeburn  14892:                     $jscript = '<script type="text/javascript">'."\n".
                   14893:                                '// <![CDATA['."\n".
                   14894:                                $jscript."\n".
                   14895:                                '// ]]>'."\n".
                   14896:                                '</script>'."\n";
1.1181    raeburn  14897:                 }
                   14898:             }
                   14899:             if ($instcodeform eq '') {
                   14900:                 $instcodeform =
                   14901:                     '<input type="text" name="instcodefilter" size="10" value="'.
                   14902:                     $list->{'instcodefilter'}.'" />';
                   14903:                 $instcodetitle = $lt{'ins'};
                   14904:             } else {
                   14905:                 $instcodetitle = $lt{'inc'};
                   14906:             }
                   14907:             if ($fixeddom) {
                   14908:                 $instcodetitle .= '<br />('.$codedom.')';
                   14909:             }
                   14910:         }
                   14911:     }
                   14912:     my $output = qq|
                   14913: <form method="post" name="filterpicker" action="$action">
                   14914: <input type="hidden" name="form" value="$formname" />
                   14915: |;
                   14916:     if ($formname eq 'modifycourse') {
                   14917:         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                   14918:                    '<input type="hidden" name="prevphase" value="'.
                   14919:                    $prevphase.'" />'."\n";
1.1182    raeburn  14920:     } elsif ($formname ne 'quotacheck') {
1.1181    raeburn  14921:         my $name_input;
                   14922:         if ($cnameelement ne '') {
                   14923:             $name_input = '<input type="hidden" name="cnameelement" value="'.
                   14924:                           $cnameelement.'" />';
                   14925:         }
                   14926:         $output .= qq|
1.1182    raeburn  14927: <input type="hidden" name="cnumelement" value="$cnumelement" />
                   14928: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181    raeburn  14929: $name_input
                   14930: $roleelement
                   14931: $multelement
                   14932: $typeelement
                   14933: |;
                   14934:         if ($formname eq 'portform') {
                   14935:             $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
                   14936:         }
                   14937:     }
                   14938:     if ($fixeddom) {
                   14939:         $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
                   14940:     }
                   14941:     $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
                   14942:     if ($sincefilterform) {
                   14943:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                   14944:                   .$sincefilterform
                   14945:                   .&Apache::lonhtmlcommon::row_closure();
                   14946:     }
                   14947:     if ($createdfilterform) {
                   14948:         $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                   14949:                   .$createdfilterform
                   14950:                   .&Apache::lonhtmlcommon::row_closure();
                   14951:     }
                   14952:     if ($domainselectform) {
                   14953:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                   14954:                   .$domainselectform
                   14955:                   .&Apache::lonhtmlcommon::row_closure();
                   14956:     }
                   14957:     if ($typeselectform) {
                   14958:         if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   14959:             $output .= $typeselectform;
                   14960:         } else {
                   14961:             $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                   14962:                       .$typeselectform
                   14963:                       .&Apache::lonhtmlcommon::row_closure();
                   14964:         }
                   14965:     }
                   14966:     if ($instcodeform) {
                   14967:         $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                   14968:                   .$instcodeform
                   14969:                   .&Apache::lonhtmlcommon::row_closure();
                   14970:     }
                   14971:     if (exists($filter->{'ownerfilter'})) {
                   14972:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                   14973:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   14974:                    '<input type="text" name="ownerfilter" size="20" value="'.
                   14975:                    $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   14976:                    $ownerdomselectform.'</td></tr></table>'.
                   14977:                    &Apache::lonhtmlcommon::row_closure();
                   14978:     }
                   14979:     if (exists($filter->{'personfilter'})) {
                   14980:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                   14981:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   14982:                    '<input type="text" name="personfilter" size="20" value="'.
                   14983:                    $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   14984:                    $persondomselectform.'</td></tr></table>'.
                   14985:                    &Apache::lonhtmlcommon::row_closure();
                   14986:     }
                   14987:     if (exists($filter->{'coursefilter'})) {
                   14988:         $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                   14989:                   .'<input type="text" name="coursefilter" size="25" value="'
                   14990:                   .$list->{'coursefilter'}.'" />'
                   14991:                   .&Apache::lonhtmlcommon::row_closure();
                   14992:     }
                   14993:     if ($cloneableonlyform) {
                   14994:         $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                   14995:                    $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
                   14996:     }
                   14997:     if (exists($filter->{'descriptfilter'})) {
                   14998:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                   14999:                   .'<input type="text" name="descriptfilter" size="40" value="'
                   15000:                   .$list->{'descriptfilter'}.'" />'
                   15001:                   .&Apache::lonhtmlcommon::row_closure(1);
                   15002:     }
                   15003:     $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                   15004:                '<input type="hidden" name="updater" value="" />'."\n".
                   15005:                '<input type="submit" name="gosearch" value="'.
                   15006:                &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
                   15007:     return $jscript.$clonewarning.$output;
                   15008: }
                   15009: 
                   15010: =pod 
                   15011: 
                   15012: =item * &timebased_select_form()
                   15013: 
1.1182    raeburn  15014: Create markup for a dropdown list used to select a time-based
1.1181    raeburn  15015: filter e.g., Course Activity, Course Created, when searching for courses
                   15016: or communities
                   15017: 
                   15018: Inputs:
                   15019: 
                   15020: item - name of form element (sincefilter or createdfilter)
                   15021: 
                   15022: filter - anonymous hash of criteria and their values
                   15023: 
                   15024: Returns: HTML for a select box contained a blank, then six time selections,
                   15025:          with value set in incoming form variables currently selected. 
                   15026: 
                   15027: Side Effects: None
                   15028: 
                   15029: =cut
                   15030: 
                   15031: sub timebased_select_form {
                   15032:     my ($item,$filter) = @_;
                   15033:     if (ref($filter) eq 'HASH') {
                   15034:         $filter->{$item} =~ s/[^\d-]//g;
                   15035:         if (!$filter->{$item}) { $filter->{$item}=-1; }
                   15036:         return &select_form(
                   15037:                             $filter->{$item},
                   15038:                             $item,
                   15039:                             {      '-1' => '',
                   15040:                                 '86400' => &mt('today'),
                   15041:                                '604800' => &mt('last week'),
                   15042:                               '2592000' => &mt('last month'),
                   15043:                               '7776000' => &mt('last three months'),
                   15044:                              '15552000' => &mt('last six months'),
                   15045:                              '31104000' => &mt('last year'),
                   15046:                     'select_form_order' =>
                   15047:                            ['-1','86400','604800','2592000','7776000',
                   15048:                             '15552000','31104000']});
                   15049:     }
                   15050: }
                   15051: 
                   15052: =pod
                   15053: 
                   15054: =item * &js_changer()
                   15055: 
                   15056: Create script tag containing Javascript used to submit course search form
1.1183  ! raeburn  15057: when course type or domain is changed, and also to hide 'Searching ...' on
        !          15058: page load completion for page showing search result.
1.1181    raeburn  15059: 
                   15060: Inputs: None
                   15061: 
1.1183  ! raeburn  15062: Returns: markup containing updateFilters() and hideSearching() javascript functions. 
1.1181    raeburn  15063: 
                   15064: Side Effects: None
                   15065: 
                   15066: =cut
                   15067: 
                   15068: sub js_changer {
                   15069:     return <<ENDJS;
                   15070: <script type="text/javascript">
                   15071: // <![CDATA[
                   15072: function updateFilters(caller) {
                   15073:     if (typeof(caller) != "undefined") {
                   15074:         document.filterpicker.updater.value = caller.name;
                   15075:     }
                   15076:     document.filterpicker.submit();
                   15077: }
1.1183  ! raeburn  15078: 
        !          15079: function hideSearching() {
        !          15080:     if (document.getElementById('searching')) {
        !          15081:         document.getElementById('searching').style.display = 'none';
        !          15082:     }
        !          15083:     return;
        !          15084: }
        !          15085: 
1.1181    raeburn  15086: // ]]>
                   15087: </script>
                   15088: 
                   15089: ENDJS
                   15090: }
                   15091: 
                   15092: =pod
                   15093: 
1.1182    raeburn  15094: =item * &search_courses()
                   15095: 
                   15096: Process selected filters form course search form and pass to lonnet::courseiddump
                   15097: to retrieve a hash for which keys are courseIDs which match the selected filters.
                   15098: 
                   15099: Inputs:
                   15100: 
                   15101: dom - domain being searched 
                   15102: 
                   15103: type - course type ('Course' or 'Community' or '.' if any).
                   15104: 
                   15105: filter - anonymous hash of criteria and their values
                   15106: 
                   15107: numtitles - for institutional codes - number of categories
                   15108: 
                   15109: cloneruname - optional username of new course owner
                   15110: 
                   15111: clonerudom - optional domain of new course owner
                   15112: 
                   15113: domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, 
                   15114:             (used when DC is using course creation form)
                   15115: 
                   15116: codetitles - reference to array of titles of components in institutional codes (official courses).
                   15117: 
                   15118: 
                   15119: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
                   15120: 
                   15121: 
                   15122: Side Effects: None
                   15123: 
                   15124: =cut
                   15125: 
                   15126: 
                   15127: sub search_courses {
                   15128:     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_;
                   15129:     my (%courses,%showcourses,$cloner);
                   15130:     if (($filter->{'ownerfilter'} ne '') ||
                   15131:         ($filter->{'ownerdomfilter'} ne '')) {
                   15132:         $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                   15133:                                        $filter->{'ownerdomfilter'};
                   15134:     }
                   15135:     foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
                   15136:         if (!$filter->{$item}) {
                   15137:             $filter->{$item}='.';
                   15138:         }
                   15139:     }
                   15140:     my $now = time;
                   15141:     my $timefilter =
                   15142:        ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
                   15143:     my ($createdbefore,$createdafter);
                   15144:     if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
                   15145:         $createdbefore = $now;
                   15146:         $createdafter = $now-$filter->{'createdfilter'};
                   15147:     }
                   15148:     my ($instcodefilter,$regexpok);
                   15149:     if ($numtitles) {
                   15150:         if ($env{'form.official'} eq 'on') {
                   15151:             $instcodefilter =
                   15152:                 &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   15153:             $regexpok = 1;
                   15154:         } elsif ($env{'form.official'} eq 'off') {
                   15155:             $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   15156:             unless ($instcodefilter eq '') {
                   15157:                 $regexpok = -1;
                   15158:             }
                   15159:         }
                   15160:     } else {
                   15161:         $instcodefilter = $filter->{'instcodefilter'};
                   15162:     }
                   15163:     if ($instcodefilter eq '') { $instcodefilter = '.'; }
                   15164:     if ($type eq '') { $type = '.'; }
                   15165: 
                   15166:     if (($clonerudom ne '') && ($cloneruname ne '')) {
                   15167:         $cloner = $cloneruname.':'.$clonerudom;
                   15168:     }
                   15169:     %courses = &Apache::lonnet::courseiddump($dom,
                   15170:                                              $filter->{'descriptfilter'},
                   15171:                                              $timefilter,
                   15172:                                              $instcodefilter,
                   15173:                                              $filter->{'combownerfilter'},
                   15174:                                              $filter->{'coursefilter'},
                   15175:                                              undef,undef,$type,$regexpok,undef,undef,
                   15176:                                              undef,undef,$cloner,$env{'form.cc_clone'},
                   15177:                                              $filter->{'cloneableonly'},
                   15178:                                              $createdbefore,$createdafter,undef,
                   15179:                                              $domcloner);
                   15180:     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
                   15181:         my $ccrole;
                   15182:         if ($type eq 'Community') {
                   15183:             $ccrole = 'co';
                   15184:         } else {
                   15185:             $ccrole = 'cc';
                   15186:         }
                   15187:         my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                   15188:                                                      $filter->{'persondomfilter'},
                   15189:                                                      'userroles',undef,
                   15190:                                                      [$ccrole,'in','ad','ep','ta','cr'],
                   15191:                                                      $dom);
                   15192:         foreach my $role (keys(%rolehash)) {
                   15193:             my ($cnum,$cdom,$courserole) = split(':',$role);
                   15194:             my $cid = $cdom.'_'.$cnum;
                   15195:             if (exists($courses{$cid})) {
                   15196:                 if (ref($courses{$cid}) eq 'HASH') {
                   15197:                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                   15198:                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
                   15199:                             push (@{$courses{$cid}{roles}},$courserole);
                   15200:                         }
                   15201:                     } else {
                   15202:                         $courses{$cid}{roles} = [$courserole];
                   15203:                     }
                   15204:                     $showcourses{$cid} = $courses{$cid};
                   15205:                 }
                   15206:             }
                   15207:         }
                   15208:         %courses = %showcourses;
                   15209:     }
                   15210:     return %courses;
                   15211: }
                   15212: 
                   15213: 
                   15214: =pod
                   15215: 
1.1181    raeburn  15216: =back
                   15217: 
                   15218: =cut
                   15219: 
                   15220: 
1.990     raeburn  15221: sub build_release_hashes {
                   15222:     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
                   15223:     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
                   15224:                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                   15225:                   (ref($randomizetry) eq 'HASH'));
                   15226:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   15227:         my ($item,$name,$value) = split(/:/,$key);
                   15228:         if ($item eq 'parameter') {
                   15229:             if (ref($checkparms->{$name}) eq 'ARRAY') {
                   15230:                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
                   15231:                     push(@{$checkparms->{$name}},$value);
                   15232:                 }
                   15233:             } else {
                   15234:                 push(@{$checkparms->{$name}},$value);
                   15235:             }
                   15236:         } elsif ($item eq 'resourcetag') {
                   15237:             if ($name eq 'responsetype') {
                   15238:                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
                   15239:             }
                   15240:         } elsif ($item eq 'course') {
                   15241:             if ($name eq 'crstype') {
                   15242:                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
                   15243:             }
                   15244:         }
                   15245:     }
                   15246:     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
                   15247:     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
                   15248:     return;
                   15249: }
                   15250: 
1.1083    raeburn  15251: sub update_content_constraints {
                   15252:     my ($cdom,$cnum,$chome,$cid) = @_;
                   15253:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   15254:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   15255:     my %checkresponsetypes;
                   15256:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   15257:         my ($item,$name,$value) = split(/:/,$key);
                   15258:         if ($item eq 'resourcetag') {
                   15259:             if ($name eq 'responsetype') {
                   15260:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   15261:             }
                   15262:         }
                   15263:     }
                   15264:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15265:     if (defined($navmap)) {
                   15266:         my %allresponses;
                   15267:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   15268:             my %responses = $res->responseTypes();
                   15269:             foreach my $key (keys(%responses)) {
                   15270:                 next unless(exists($checkresponsetypes{$key}));
                   15271:                 $allresponses{$key} += $responses{$key};
                   15272:             }
                   15273:         }
                   15274:         foreach my $key (keys(%allresponses)) {
                   15275:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   15276:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   15277:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   15278:             }
                   15279:         }
                   15280:         undef($navmap);
                   15281:     }
                   15282:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   15283:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   15284:     }
                   15285:     return;
                   15286: }
                   15287: 
1.1110    raeburn  15288: sub allmaps_incourse {
                   15289:     my ($cdom,$cnum,$chome,$cid) = @_;
                   15290:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   15291:         $cid = $env{'request.course.id'};
                   15292:         $cdom = $env{'course.'.$cid.'.domain'};
                   15293:         $cnum = $env{'course.'.$cid.'.num'};
                   15294:         $chome = $env{'course.'.$cid.'.home'};
                   15295:     }
                   15296:     my %allmaps = ();
                   15297:     my $lastchange =
                   15298:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   15299:     if ($lastchange > $env{'request.course.tied'}) {
                   15300:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   15301:         unless ($ferr) {
                   15302:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   15303:         }
                   15304:     }
                   15305:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15306:     if (defined($navmap)) {
                   15307:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   15308:             $allmaps{$res->src()} = 1;
                   15309:         }
                   15310:     }
                   15311:     return \%allmaps;
                   15312: }
                   15313: 
1.1083    raeburn  15314: sub parse_supplemental_title {
                   15315:     my ($title) = @_;
                   15316: 
                   15317:     my ($foldertitle,$renametitle);
                   15318:     if ($title =~ /&amp;&amp;&amp;/) {
                   15319:         $title = &HTML::Entites::decode($title);
                   15320:     }
                   15321:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   15322:         $renametitle=$4;
                   15323:         my ($time,$uname,$udom) = ($1,$2,$3);
                   15324:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   15325:         my $name =  &plainname($uname,$udom);
                   15326:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   15327:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   15328:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   15329:             $name.': <br />'.$foldertitle;
                   15330:     }
                   15331:     if (wantarray) {
                   15332:         return ($title,$foldertitle,$renametitle);
                   15333:     }
                   15334:     return $title;
                   15335: }
                   15336: 
1.1143    raeburn  15337: sub recurse_supplemental {
                   15338:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
                   15339:     if ($suppmap) {
                   15340:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   15341:         if ($fatal) {
                   15342:             $errors ++;
                   15343:         } else {
                   15344:             if ($#LONCAPA::map::resources > 0) {
                   15345:                 foreach my $res (@LONCAPA::map::resources) {
                   15346:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                   15347:                     if (($src ne '') && ($status eq 'res')) {
1.1146    raeburn  15348:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                   15349:                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143    raeburn  15350:                         } else {
                   15351:                             $numfiles ++;
                   15352:                         }
                   15353:                     }
                   15354:                 }
                   15355:             }
                   15356:         }
                   15357:     }
                   15358:     return ($numfiles,$errors);
                   15359: }
                   15360: 
1.1101    raeburn  15361: sub symb_to_docspath {
                   15362:     my ($symb) = @_;
                   15363:     return unless ($symb);
                   15364:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   15365:     if ($resurl=~/\.(sequence|page)$/) {
                   15366:         $mapurl=$resurl;
                   15367:     } elsif ($resurl eq 'adm/navmaps') {
                   15368:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   15369:     }
                   15370:     my $mapresobj;
                   15371:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15372:     if (ref($navmap)) {
                   15373:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   15374:     }
                   15375:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   15376:     my $type=$2;
                   15377:     my $path;
                   15378:     if (ref($mapresobj)) {
                   15379:         my $pcslist = $mapresobj->map_hierarchy();
                   15380:         if ($pcslist ne '') {
                   15381:             foreach my $pc (split(/,/,$pcslist)) {
                   15382:                 next if ($pc <= 1);
                   15383:                 my $res = $navmap->getByMapPc($pc);
                   15384:                 if (ref($res)) {
                   15385:                     my $thisurl = $res->src();
                   15386:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   15387:                     my $thistitle = $res->title();
                   15388:                     $path .= '&'.
                   15389:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146    raeburn  15390:                              &escape($thistitle).
1.1101    raeburn  15391:                              ':'.$res->randompick().
                   15392:                              ':'.$res->randomout().
                   15393:                              ':'.$res->encrypted().
                   15394:                              ':'.$res->randomorder().
                   15395:                              ':'.$res->is_page();
                   15396:                 }
                   15397:             }
                   15398:         }
                   15399:         $path =~ s/^\&//;
                   15400:         my $maptitle = $mapresobj->title();
                   15401:         if ($mapurl eq 'default') {
1.1129    raeburn  15402:             $maptitle = 'Main Content';
1.1101    raeburn  15403:         }
                   15404:         $path .= (($path ne '')? '&' : '').
                   15405:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  15406:                  &escape($maptitle).
1.1101    raeburn  15407:                  ':'.$mapresobj->randompick().
                   15408:                  ':'.$mapresobj->randomout().
                   15409:                  ':'.$mapresobj->encrypted().
                   15410:                  ':'.$mapresobj->randomorder().
                   15411:                  ':'.$mapresobj->is_page();
                   15412:     } else {
                   15413:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   15414:         my $ispage = (($type eq 'page')? 1 : '');
                   15415:         if ($mapurl eq 'default') {
1.1129    raeburn  15416:             $maptitle = 'Main Content';
1.1101    raeburn  15417:         }
                   15418:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  15419:                 &escape($maptitle).':::::'.$ispage;
1.1101    raeburn  15420:     }
                   15421:     unless ($mapurl eq 'default') {
                   15422:         $path = 'default&'.
1.1146    raeburn  15423:                 &escape('Main Content').
1.1101    raeburn  15424:                 ':::::&'.$path;
                   15425:     }
                   15426:     return $path;
                   15427: }
                   15428: 
1.1094    raeburn  15429: sub captcha_display {
                   15430:     my ($context,$lonhost) = @_;
                   15431:     my ($output,$error);
                   15432:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095    raeburn  15433:     if ($captcha eq 'original') {
1.1094    raeburn  15434:         $output = &create_captcha();
                   15435:         unless ($output) {
1.1172    raeburn  15436:             $error = 'captcha';
1.1094    raeburn  15437:         }
                   15438:     } elsif ($captcha eq 'recaptcha') {
                   15439:         $output = &create_recaptcha($pubkey);
                   15440:         unless ($output) {
1.1172    raeburn  15441:             $error = 'recaptcha';
1.1094    raeburn  15442:         }
                   15443:     }
1.1176    raeburn  15444:     return ($output,$error,$captcha);
1.1094    raeburn  15445: }
                   15446: 
                   15447: sub captcha_response {
                   15448:     my ($context,$lonhost) = @_;
                   15449:     my ($captcha_chk,$captcha_error);
                   15450:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095    raeburn  15451:     if ($captcha eq 'original') {
1.1094    raeburn  15452:         ($captcha_chk,$captcha_error) = &check_captcha();
                   15453:     } elsif ($captcha eq 'recaptcha') {
                   15454:         $captcha_chk = &check_recaptcha($privkey);
                   15455:     } else {
                   15456:         $captcha_chk = 1;
                   15457:     }
                   15458:     return ($captcha_chk,$captcha_error);
                   15459: }
                   15460: 
                   15461: sub get_captcha_config {
                   15462:     my ($context,$lonhost) = @_;
1.1095    raeburn  15463:     my ($captcha,$pubkey,$privkey,$hashtocheck);
1.1094    raeburn  15464:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   15465:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   15466:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095    raeburn  15467:     if ($context eq 'usercreation') {
                   15468:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   15469:         if (ref($domconfig{$context}) eq 'HASH') {
                   15470:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   15471:             if (ref($hashtocheck) eq 'HASH') {
                   15472:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   15473:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   15474:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   15475:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   15476:                     }
                   15477:                     if ($privkey && $pubkey) {
                   15478:                         $captcha = 'recaptcha';
                   15479:                     } else {
                   15480:                         $captcha = 'original';
                   15481:                     }
                   15482:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   15483:                     $captcha = 'original';
                   15484:                 }
1.1094    raeburn  15485:             }
1.1095    raeburn  15486:         } else {
                   15487:             $captcha = 'captcha';
                   15488:         }
                   15489:     } elsif ($context eq 'login') {
                   15490:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   15491:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   15492:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   15493:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094    raeburn  15494:             if ($privkey && $pubkey) {
                   15495:                 $captcha = 'recaptcha';
1.1095    raeburn  15496:             } else {
                   15497:                 $captcha = 'original';
1.1094    raeburn  15498:             }
1.1095    raeburn  15499:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   15500:             $captcha = 'original';
1.1094    raeburn  15501:         }
                   15502:     }
                   15503:     return ($captcha,$pubkey,$privkey);
                   15504: }
                   15505: 
                   15506: sub create_captcha {
                   15507:     my %captcha_params = &captcha_settings();
                   15508:     my ($output,$maxtries,$tries) = ('',10,0);
                   15509:     while ($tries < $maxtries) {
                   15510:         $tries ++;
                   15511:         my $captcha = Authen::Captcha->new (
                   15512:                                            output_folder => $captcha_params{'output_dir'},
                   15513:                                            data_folder   => $captcha_params{'db_dir'},
                   15514:                                           );
                   15515:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   15516: 
                   15517:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   15518:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   15519:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
1.1176    raeburn  15520:                       '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
                   15521:                       '<br />'.
                   15522:                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094    raeburn  15523:             last;
                   15524:         }
                   15525:     }
                   15526:     return $output;
                   15527: }
                   15528: 
                   15529: sub captcha_settings {
                   15530:     my %captcha_params = (
                   15531:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   15532:                            www_output_dir => "/captchaspool",
                   15533:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   15534:                            numchars       => '5',
                   15535:                          );
                   15536:     return %captcha_params;
                   15537: }
                   15538: 
                   15539: sub check_captcha {
                   15540:     my ($captcha_chk,$captcha_error);
                   15541:     my $code = $env{'form.code'};
                   15542:     my $md5sum = $env{'form.crypt'};
                   15543:     my %captcha_params = &captcha_settings();
                   15544:     my $captcha = Authen::Captcha->new(
                   15545:                       output_folder => $captcha_params{'output_dir'},
                   15546:                       data_folder   => $captcha_params{'db_dir'},
                   15547:                   );
1.1109    raeburn  15548:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094    raeburn  15549:     my %captcha_hash = (
                   15550:                         0       => 'Code not checked (file error)',
                   15551:                        -1      => 'Failed: code expired',
                   15552:                        -2      => 'Failed: invalid code (not in database)',
                   15553:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   15554:     );
                   15555:     if ($captcha_chk != 1) {
                   15556:         $captcha_error = $captcha_hash{$captcha_chk}
                   15557:     }
                   15558:     return ($captcha_chk,$captcha_error);
                   15559: }
                   15560: 
                   15561: sub create_recaptcha {
                   15562:     my ($pubkey) = @_;
1.1153    raeburn  15563:     my $use_ssl;
                   15564:     if ($ENV{'SERVER_PORT'} == 443) {
                   15565:         $use_ssl = 1;
                   15566:     }
1.1094    raeburn  15567:     my $captcha = Captcha::reCAPTCHA->new;
                   15568:     return $captcha->get_options_setter({theme => 'white'})."\n".
1.1153    raeburn  15569:            $captcha->get_html($pubkey,undef,$use_ssl).
1.1094    raeburn  15570:            &mt('If either word is hard to read, [_1] will replace them.',
1.1133    raeburn  15571:                '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1094    raeburn  15572:            '<br /><br />';
                   15573: }
                   15574: 
                   15575: sub check_recaptcha {
                   15576:     my ($privkey) = @_;
                   15577:     my $captcha_chk;
                   15578:     my $captcha = Captcha::reCAPTCHA->new;
                   15579:     my $captcha_result =
                   15580:         $captcha->check_answer(
                   15581:                                 $privkey,
                   15582:                                 $ENV{'REMOTE_ADDR'},
                   15583:                                 $env{'form.recaptcha_challenge_field'},
                   15584:                                 $env{'form.recaptcha_response_field'},
                   15585:                               );
                   15586:     if ($captcha_result->{is_valid}) {
                   15587:         $captcha_chk = 1;
                   15588:     }
                   15589:     return $captcha_chk;
                   15590: }
                   15591: 
1.1174    raeburn  15592: sub emailusername_info {
1.1177    raeburn  15593:     my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1174    raeburn  15594:     my %titles = &Apache::lonlocal::texthash (
                   15595:                      lastname      => 'Last Name',
                   15596:                      firstname     => 'First Name',
                   15597:                      institution   => 'School/college/university',
                   15598:                      location      => "School's city, state/province, country",
                   15599:                      web           => "School's web address",
                   15600:                      officialemail => 'E-mail address at institution (if different)',
                   15601:                  );
                   15602:     return (\@fields,\%titles);
                   15603: }
                   15604: 
1.1161    raeburn  15605: sub cleanup_html {
                   15606:     my ($incoming) = @_;
                   15607:     my $outgoing;
                   15608:     if ($incoming ne '') {
                   15609:         $outgoing = $incoming;
                   15610:         $outgoing =~ s/;/&#059;/g;
                   15611:         $outgoing =~ s/\#/&#035;/g;
                   15612:         $outgoing =~ s/\&/&#038;/g;
                   15613:         $outgoing =~ s/</&#060;/g;
                   15614:         $outgoing =~ s/>/&#062;/g;
                   15615:         $outgoing =~ s/\(/&#040/g;
                   15616:         $outgoing =~ s/\)/&#041;/g;
                   15617:         $outgoing =~ s/"/&#034;/g;
                   15618:         $outgoing =~ s/'/&#039;/g;
                   15619:         $outgoing =~ s/\$/&#036;/g;
                   15620:         $outgoing =~ s{/}{&#047;}g;
                   15621:         $outgoing =~ s/=/&#061;/g;
                   15622:         $outgoing =~ s/\\/&#092;/g
                   15623:     }
                   15624:     return $outgoing;
                   15625: }
                   15626: 
1.1174    raeburn  15627: # Use:
                   15628: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                   15629: #
                   15630: ##################################################
                   15631: #          password associated functions         #
                   15632: ##################################################
                   15633: sub des_keys {
                   15634:     # Make a new key for DES encryption.
                   15635:     # Each key has two parts which are returned separately.
                   15636:     # Please note:  Each key must be passed through the &hex function
                   15637:     # before it is output to the web browser.  The hex versions cannot
                   15638:     # be used to decrypt.
                   15639:     my @hexstr=('0','1','2','3','4','5','6','7',
                   15640:                 '8','9','a','b','c','d','e','f');
                   15641:     my $lkey='';
                   15642:     for (0..7) {
                   15643:         $lkey.=$hexstr[rand(15)];
                   15644:     }
                   15645:     my $ukey='';
                   15646:     for (0..7) {
                   15647:         $ukey.=$hexstr[rand(15)];
                   15648:     }
                   15649:     return ($lkey,$ukey);
                   15650: }
                   15651: 
                   15652: sub des_decrypt {
                   15653:     my ($key,$cyphertext) = @_;
                   15654:     my $keybin=pack("H16",$key);
                   15655:     my $cypher;
                   15656:     if ($Crypt::DES::VERSION>=2.03) {
                   15657:         $cypher=new Crypt::DES $keybin;
                   15658:     } else {
                   15659:         $cypher=new DES $keybin;
                   15660:     }
                   15661:     my $plaintext=
                   15662:         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
                   15663:     $plaintext.=
                   15664:         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
                   15665:     $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
                   15666:     return $plaintext;
                   15667: }
                   15668: 
1.112     bowersj2 15669: 1;
                   15670: __END__;
1.41      ng       15671: 

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