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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1225  ! raeburn     4: # $Id: loncommon.pm,v 1.1224 2015/07/02 17:23:17 musolffc 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.1220    raeburn    76: use Encode();
1.1091    foxr       77: use Text::Aspell;
1.1094    raeburn    78: use Authen::Captcha;
                     79: use Captcha::reCAPTCHA;
1.1174    raeburn    80: use Crypt::DES;
                     81: use DynaLoader; # for Crypt::DES version
1.1223    musolffc   82: use MIME::Lite;
                     83: use MIME::Types;
1.117     www        84: 
1.517     raeburn    85: # ---------------------------------------------- Designs
                     86: use vars qw(%defaultdesign);
                     87: 
1.22      www        88: my $readit;
                     89: 
1.517     raeburn    90: 
1.157     matthew    91: ##
                     92: ## Global Variables
                     93: ##
1.46      matthew    94: 
1.643     foxr       95: 
                     96: # ----------------------------------------------- SSI with retries:
                     97: #
                     98: 
                     99: =pod
                    100: 
1.648     raeburn   101: =head1 Server Side include with retries:
1.643     foxr      102: 
                    103: =over 4
                    104: 
1.648     raeburn   105: =item * &ssi_with_retries(resource,retries form)
1.643     foxr      106: 
                    107: Performs an ssi with some number of retries.  Retries continue either
                    108: until the result is ok or until the retry count supplied by the
                    109: caller is exhausted.  
                    110: 
                    111: Inputs:
1.648     raeburn   112: 
                    113: =over 4
                    114: 
1.643     foxr      115: resource   - Identifies the resource to insert.
1.648     raeburn   116: 
1.643     foxr      117: retries    - Count of the number of retries allowed.
1.648     raeburn   118: 
1.643     foxr      119: form       - Hash that identifies the rendering options.
                    120: 
1.648     raeburn   121: =back
                    122: 
                    123: Returns:
                    124: 
                    125: =over 4
                    126: 
1.643     foxr      127: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   128: 
1.643     foxr      129: response   - The response from the last attempt (which may or may not have been successful.
                    130: 
1.648     raeburn   131: =back
                    132: 
                    133: =back
                    134: 
1.643     foxr      135: =cut
                    136: 
                    137: sub ssi_with_retries {
                    138:     my ($resource, $retries, %form) = @_;
                    139: 
                    140: 
                    141:     my $ok = 0;			# True if we got a good response.
                    142:     my $content;
                    143:     my $response;
                    144: 
                    145:     # Try to get the ssi done. within the retries count:
                    146: 
                    147:     do {
                    148: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    149: 	$ok      = $response->is_success;
1.650     www       150:         if (!$ok) {
                    151:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    152:         }
1.643     foxr      153: 	$retries--;
                    154:     } while (!$ok && ($retries > 0));
                    155: 
                    156:     if (!$ok) {
                    157: 	$content = '';		# On error return an empty content.
                    158:     }
                    159:     return ($content, $response);
                    160: 
                    161: }
                    162: 
                    163: 
                    164: 
1.20      www       165: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  166: my %language;
1.124     www       167: my %supported_language;
1.1088    foxr      168: my %supported_codes;
1.1048    foxr      169: my %latex_language;		# For choosing hyphenation in <transl..>
                    170: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  171: my %cprtag;
1.192     taceyjo1  172: my %scprtag;
1.351     www       173: my %fe; my %fd; my %fm;
1.41      ng        174: my %category_extensions;
1.12      harris41  175: 
1.46      matthew   176: # ---------------------------------------------- Thesaurus variables
1.144     matthew   177: #
                    178: # %Keywords:
                    179: #      A hash used by &keyword to determine if a word is considered a keyword.
                    180: # $thesaurus_db_file 
                    181: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   182: 
                    183: my %Keywords;
                    184: my $thesaurus_db_file;
                    185: 
1.144     matthew   186: #
                    187: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    188: # thesaurus.tab, and filecategories.tab.
                    189: #
1.18      www       190: BEGIN {
1.46      matthew   191:     # Variable initialization
                    192:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    193:     #
1.22      www       194:     unless ($readit) {
1.12      harris41  195: # ------------------------------------------------------------------- languages
                    196:     {
1.158     raeburn   197:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    198:                                    '/language.tab';
                    199:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  200:             while (my $line = <$fh>) {
                    201:                 next if ($line=~/^\#/);
                    202:                 chomp($line);
1.1088    foxr      203:                 my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   204:                 $language{$key}=$val.' - '.$enc;
                    205:                 if ($sup) {
                    206:                     $supported_language{$key}=$sup;
1.1088    foxr      207: 		    $supported_codes{$key}   = $code;
1.158     raeburn   208:                 }
1.1048    foxr      209: 		if ($latex) {
                    210: 		    $latex_language_bykey{$key} = $latex;
1.1088    foxr      211: 		    $latex_language{$code} = $latex;
1.1048    foxr      212: 		}
1.158     raeburn   213:             }
                    214:             close($fh);
                    215:         }
1.12      harris41  216:     }
                    217: # ------------------------------------------------------------------ copyrights
                    218:     {
1.158     raeburn   219:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    220:                                   '/copyright.tab';
                    221:         if ( open (my $fh,"<$copyrightfile") ) {
1.356     albertel  222:             while (my $line = <$fh>) {
                    223:                 next if ($line=~/^\#/);
                    224:                 chomp($line);
                    225:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   226:                 $cprtag{$key}=$val;
                    227:             }
                    228:             close($fh);
                    229:         }
1.12      harris41  230:     }
1.351     www       231: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  232:     {
                    233:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    234:                                   '/source_copyright.tab';
                    235:         if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356     albertel  236:             while (my $line = <$fh>) {
                    237:                 next if ($line =~ /^\#/);
                    238:                 chomp($line);
                    239:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  240:                 $scprtag{$key}=$val;
                    241:             }
                    242:             close($fh);
                    243:         }
                    244:     }
1.63      www       245: 
1.517     raeburn   246: # -------------------------------------------------------------- default domain designs
1.63      www       247:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   248:     my $designfile = $designdir.'/default.tab';
                    249:     if ( open (my $fh,"<$designfile") ) {
                    250:         while (my $line = <$fh>) {
                    251:             next if ($line =~ /^\#/);
                    252:             chomp($line);
                    253:             my ($key,$val)=(split(/\=/,$line));
                    254:             if ($val) { $defaultdesign{$key}=$val; }
                    255:         }
                    256:         close($fh);
1.63      www       257:     }
                    258: 
1.15      harris41  259: # ------------------------------------------------------------- file categories
                    260:     {
1.158     raeburn   261:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    262:                                   '/filecategories.tab';
                    263:         if ( open (my $fh,"<$categoryfile") ) {
1.356     albertel  264: 	    while (my $line = <$fh>) {
                    265: 		next if ($line =~ /^\#/);
                    266: 		chomp($line);
                    267:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.158     raeburn   268:                 push @{$category_extensions{lc($category)}},$extension;
                    269:             }
                    270:             close($fh);
                    271:         }
                    272: 
1.15      harris41  273:     }
1.12      harris41  274: # ------------------------------------------------------------------ file types
                    275:     {
1.158     raeburn   276:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    277:                '/filetypes.tab';
                    278:         if ( open (my $fh,"<$typesfile") ) {
1.356     albertel  279:             while (my $line = <$fh>) {
                    280: 		next if ($line =~ /^\#/);
                    281: 		chomp($line);
                    282:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   283:                 if ($descr ne '') {
                    284:                     $fe{$ending}=lc($emb);
                    285:                     $fd{$ending}=$descr;
1.351     www       286:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   287:                 }
                    288:             }
                    289:             close($fh);
                    290:         }
1.12      harris41  291:     }
1.22      www       292:     &Apache::lonnet::logthis(
1.705     tempelho  293:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       294:     $readit=1;
1.46      matthew   295:     }  # end of unless($readit) 
1.32      matthew   296:     
                    297: }
1.112     bowersj2  298: 
1.42      matthew   299: ###############################################################
                    300: ##           HTML and Javascript Helper Functions            ##
                    301: ###############################################################
                    302: 
                    303: =pod 
                    304: 
1.112     bowersj2  305: =head1 HTML and Javascript Functions
1.42      matthew   306: 
1.112     bowersj2  307: =over 4
                    308: 
1.648     raeburn   309: =item * &browser_and_searcher_javascript()
1.112     bowersj2  310: 
                    311: X<browsing, javascript>X<searching, javascript>Returns a string
                    312: containing javascript with two functions, C<openbrowser> and
                    313: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    314: tags.
1.42      matthew   315: 
1.648     raeburn   316: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   317: 
                    318: inputs: formname, elementname, only, omit
                    319: 
                    320: formname and elementname indicate the name of the html form and name of
                    321: the element that the results of the browsing selection are to be placed in. 
                    322: 
                    323: Specifying 'only' will restrict the browser to displaying only files
1.185     www       324: with the given extension.  Can be a comma separated list.
1.42      matthew   325: 
                    326: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       327: with the given extension.  Can be a comma separated list.
1.42      matthew   328: 
1.648     raeburn   329: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   330: 
                    331: Inputs: formname, elementname
                    332: 
                    333: formname and elementname specify the name of the html form and the name
                    334: of the element the selection from the search results will be placed in.
1.542     raeburn   335: 
1.42      matthew   336: =cut
                    337: 
                    338: sub browser_and_searcher_javascript {
1.199     albertel  339:     my ($mode)=@_;
                    340:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  341:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   342:     return <<END;
1.219     albertel  343: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   344:     var editbrowser = null;
1.135     albertel  345:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       346:         var url = '$resurl/?';
1.42      matthew   347:         if (editbrowser == null) {
                    348:             url += 'launch=1&';
                    349:         }
                    350:         url += 'catalogmode=interactive&';
1.199     albertel  351:         url += 'mode=$mode&';
1.611     albertel  352:         url += 'inhibitmenu=yes&';
1.42      matthew   353:         url += 'form=' + formname + '&';
                    354:         if (only != null) {
                    355:             url += 'only=' + only + '&';
1.217     albertel  356:         } else {
                    357:             url += 'only=&';
                    358: 	}
1.42      matthew   359:         if (omit != null) {
                    360:             url += 'omit=' + omit + '&';
1.217     albertel  361:         } else {
                    362:             url += 'omit=&';
                    363: 	}
1.135     albertel  364:         if (titleelement != null) {
                    365:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  366:         } else {
                    367: 	    url += 'titleelement=&';
                    368: 	}
1.42      matthew   369:         url += 'element=' + elementname + '';
                    370:         var title = 'Browser';
1.435     albertel  371:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   372:         options += ',width=700,height=600';
                    373:         editbrowser = open(url,title,options,'1');
                    374:         editbrowser.focus();
                    375:     }
                    376:     var editsearcher;
1.135     albertel  377:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   378:         var url = '/adm/searchcat?';
                    379:         if (editsearcher == null) {
                    380:             url += 'launch=1&';
                    381:         }
                    382:         url += 'catalogmode=interactive&';
1.199     albertel  383:         url += 'mode=$mode&';
1.42      matthew   384:         url += 'form=' + formname + '&';
1.135     albertel  385:         if (titleelement != null) {
                    386:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  387:         } else {
                    388: 	    url += 'titleelement=&';
                    389: 	}
1.42      matthew   390:         url += 'element=' + elementname + '';
                    391:         var title = 'Search';
1.435     albertel  392:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   393:         options += ',width=700,height=600';
                    394:         editsearcher = open(url,title,options,'1');
                    395:         editsearcher.focus();
                    396:     }
1.219     albertel  397: // END LON-CAPA Internal -->
1.42      matthew   398: END
1.170     www       399: }
                    400: 
                    401: sub lastresurl {
1.258     albertel  402:     if ($env{'environment.lastresurl'}) {
                    403: 	return $env{'environment.lastresurl'}
1.170     www       404:     } else {
                    405: 	return '/res';
                    406:     }
                    407: }
                    408: 
                    409: sub storeresurl {
                    410:     my $resurl=&Apache::lonnet::clutter(shift);
                    411:     unless ($resurl=~/^\/res/) { return 0; }
                    412:     $resurl=~s/\/$//;
                    413:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   414:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       415:     return 1;
1.42      matthew   416: }
                    417: 
1.74      www       418: sub studentbrowser_javascript {
1.111     www       419:    unless (
1.258     albertel  420:             (($env{'request.course.id'}) && 
1.302     albertel  421:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    422: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    423: 					  '/'.$env{'request.course.sec'})
                    424: 	      ))
1.258     albertel  425:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       426:           ) { return ''; }  
1.74      www       427:    return (<<'ENDSTDBRW');
1.776     bisitz    428: <script type="text/javascript" language="Javascript">
1.824     bisitz    429: // <![CDATA[
1.74      www       430:     var stdeditbrowser;
1.999     www       431:     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74      www       432:         var url = '/adm/pickstudent?';
                    433:         var filter;
1.558     albertel  434: 	if (!ignorefilter) {
                    435: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    436: 	}
1.74      www       437:         if (filter != null) {
                    438:            if (filter != '') {
                    439:                url += 'filter='+filter+'&';
                    440: 	   }
                    441:         }
                    442:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       443:                                     '&udomelement='+udom+
                    444:                                     '&clicker='+clicker;
1.111     www       445: 	if (roleflag) { url+="&roles=1"; }
1.793     raeburn   446:         if (courseadvonly) { url+="&courseadvonly=1"; }
1.102     www       447:         var title = 'Student_Browser';
1.74      www       448:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    449:         options += ',width=700,height=600';
                    450:         stdeditbrowser = open(url,title,options,'1');
                    451:         stdeditbrowser.focus();
                    452:     }
1.824     bisitz    453: // ]]>
1.74      www       454: </script>
                    455: ENDSTDBRW
                    456: }
1.42      matthew   457: 
1.1003    www       458: sub resourcebrowser_javascript {
                    459:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       460:    return (<<'ENDRESBRW');
1.1003    www       461: <script type="text/javascript" language="Javascript">
                    462: // <![CDATA[
                    463:     var reseditbrowser;
1.1004    www       464:     function openresbrowser(formname,reslink) {
1.1005    www       465:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       466:         var title = 'Resource_Browser';
                    467:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       468:         options += ',width=700,height=500';
1.1004    www       469:         reseditbrowser = open(url,title,options,'1');
                    470:         reseditbrowser.focus();
1.1003    www       471:     }
                    472: // ]]>
                    473: </script>
1.1004    www       474: ENDRESBRW
1.1003    www       475: }
                    476: 
1.74      www       477: sub selectstudent_link {
1.999     www       478:    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
                    479:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    480:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    481:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  482:    if ($env{'request.course.id'}) {  
1.302     albertel  483:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    484: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    485: 					'/'.$env{'request.course.sec'})) {
1.111     www       486: 	   return '';
                    487:        }
1.999     www       488:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793     raeburn   489:        if ($courseadvonly)  {
                    490:            $callargs .= ",'',1,1";
                    491:        }
                    492:        return '<span class="LC_nobreak">'.
                    493:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    494:               &mt('Select User').'</a></span>';
1.74      www       495:    }
1.258     albertel  496:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       497:        $callargs .= ",'',1"; 
1.793     raeburn   498:        return '<span class="LC_nobreak">'.
                    499:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    500:               &mt('Select User').'</a></span>';
1.111     www       501:    }
                    502:    return '';
1.91      www       503: }
                    504: 
1.1004    www       505: sub selectresource_link {
                    506:    my ($form,$reslink,$arg)=@_;
                    507:    
                    508:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    509:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    510:    unless ($env{'request.course.id'}) { return $arg; }
                    511:    return '<span class="LC_nobreak">'.
                    512:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    513:               $arg.'</a></span>';
                    514: }
                    515: 
                    516: 
                    517: 
1.653     raeburn   518: sub authorbrowser_javascript {
                    519:     return <<"ENDAUTHORBRW";
1.776     bisitz    520: <script type="text/javascript" language="JavaScript">
1.824     bisitz    521: // <![CDATA[
1.653     raeburn   522: var stdeditbrowser;
                    523: 
                    524: function openauthorbrowser(formname,udom) {
                    525:     var url = '/adm/pickauthor?';
                    526:     url += 'form='+formname+'&roledom='+udom;
                    527:     var title = 'Author_Browser';
                    528:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    529:     options += ',width=700,height=600';
                    530:     stdeditbrowser = open(url,title,options,'1');
                    531:     stdeditbrowser.focus();
                    532: }
                    533: 
1.824     bisitz    534: // ]]>
1.653     raeburn   535: </script>
                    536: ENDAUTHORBRW
                    537: }
                    538: 
1.91      www       539: sub coursebrowser_javascript {
1.1116    raeburn   540:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1221    raeburn   541:         $credits_element,$instcode) = @_;
1.932     raeburn   542:     my $wintitle = 'Course_Browser';
1.931     raeburn   543:     if ($crstype eq 'Community') {
1.932     raeburn   544:         $wintitle = 'Community_Browser';
1.909     raeburn   545:     }
1.876     raeburn   546:     my $id_functions = &javascript_index_functions();
                    547:     my $output = '
1.776     bisitz    548: <script type="text/javascript" language="JavaScript">
1.824     bisitz    549: // <![CDATA[
1.468     raeburn   550:     var stdeditbrowser;'."\n";
1.876     raeburn   551: 
                    552:     $output .= <<"ENDSTDBRW";
1.909     raeburn   553:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       554:         var url = '/adm/pickcourse?';
1.895     raeburn   555:         var formid = getFormIdByName(formname);
1.876     raeburn   556:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  557:         if (domainfilter != null) {
                    558:            if (domainfilter != '') {
                    559:                url += 'domainfilter='+domainfilter+'&';
                    560: 	   }
                    561:         }
1.91      www       562:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  563: 	                            '&cdomelement='+udom+
                    564:                                     '&cnameelement='+desc;
1.468     raeburn   565:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   566:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   567:                 url += '&roleelement='+extra_element;
                    568:                 if (domainfilter == null || domainfilter == '') {
                    569:                     url += '&domainfilter='+extra_element;
                    570:                 }
1.234     raeburn   571:             }
1.468     raeburn   572:             else {
                    573:                 if (formname == 'portform') {
                    574:                     url += '&setroles='+extra_element;
1.800     raeburn   575:                 } else {
                    576:                     if (formname == 'rules') {
                    577:                         url += '&fixeddom='+extra_element; 
                    578:                     }
1.468     raeburn   579:                 }
                    580:             }     
1.230     raeburn   581:         }
1.909     raeburn   582:         if (type != null && type != '') {
                    583:             url += '&type='+type;
                    584:         }
                    585:         if (type_elem != null && type_elem != '') {
                    586:             url += '&typeelement='+type_elem;
                    587:         }
1.872     raeburn   588:         if (formname == 'ccrs') {
                    589:             var ownername = document.forms[formid].ccuname.value;
                    590:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1221    raeburn   591:             url += '&cloner='+ownername+':'+ownerdom+'&crscode='+document.forms[formid].crscode.value;
                    592:         }
                    593:         if (formname == 'requestcrs') {
                    594:             url += '&crsdom=$domainfilter&crscode=$instcode';
1.872     raeburn   595:         }
1.293     raeburn   596:         if (multflag !=null && multflag != '') {
                    597:             url += '&multiple='+multflag;
                    598:         }
1.909     raeburn   599:         var title = '$wintitle';
1.91      www       600:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    601:         options += ',width=700,height=600';
                    602:         stdeditbrowser = open(url,title,options,'1');
                    603:         stdeditbrowser.focus();
                    604:     }
1.876     raeburn   605: $id_functions
                    606: ENDSTDBRW
1.1116    raeburn   607:     if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
                    608:         $output .= &setsec_javascript($sec_element,$formname,$role_element,
                    609:                                       $credits_element);
1.876     raeburn   610:     }
                    611:     $output .= '
                    612: // ]]>
                    613: </script>';
                    614:     return $output;
                    615: }
                    616: 
                    617: sub javascript_index_functions {
                    618:     return <<"ENDJS";
                    619: 
                    620: function getFormIdByName(formname) {
                    621:     for (var i=0;i<document.forms.length;i++) {
                    622:         if (document.forms[i].name == formname) {
                    623:             return i;
                    624:         }
                    625:     }
                    626:     return -1;
                    627: }
                    628: 
                    629: function getIndexByName(formid,item) {
                    630:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    631:         if (document.forms[formid].elements[i].name == item) {
                    632:             return i;
                    633:         }
                    634:     }
                    635:     return -1;
                    636: }
1.468     raeburn   637: 
1.876     raeburn   638: function getDomainFromSelectbox(formname,udom) {
                    639:     var userdom;
                    640:     var formid = getFormIdByName(formname);
                    641:     if (formid > -1) {
                    642:         var domid = getIndexByName(formid,udom);
                    643:         if (domid > -1) {
                    644:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    645:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    646:             }
                    647:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    648:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   649:             }
                    650:         }
                    651:     }
1.876     raeburn   652:     return userdom;
                    653: }
                    654: 
                    655: ENDJS
1.468     raeburn   656: 
1.876     raeburn   657: }
                    658: 
1.1017    raeburn   659: sub javascript_array_indexof {
1.1018    raeburn   660:     return <<ENDJS;
1.1017    raeburn   661: <script type="text/javascript" language="JavaScript">
                    662: // <![CDATA[
                    663: 
                    664: if (!Array.prototype.indexOf) {
                    665:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    666:         "use strict";
                    667:         if (this === void 0 || this === null) {
                    668:             throw new TypeError();
                    669:         }
                    670:         var t = Object(this);
                    671:         var len = t.length >>> 0;
                    672:         if (len === 0) {
                    673:             return -1;
                    674:         }
                    675:         var n = 0;
                    676:         if (arguments.length > 0) {
                    677:             n = Number(arguments[1]);
1.1088    foxr      678:             if (n !== n) { // shortcut for verifying if it is NaN
1.1017    raeburn   679:                 n = 0;
                    680:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    681:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    682:             }
                    683:         }
                    684:         if (n >= len) {
                    685:             return -1;
                    686:         }
                    687:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    688:         for (; k < len; k++) {
                    689:             if (k in t && t[k] === searchElement) {
                    690:                 return k;
                    691:             }
                    692:         }
                    693:         return -1;
                    694:     }
                    695: }
                    696: 
                    697: // ]]>
                    698: </script>
                    699: 
                    700: ENDJS
                    701: 
                    702: }
                    703: 
1.876     raeburn   704: sub userbrowser_javascript {
                    705:     my $id_functions = &javascript_index_functions();
                    706:     return <<"ENDUSERBRW";
                    707: 
1.888     raeburn   708: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   709:     var url = '/adm/pickuser?';
                    710:     var userdom = getDomainFromSelectbox(formname,udom);
                    711:     if (userdom != null) {
                    712:        if (userdom != '') {
                    713:            url += 'srchdom='+userdom+'&';
                    714:        }
                    715:     }
                    716:     url += 'form=' + formname + '&unameelement='+uname+
                    717:                                 '&udomelement='+udom+
                    718:                                 '&ulastelement='+ulast+
                    719:                                 '&ufirstelement='+ufirst+
                    720:                                 '&uemailelement='+uemail+
1.881     raeburn   721:                                 '&hideudomelement='+hideudom+
                    722:                                 '&coursedom='+crsdom;
1.888     raeburn   723:     if ((caller != null) && (caller != undefined)) {
                    724:         url += '&caller='+caller;
                    725:     }
1.876     raeburn   726:     var title = 'User_Browser';
                    727:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    728:     options += ',width=700,height=600';
                    729:     var stdeditbrowser = open(url,title,options,'1');
                    730:     stdeditbrowser.focus();
                    731: }
                    732: 
1.888     raeburn   733: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   734:     var formid = getFormIdByName(formname);
                    735:     if (formid > -1) {
1.888     raeburn   736:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   737:         var domid = getIndexByName(formid,udom);
                    738:         var hidedomid = getIndexByName(formid,origdom);
                    739:         if (hidedomid > -1) {
                    740:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   741:             var unameval = document.forms[formid].elements[unameid].value;
                    742:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    743:                 if (domid > -1) {
                    744:                     var slct = document.forms[formid].elements[domid];
                    745:                     if (slct.type == 'select-one') {
                    746:                         var i;
                    747:                         for (i=0;i<slct.length;i++) {
                    748:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    749:                         }
                    750:                     }
                    751:                     if (slct.type == 'hidden') {
                    752:                         slct.value = fixeddom;
1.876     raeburn   753:                     }
                    754:                 }
1.468     raeburn   755:             }
                    756:         }
                    757:     }
1.876     raeburn   758:     return;
                    759: }
                    760: 
                    761: $id_functions
                    762: ENDUSERBRW
1.468     raeburn   763: }
                    764: 
                    765: sub setsec_javascript {
1.1116    raeburn   766:     my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905     raeburn   767:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    768:         $communityrolestr);
                    769:     if ($role_element ne '') {
                    770:         my @allroles = ('st','ta','ep','in','ad');
                    771:         foreach my $crstype ('Course','Community') {
                    772:             if ($crstype eq 'Community') {
                    773:                 foreach my $role (@allroles) {
                    774:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    775:                 }
                    776:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    777:             } else {
                    778:                 foreach my $role (@allroles) {
                    779:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    780:                 }
                    781:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    782:             }
                    783:         }
                    784:         $rolestr = '"'.join('","',@allroles).'"';
                    785:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    786:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    787:     }
1.468     raeburn   788:     my $setsections = qq|
                    789: function setSect(sectionlist) {
1.629     raeburn   790:     var sectionsArray = new Array();
                    791:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    792:         sectionsArray = sectionlist.split(",");
                    793:     }
1.468     raeburn   794:     var numSections = sectionsArray.length;
                    795:     document.$formname.$sec_element.length = 0;
                    796:     if (numSections == 0) {
                    797:         document.$formname.$sec_element.multiple=false;
                    798:         document.$formname.$sec_element.size=1;
                    799:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    800:     } else {
                    801:         if (numSections == 1) {
                    802:             document.$formname.$sec_element.multiple=false;
                    803:             document.$formname.$sec_element.size=1;
                    804:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    805:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    806:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    807:         } else {
                    808:             for (var i=0; i<numSections; i++) {
                    809:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    810:             }
                    811:             document.$formname.$sec_element.multiple=true
                    812:             if (numSections < 3) {
                    813:                 document.$formname.$sec_element.size=numSections;
                    814:             } else {
                    815:                 document.$formname.$sec_element.size=3;
                    816:             }
                    817:             document.$formname.$sec_element.options[0].selected = false
                    818:         }
                    819:     }
1.91      www       820: }
1.905     raeburn   821: 
                    822: function setRole(crstype) {
1.468     raeburn   823: |;
1.905     raeburn   824:     if ($role_element eq '') {
                    825:         $setsections .= '    return;
                    826: }
                    827: ';
                    828:     } else {
                    829:         $setsections .= qq|
                    830:     var elementLength = document.$formname.$role_element.length;
                    831:     var allroles = Array($rolestr);
                    832:     var courserolenames = Array($courserolestr);
                    833:     var communityrolenames = Array($communityrolestr);
                    834:     if (elementLength != undefined) {
                    835:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    836:             if (crstype == 'Course') {
                    837:                 return;
                    838:             } else {
                    839:                 allroles[5] = 'co';
                    840:                 for (var i=0; i<6; i++) {
                    841:                     document.$formname.$role_element.options[i].value = allroles[i];
                    842:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    843:                 }
                    844:             }
                    845:         } else {
                    846:             if (crstype == 'Community') {
                    847:                 return;
                    848:             } else {
                    849:                 allroles[5] = 'cc';
                    850:                 for (var i=0; i<6; i++) {
                    851:                     document.$formname.$role_element.options[i].value = allroles[i];
                    852:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    853:                 }
                    854:             }
                    855:         }
                    856:     }
                    857:     return;
                    858: }
                    859: |;
                    860:     }
1.1116    raeburn   861:     if ($credits_element) {
                    862:         $setsections .= qq|
                    863: function setCredits(defaultcredits) {
                    864:     document.$formname.$credits_element.value = defaultcredits;
                    865:     return;
                    866: }
                    867: |;
                    868:     }
1.468     raeburn   869:     return $setsections;
                    870: }
                    871: 
1.91      www       872: sub selectcourse_link {
1.909     raeburn   873:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    874:        $typeelement) = @_;
                    875:    my $type = $selecttype;
1.871     raeburn   876:    my $linktext = &mt('Select Course');
                    877:    if ($selecttype eq 'Community') {
1.909     raeburn   878:        $linktext = &mt('Select Community');
1.906     raeburn   879:    } elsif ($selecttype eq 'Course/Community') {
                    880:        $linktext = &mt('Select Course/Community');
1.909     raeburn   881:        $type = '';
1.1019    raeburn   882:    } elsif ($selecttype eq 'Select') {
                    883:        $linktext = &mt('Select');
                    884:        $type = '';
1.871     raeburn   885:    }
1.787     bisitz    886:    return '<span class="LC_nobreak">'
                    887:          ."<a href='"
                    888:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    889:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   890:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   891:          ."'>".$linktext.'</a>'
1.787     bisitz    892:          .'</span>';
1.74      www       893: }
1.42      matthew   894: 
1.653     raeburn   895: sub selectauthor_link {
                    896:    my ($form,$udom)=@_;
                    897:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    898:           &mt('Select Author').'</a>';
                    899: }
                    900: 
1.876     raeburn   901: sub selectuser_link {
1.881     raeburn   902:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   903:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   904:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   905:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   906:            ');">'.$linktext.'</a>';
1.876     raeburn   907: }
                    908: 
1.273     raeburn   909: sub check_uncheck_jscript {
                    910:     my $jscript = <<"ENDSCRT";
                    911: function checkAll(field) {
                    912:     if (field.length > 0) {
                    913:         for (i = 0; i < field.length; i++) {
1.1093    raeburn   914:             if (!field[i].disabled) { 
                    915:                 field[i].checked = true;
                    916:             }
1.273     raeburn   917:         }
                    918:     } else {
1.1093    raeburn   919:         if (!field.disabled) { 
                    920:             field.checked = true;
                    921:         }
1.273     raeburn   922:     }
                    923: }
                    924:  
                    925: function uncheckAll(field) {
                    926:     if (field.length > 0) {
                    927:         for (i = 0; i < field.length; i++) {
                    928:             field[i].checked = false ;
1.543     albertel  929:         }
                    930:     } else {
1.273     raeburn   931:         field.checked = false ;
                    932:     }
                    933: }
                    934: ENDSCRT
                    935:     return $jscript;
                    936: }
                    937: 
1.656     www       938: sub select_timezone {
1.659     raeburn   939:    my ($name,$selected,$onchange,$includeempty)=@_;
                    940:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    941:    if ($includeempty) {
                    942:        $output .= '<option value=""';
                    943:        if (($selected eq '') || ($selected eq 'local')) {
                    944:            $output .= ' selected="selected" ';
                    945:        }
                    946:        $output .= '> </option>';
                    947:    }
1.657     raeburn   948:    my @timezones = DateTime::TimeZone->all_names;
                    949:    foreach my $tzone (@timezones) {
                    950:        $output.= '<option value="'.$tzone.'"';
                    951:        if ($tzone eq $selected) {
                    952:            $output.=' selected="selected"';
                    953:        }
                    954:        $output.=">$tzone</option>\n";
1.656     www       955:    }
                    956:    $output.="</select>";
                    957:    return $output;
                    958: }
1.273     raeburn   959: 
1.687     raeburn   960: sub select_datelocale {
                    961:     my ($name,$selected,$onchange,$includeempty)=@_;
                    962:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    963:     if ($includeempty) {
                    964:         $output .= '<option value=""';
                    965:         if ($selected eq '') {
                    966:             $output .= ' selected="selected" ';
                    967:         }
                    968:         $output .= '> </option>';
                    969:     }
                    970:     my (@possibles,%locale_names);
                    971:     my @locales = DateTime::Locale::Catalog::Locales;
                    972:     foreach my $locale (@locales) {
                    973:         if (ref($locale) eq 'HASH') {
                    974:             my $id = $locale->{'id'};
                    975:             if ($id ne '') {
                    976:                 my $en_terr = $locale->{'en_territory'};
                    977:                 my $native_terr = $locale->{'native_territory'};
1.695     raeburn   978:                 my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   979:                 if (grep(/^en$/,@languages) || !@languages) {
                    980:                     if ($en_terr ne '') {
                    981:                         $locale_names{$id} = '('.$en_terr.')';
                    982:                     } elsif ($native_terr ne '') {
                    983:                         $locale_names{$id} = $native_terr;
                    984:                     }
                    985:                 } else {
                    986:                     if ($native_terr ne '') {
                    987:                         $locale_names{$id} = $native_terr.' ';
                    988:                     } elsif ($en_terr ne '') {
                    989:                         $locale_names{$id} = '('.$en_terr.')';
                    990:                     }
                    991:                 }
1.1220    raeburn   992:                 $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.687     raeburn   993:                 push (@possibles,$id);
                    994:             }
                    995:         }
                    996:     }
                    997:     foreach my $item (sort(@possibles)) {
                    998:         $output.= '<option value="'.$item.'"';
                    999:         if ($item eq $selected) {
                   1000:             $output.=' selected="selected"';
                   1001:         }
                   1002:         $output.=">$item";
                   1003:         if ($locale_names{$item} ne '') {
1.1220    raeburn  1004:             $output.='  '.$locale_names{$item};
1.687     raeburn  1005:         }
                   1006:         $output.="</option>\n";
                   1007:     }
                   1008:     $output.="</select>";
                   1009:     return $output;
                   1010: }
                   1011: 
1.792     raeburn  1012: sub select_language {
                   1013:     my ($name,$selected,$includeempty) = @_;
                   1014:     my %langchoices;
                   1015:     if ($includeempty) {
1.1117    raeburn  1016:         %langchoices = ('' => 'No language preference');
1.792     raeburn  1017:     }
                   1018:     foreach my $id (&languageids()) {
                   1019:         my $code = &supportedlanguagecode($id);
                   1020:         if ($code) {
                   1021:             $langchoices{$code} = &plainlanguagedescription($id);
                   1022:         }
                   1023:     }
1.1117    raeburn  1024:     %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970     raeburn  1025:     return &select_form($selected,$name,\%langchoices);
1.792     raeburn  1026: }
                   1027: 
1.42      matthew  1028: =pod
1.36      matthew  1029: 
1.1088    foxr     1030: 
                   1031: =item * &list_languages()
                   1032: 
                   1033: Returns an array reference that is suitable for use in language prompters.
                   1034: Each array element is itself a two element array.  The first element
                   1035: is the language code.  The second element a descsriptiuon of the 
                   1036: language itself.  This is suitable for use in e.g.
                   1037: &Apache::edit::select_arg (once dereferenced that is).
                   1038: 
                   1039: =cut 
                   1040: 
                   1041: sub list_languages {
                   1042:     my @lang_choices;
                   1043: 
                   1044:     foreach my $id (&languageids()) {
                   1045: 	my $code = &supportedlanguagecode($id);
                   1046: 	if ($code) {
                   1047: 	    my $selector    = $supported_codes{$id};
                   1048: 	    my $description = &plainlanguagedescription($id);
                   1049: 	    push (@lang_choices, [$selector, $description]);
                   1050: 	}
                   1051:     }
                   1052:     return \@lang_choices;
                   1053: }
                   1054: 
                   1055: =pod
                   1056: 
1.648     raeburn  1057: =item * &linked_select_forms(...)
1.36      matthew  1058: 
                   1059: linked_select_forms returns a string containing a <script></script> block
                   1060: and html for two <select> menus.  The select menus will be linked in that
                   1061: changing the value of the first menu will result in new values being placed
                   1062: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1063: order unless a defined order is provided.
1.36      matthew  1064: 
                   1065: linked_select_forms takes the following ordered inputs:
                   1066: 
                   1067: =over 4
                   1068: 
1.112     bowersj2 1069: =item * $formname, the name of the <form> tag
1.36      matthew  1070: 
1.112     bowersj2 1071: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1072: 
1.112     bowersj2 1073: =item * $firstdefault, the default value for the first menu
1.36      matthew  1074: 
1.112     bowersj2 1075: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1076: 
1.112     bowersj2 1077: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1078: 
1.112     bowersj2 1079: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1080: 
1.609     raeburn  1081: =item * $menuorder, the order of values in the first menu
                   1082: 
1.1115    raeburn  1083: =item * $onchangefirst, additional javascript call to execute for an onchange
                   1084:         event for the first <select> tag
                   1085: 
                   1086: =item * $onchangesecond, additional javascript call to execute for an onchange
                   1087:         event for the second <select> tag
                   1088: 
1.41      ng       1089: =back 
                   1090: 
1.36      matthew  1091: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1092: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1093: values for the first select menu.  The text that coincides with the 
1.41      ng       1094: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1095: and text for the second menu are given in the hash pointed to by 
                   1096: $menu{$choice1}->{'select2'}.  
                   1097: 
1.112     bowersj2 1098:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1099:                        default => "B3",
                   1100:                        select2 => { 
                   1101:                            B1 => "Choice B1",
                   1102:                            B2 => "Choice B2",
                   1103:                            B3 => "Choice B3",
                   1104:                            B4 => "Choice B4"
1.609     raeburn  1105:                            },
                   1106:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1107:                    },
                   1108:                A2 => { text =>"Choice A2" ,
                   1109:                        default => "C2",
                   1110:                        select2 => { 
                   1111:                            C1 => "Choice C1",
                   1112:                            C2 => "Choice C2",
                   1113:                            C3 => "Choice C3"
1.609     raeburn  1114:                            },
                   1115:                        order => ['C2','C1','C3'],
1.112     bowersj2 1116:                    },
                   1117:                A3 => { text =>"Choice A3" ,
                   1118:                        default => "D6",
                   1119:                        select2 => { 
                   1120:                            D1 => "Choice D1",
                   1121:                            D2 => "Choice D2",
                   1122:                            D3 => "Choice D3",
                   1123:                            D4 => "Choice D4",
                   1124:                            D5 => "Choice D5",
                   1125:                            D6 => "Choice D6",
                   1126:                            D7 => "Choice D7"
1.609     raeburn  1127:                            },
                   1128:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1129:                    }
                   1130:                );
1.36      matthew  1131: 
                   1132: =cut
                   1133: 
                   1134: sub linked_select_forms {
                   1135:     my ($formname,
                   1136:         $middletext,
                   1137:         $firstdefault,
                   1138:         $firstselectname,
                   1139:         $secondselectname, 
1.609     raeburn  1140:         $hashref,
                   1141:         $menuorder,
1.1115    raeburn  1142:         $onchangefirst,
                   1143:         $onchangesecond
1.36      matthew  1144:         ) = @_;
                   1145:     my $second = "document.$formname.$secondselectname";
                   1146:     my $first = "document.$formname.$firstselectname";
                   1147:     # output the javascript to do the changing
                   1148:     my $result = '';
1.776     bisitz   1149:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1150:     $result.="// <![CDATA[\n";
1.36      matthew  1151:     $result.="var select2data = new Object();\n";
                   1152:     $" = '","';
                   1153:     my $debug = '';
                   1154:     foreach my $s1 (sort(keys(%$hashref))) {
                   1155:         $result.="select2data.d_$s1 = new Object();\n";        
                   1156:         $result.="select2data.d_$s1.def = new String('".
                   1157:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1158:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1159:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1160:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1161:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1162:         }
1.36      matthew  1163:         $result.="\"@s2values\");\n";
                   1164:         $result.="select2data.d_$s1.texts = new Array(";        
                   1165:         my @s2texts;
                   1166:         foreach my $value (@s2values) {
                   1167:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1168:         }
                   1169:         $result.="\"@s2texts\");\n";
                   1170:     }
                   1171:     $"=' ';
                   1172:     $result.= <<"END";
                   1173: 
                   1174: function select1_changed() {
                   1175:     // Determine new choice
                   1176:     var newvalue = "d_" + $first.value;
                   1177:     // update select2
                   1178:     var values     = select2data[newvalue].values;
                   1179:     var texts      = select2data[newvalue].texts;
                   1180:     var select2def = select2data[newvalue].def;
                   1181:     var i;
                   1182:     // out with the old
                   1183:     for (i = 0; i < $second.options.length; i++) {
                   1184:         $second.options[i] = null;
                   1185:     }
                   1186:     // in with the nuclear
                   1187:     for (i=0;i<values.length; i++) {
                   1188:         $second.options[i] = new Option(values[i]);
1.143     matthew  1189:         $second.options[i].value = values[i];
1.36      matthew  1190:         $second.options[i].text = texts[i];
                   1191:         if (values[i] == select2def) {
                   1192:             $second.options[i].selected = true;
                   1193:         }
                   1194:     }
                   1195: }
1.824     bisitz   1196: // ]]>
1.36      matthew  1197: </script>
                   1198: END
                   1199:     # output the initial values for the selection lists
1.1115    raeburn  1200:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609     raeburn  1201:     my @order = sort(keys(%{$hashref}));
                   1202:     if (ref($menuorder) eq 'ARRAY') {
                   1203:         @order = @{$menuorder};
                   1204:     }
                   1205:     foreach my $value (@order) {
1.36      matthew  1206:         $result.="    <option value=\"$value\" ";
1.253     albertel 1207:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1208:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1209:     }
                   1210:     $result .= "</select>\n";
                   1211:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1212:     $result .= $middletext;
1.1115    raeburn  1213:     $result .= "<select size=\"1\" name=\"$secondselectname\"";
                   1214:     if ($onchangesecond) {
                   1215:         $result .= ' onchange="'.$onchangesecond.'"';
                   1216:     }
                   1217:     $result .= ">\n";
1.36      matthew  1218:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1219:     
                   1220:     my @secondorder = sort(keys(%select2));
                   1221:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1222:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1223:     }
                   1224:     foreach my $value (@secondorder) {
1.36      matthew  1225:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1226:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1227:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1228:     }
                   1229:     $result .= "</select>\n";
                   1230:     #    return $debug;
                   1231:     return $result;
                   1232: }   #  end of sub linked_select_forms {
                   1233: 
1.45      matthew  1234: =pod
1.44      bowersj2 1235: 
1.973     raeburn  1236: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1237: 
1.112     bowersj2 1238: Returns a string corresponding to an HTML link to the given help
                   1239: $topic, where $topic corresponds to the name of a .tex file in
                   1240: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1241: spaces. 
                   1242: 
                   1243: $text will optionally be linked to the same topic, allowing you to
                   1244: link text in addition to the graphic. If you do not want to link
                   1245: text, but wish to specify one of the later parameters, pass an
                   1246: empty string. 
                   1247: 
                   1248: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1249: the link will not open a new window. If false, the link will open
                   1250: a new window using Javascript. (Default is false.) 
                   1251: 
                   1252: $width and $height are optional numerical parameters that will
                   1253: override the width and height of the popped up window, which may
1.973     raeburn  1254: be useful for certain help topics with big pictures included.
                   1255: 
                   1256: $imgid is the id of the img tag used for the help icon. This may be
                   1257: used in a javascript call to switch the image src.  See 
                   1258: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1259: 
                   1260: =cut
                   1261: 
                   1262: sub help_open_topic {
1.973     raeburn  1263:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1264:     $text = "" if (not defined $text);
1.44      bowersj2 1265:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1266:     $width = 500 if (not defined $width);
1.44      bowersj2 1267:     $height = 400 if (not defined $height);
                   1268:     my $filename = $topic;
                   1269:     $filename =~ s/ /_/g;
                   1270: 
1.48      bowersj2 1271:     my $template = "";
                   1272:     my $link;
1.572     banghart 1273:     
1.159     www      1274:     $topic=~s/\W/\_/g;
1.44      bowersj2 1275: 
1.572     banghart 1276:     if (!$stayOnPage) {
1.1033    www      1277: 	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037    www      1278:     } elsif ($stayOnPage eq 'popup') {
                   1279:         $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 1280:     } else {
1.48      bowersj2 1281: 	$link = "/adm/help/${filename}.hlp";
                   1282:     }
                   1283: 
                   1284:     # Add the text
1.755     neumanie 1285:     if ($text ne "") {	
1.763     bisitz   1286: 	$template.='<span class="LC_help_open_topic">'
                   1287:                   .'<a target="_top" href="'.$link.'">'
                   1288:                   .$text.'</a>';
1.48      bowersj2 1289:     }
                   1290: 
1.763     bisitz   1291:     # (Always) Add the graphic
1.179     matthew  1292:     my $title = &mt('Online Help');
1.667     raeburn  1293:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1294:     if ($imgid ne '') {
                   1295:         $imgid = ' id="'.$imgid.'"';
                   1296:     }
1.763     bisitz   1297:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1298:               .'<img src="'.$helpicon.'" border="0"'
                   1299:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1300:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1301:               .' /></a>';
                   1302:     if ($text ne "") {	
                   1303:         $template.='</span>';
                   1304:     }
1.44      bowersj2 1305:     return $template;
                   1306: 
1.106     bowersj2 1307: }
                   1308: 
                   1309: # This is a quicky function for Latex cheatsheet editing, since it 
                   1310: # appears in at least four places
                   1311: sub helpLatexCheatsheet {
1.1037    www      1312:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1313:     my $out;
1.106     bowersj2 1314:     my $addOther = '';
1.732     raeburn  1315:     if ($topic) {
1.1037    www      1316: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1317:     }
                   1318:     $out = '<span>' # Start cheatsheet
                   1319: 	  .$addOther
                   1320:           .'<span>'
1.1037    www      1321: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1322: 	  .'</span> <span>'
1.1037    www      1323: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1324: 	  .'</span>';
1.732     raeburn  1325:     unless ($not_author) {
1.1186    kruse    1326:         $out .= '<span>'
                   1327:                .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
                   1328:                .'</span> <span>'
                   1329:                .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763     bisitz   1330: 	       .'</span>';
1.732     raeburn  1331:     }
1.763     bisitz   1332:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1333:     return $out;
1.172     www      1334: }
                   1335: 
1.430     albertel 1336: sub general_help {
                   1337:     my $helptopic='Student_Intro';
                   1338:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1339: 	$helptopic='Authoring_Intro';
1.907     raeburn  1340:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1341: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1342:     } elsif ($env{'request.role'}=~/^dc/) {
                   1343:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1344:     }
                   1345:     return $helptopic;
                   1346: }
                   1347: 
                   1348: sub update_help_link {
                   1349:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1350:     my $origurl = $ENV{'REQUEST_URI'};
                   1351:     $origurl=~s|^/~|/priv/|;
                   1352:     my $timestamp = time;
                   1353:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1354:         $$datum = &escape($$datum);
                   1355:     }
                   1356: 
                   1357:     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";
                   1358:     my $output .= <<"ENDOUTPUT";
                   1359: <script type="text/javascript">
1.824     bisitz   1360: // <![CDATA[
1.430     albertel 1361: banner_link = '$banner_link';
1.824     bisitz   1362: // ]]>
1.430     albertel 1363: </script>
                   1364: ENDOUTPUT
                   1365:     return $output;
                   1366: }
                   1367: 
                   1368: # now just updates the help link and generates a blue icon
1.193     raeburn  1369: sub help_open_menu {
1.430     albertel 1370:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1371: 	= @_;    
1.949     droeschl 1372:     $stayOnPage = 1;
1.430     albertel 1373:     my $output;
                   1374:     if ($component_help) {
                   1375: 	if (!$text) {
                   1376: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1377: 				       $width,$height);
                   1378: 	} else {
                   1379: 	    my $help_text;
                   1380: 	    $help_text=&unescape($topic);
                   1381: 	    $output='<table><tr><td>'.
                   1382: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1383: 				 $width,$height).'</td></tr></table>';
                   1384: 	}
                   1385:     }
                   1386:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1387:     return $output.$banner_link;
                   1388: }
                   1389: 
                   1390: sub top_nav_help {
                   1391:     my ($text) = @_;
1.436     albertel 1392:     $text = &mt($text);
1.949     droeschl 1393:     my $stay_on_page = 1;
                   1394: 
1.1168    raeburn  1395:     my ($link,$banner_link);
                   1396:     unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
                   1397:         $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                   1398: 	                         : "javascript:helpMenu('open')";
                   1399:         $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
                   1400:     }
1.201     raeburn  1401:     my $title = &mt('Get help');
1.1168    raeburn  1402:     if ($link) {
                   1403:         return <<"END";
1.436     albertel 1404: $banner_link
1.1159    raeburn  1405: <a href="$link" title="$title">$text</a>
1.436     albertel 1406: END
1.1168    raeburn  1407:     } else {
                   1408:         return '&nbsp;'.$text.'&nbsp;';
                   1409:     }
1.436     albertel 1410: }
                   1411: 
                   1412: sub help_menu_js {
1.1154    raeburn  1413:     my ($httphost) = @_;
1.949     droeschl 1414:     my $stayOnPage = 1;
1.436     albertel 1415:     my $width = 620;
                   1416:     my $height = 600;
1.430     albertel 1417:     my $helptopic=&general_help();
1.1154    raeburn  1418:     my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1419:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1420:     my $start_page =
                   1421:         &Apache::loncommon::start_page('Help Menu', undef,
                   1422: 				       {'frameset'    => 1,
                   1423: 					'js_ready'    => 1,
1.1154    raeburn  1424:                                         'use_absolute' => $httphost,
1.331     albertel 1425: 					'add_entries' => {
1.1168    raeburn  1426: 					    'border' => '0', 
1.579     raeburn  1427: 					    'rows'   => "110,*",},});
1.331     albertel 1428:     my $end_page =
                   1429:         &Apache::loncommon::end_page({'frameset' => 1,
                   1430: 				      'js_ready' => 1,});
                   1431: 
1.436     albertel 1432:     my $template .= <<"ENDTEMPLATE";
                   1433: <script type="text/javascript">
1.877     bisitz   1434: // <![CDATA[
1.253     albertel 1435: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1436: var banner_link = '';
1.243     raeburn  1437: function helpMenu(target) {
                   1438:     var caller = this;
                   1439:     if (target == 'open') {
                   1440:         var newWindow = null;
                   1441:         try {
1.262     albertel 1442:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1443:         }
                   1444:         catch(error) {
                   1445:             writeHelp(caller);
                   1446:             return;
                   1447:         }
                   1448:         if (newWindow) {
                   1449:             caller = newWindow;
                   1450:         }
1.193     raeburn  1451:     }
1.243     raeburn  1452:     writeHelp(caller);
                   1453:     return;
                   1454: }
                   1455: function writeHelp(caller) {
1.1168    raeburn  1456:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
                   1457:     caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
                   1458:     caller.document.close();
                   1459:     caller.focus();
1.193     raeburn  1460: }
1.877     bisitz   1461: // END LON-CAPA Internal -->
1.253     albertel 1462: // ]]>
1.436     albertel 1463: </script>
1.193     raeburn  1464: ENDTEMPLATE
                   1465:     return $template;
                   1466: }
                   1467: 
1.172     www      1468: sub help_open_bug {
                   1469:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1470:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1471:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1472:     $text = "" if (not defined $text);
                   1473: 	$stayOnPage=1;
1.184     albertel 1474:     $width = 600 if (not defined $width);
                   1475:     $height = 600 if (not defined $height);
1.172     www      1476: 
                   1477:     $topic=~s/\W+/\+/g;
                   1478:     my $link='';
                   1479:     my $template='';
1.379     albertel 1480:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1481: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1482:     if (!$stayOnPage)
                   1483:     {
                   1484: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1485:     }
                   1486:     else
                   1487:     {
                   1488: 	$link = $url;
                   1489:     }
                   1490:     # Add the text
                   1491:     if ($text ne "")
                   1492:     {
                   1493: 	$template .= 
                   1494:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1495:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1496:     }
                   1497: 
                   1498:     # Add the graphic
1.179     matthew  1499:     my $title = &mt('Report a Bug');
1.215     albertel 1500:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1501:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1502:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1503: ENDTEMPLATE
                   1504:     if ($text ne '') { $template.='</td></tr></table>' };
                   1505:     return $template;
                   1506: 
                   1507: }
                   1508: 
                   1509: sub help_open_faq {
                   1510:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1511:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1512:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1513:     $text = "" if (not defined $text);
                   1514: 	$stayOnPage=1;
                   1515:     $width = 350 if (not defined $width);
                   1516:     $height = 400 if (not defined $height);
                   1517: 
                   1518:     $topic=~s/\W+/\+/g;
                   1519:     my $link='';
                   1520:     my $template='';
                   1521:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1522:     if (!$stayOnPage)
                   1523:     {
                   1524: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1525:     }
                   1526:     else
                   1527:     {
                   1528: 	$link = $url;
                   1529:     }
                   1530: 
                   1531:     # Add the text
                   1532:     if ($text ne "")
                   1533:     {
                   1534: 	$template .= 
1.173     www      1535:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1536:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1537:     }
                   1538: 
                   1539:     # Add the graphic
1.179     matthew  1540:     my $title = &mt('View the FAQ');
1.215     albertel 1541:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1542:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1543:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1544: ENDTEMPLATE
                   1545:     if ($text ne '') { $template.='</td></tr></table>' };
                   1546:     return $template;
                   1547: 
1.44      bowersj2 1548: }
1.37      matthew  1549: 
1.180     matthew  1550: ###############################################################
                   1551: ###############################################################
                   1552: 
1.45      matthew  1553: =pod
                   1554: 
1.648     raeburn  1555: =item * &change_content_javascript():
1.256     matthew  1556: 
                   1557: This and the next function allow you to create small sections of an
                   1558: otherwise static HTML page that you can update on the fly with
                   1559: Javascript, even in Netscape 4.
                   1560: 
                   1561: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1562: must be written to the HTML page once. It will prove the Javascript
                   1563: function "change(name, content)". Calling the change function with the
                   1564: name of the section 
                   1565: you want to update, matching the name passed to C<changable_area>, and
                   1566: the new content you want to put in there, will put the content into
                   1567: that area.
                   1568: 
                   1569: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1570: to contain room for the original contents. You need to "make space"
                   1571: for whatever changes you wish to make, and be B<sure> to check your
                   1572: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1573: it's adequate for updating a one-line status display, but little more.
                   1574: This script will set the space to 100% width, so you only need to
                   1575: worry about height in Netscape 4.
                   1576: 
                   1577: Modern browsers are much less limiting, and if you can commit to the
                   1578: user not using Netscape 4, this feature may be used freely with
                   1579: pretty much any HTML.
                   1580: 
                   1581: =cut
                   1582: 
                   1583: sub change_content_javascript {
                   1584:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1585:     if ($env{'browser.type'} eq 'netscape' &&
                   1586: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1587: 	return (<<NETSCAPE4);
                   1588: 	function change(name, content) {
                   1589: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1590: 	    doc.open();
                   1591: 	    doc.write(content);
                   1592: 	    doc.close();
                   1593: 	}
                   1594: NETSCAPE4
                   1595:     } else {
                   1596: 	# Otherwise, we need to use semi-standards-compliant code
                   1597: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1598: 	# is really scary, and every useful browser supports it
                   1599: 	return (<<DOMBASED);
                   1600: 	function change(name, content) {
                   1601: 	    element = document.getElementById(name);
                   1602: 	    element.innerHTML = content;
                   1603: 	}
                   1604: DOMBASED
                   1605:     }
                   1606: }
                   1607: 
                   1608: =pod
                   1609: 
1.648     raeburn  1610: =item * &changable_area($name,$origContent):
1.256     matthew  1611: 
                   1612: This provides a "changable area" that can be modified on the fly via
                   1613: the Javascript code provided in C<change_content_javascript>. $name is
                   1614: the name you will use to reference the area later; do not repeat the
                   1615: same name on a given HTML page more then once. $origContent is what
                   1616: the area will originally contain, which can be left blank.
                   1617: 
                   1618: =cut
                   1619: 
                   1620: sub changable_area {
                   1621:     my ($name, $origContent) = @_;
                   1622: 
1.258     albertel 1623:     if ($env{'browser.type'} eq 'netscape' &&
                   1624: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1625: 	# If this is netscape 4, we need to use the Layer tag
                   1626: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1627:     } else {
                   1628: 	return "<span id='$name'>$origContent</span>";
                   1629:     }
                   1630: }
                   1631: 
                   1632: =pod
                   1633: 
1.648     raeburn  1634: =item * &viewport_geometry_js 
1.590     raeburn  1635: 
                   1636: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1637: 
                   1638: =cut
                   1639: 
                   1640: 
                   1641: sub viewport_geometry_js { 
                   1642:     return <<"GEOMETRY";
                   1643: var Geometry = {};
                   1644: function init_geometry() {
                   1645:     if (Geometry.init) { return };
                   1646:     Geometry.init=1;
                   1647:     if (window.innerHeight) {
                   1648:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1649:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1650:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1651:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1652:     }
                   1653:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1654:         Geometry.getViewportHeight =
                   1655:             function() { return document.documentElement.clientHeight; };
                   1656:         Geometry.getViewportWidth =
                   1657:             function() { return document.documentElement.clientWidth; };
                   1658: 
                   1659:         Geometry.getHorizontalScroll =
                   1660:             function() { return document.documentElement.scrollLeft; };
                   1661:         Geometry.getVerticalScroll =
                   1662:             function() { return document.documentElement.scrollTop; };
                   1663:     }
                   1664:     else if (document.body.clientHeight) {
                   1665:         Geometry.getViewportHeight =
                   1666:             function() { return document.body.clientHeight; };
                   1667:         Geometry.getViewportWidth =
                   1668:             function() { return document.body.clientWidth; };
                   1669:         Geometry.getHorizontalScroll =
                   1670:             function() { return document.body.scrollLeft; };
                   1671:         Geometry.getVerticalScroll =
                   1672:             function() { return document.body.scrollTop; };
                   1673:     }
                   1674: }
                   1675: 
                   1676: GEOMETRY
                   1677: }
                   1678: 
                   1679: =pod
                   1680: 
1.648     raeburn  1681: =item * &viewport_size_js()
1.590     raeburn  1682: 
                   1683: 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. 
                   1684: 
                   1685: =cut
                   1686: 
                   1687: sub viewport_size_js {
                   1688:     my $geometry = &viewport_geometry_js();
                   1689:     return <<"DIMS";
                   1690: 
                   1691: $geometry
                   1692: 
                   1693: function getViewportDims(width,height) {
                   1694:     init_geometry();
                   1695:     width.value = Geometry.getViewportWidth();
                   1696:     height.value = Geometry.getViewportHeight();
                   1697:     return;
                   1698: }
                   1699: 
                   1700: DIMS
                   1701: }
                   1702: 
                   1703: =pod
                   1704: 
1.648     raeburn  1705: =item * &resize_textarea_js()
1.565     albertel 1706: 
                   1707: emits the needed javascript to resize a textarea to be as big as possible
                   1708: 
                   1709: creates a function resize_textrea that takes two IDs first should be
                   1710: the id of the element to resize, second should be the id of a div that
                   1711: surrounds everything that comes after the textarea, this routine needs
                   1712: to be attached to the <body> for the onload and onresize events.
                   1713: 
1.648     raeburn  1714: =back
1.565     albertel 1715: 
                   1716: =cut
                   1717: 
                   1718: sub resize_textarea_js {
1.590     raeburn  1719:     my $geometry = &viewport_geometry_js();
1.565     albertel 1720:     return <<"RESIZE";
                   1721:     <script type="text/javascript">
1.824     bisitz   1722: // <![CDATA[
1.590     raeburn  1723: $geometry
1.565     albertel 1724: 
1.588     albertel 1725: function getX(element) {
                   1726:     var x = 0;
                   1727:     while (element) {
                   1728: 	x += element.offsetLeft;
                   1729: 	element = element.offsetParent;
                   1730:     }
                   1731:     return x;
                   1732: }
                   1733: function getY(element) {
                   1734:     var y = 0;
                   1735:     while (element) {
                   1736: 	y += element.offsetTop;
                   1737: 	element = element.offsetParent;
                   1738:     }
                   1739:     return y;
                   1740: }
                   1741: 
                   1742: 
1.565     albertel 1743: function resize_textarea(textarea_id,bottom_id) {
                   1744:     init_geometry();
                   1745:     var textarea        = document.getElementById(textarea_id);
                   1746:     //alert(textarea);
                   1747: 
1.588     albertel 1748:     var textarea_top    = getY(textarea);
1.565     albertel 1749:     var textarea_height = textarea.offsetHeight;
                   1750:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1751:     var bottom_top      = getY(bottom);
1.565     albertel 1752:     var bottom_height   = bottom.offsetHeight;
                   1753:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1754:     var fudge           = 23;
1.565     albertel 1755:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1756:     if (new_height < 300) {
                   1757: 	new_height = 300;
                   1758:     }
                   1759:     textarea.style.height=new_height+'px';
                   1760: }
1.824     bisitz   1761: // ]]>
1.565     albertel 1762: </script>
                   1763: RESIZE
                   1764: 
                   1765: }
                   1766: 
1.1205    golterma 1767: sub colorfuleditor_js {
                   1768:     return <<"COLORFULEDIT"
                   1769: <script type="text/javascript">
                   1770: // <![CDATA[>
                   1771:     function fold_box(curDepth, lastresource){
                   1772: 
                   1773:     // we need a list because there can be several blocks you need to fold in one tag
                   1774:         var block = document.getElementsByName('foldblock_'+curDepth);
                   1775:     // but there is only one folding button per tag
                   1776:         var foldbutton = document.getElementById('folding_btn_'+curDepth);
                   1777: 
                   1778:         if(block.item(0).style.display == 'none'){
                   1779: 
                   1780:             foldbutton.value = '@{[&mt("Hide")]}';
                   1781:             for (i = 0; i < block.length; i++){
                   1782:                 block.item(i).style.display = '';
                   1783:             }
                   1784:         }else{
                   1785: 
                   1786:             foldbutton.value = '@{[&mt("Show")]}';
                   1787:             for (i = 0; i < block.length; i++){
                   1788:                 // block.item(i).style.visibility = 'collapse';
                   1789:                 block.item(i).style.display = 'none';
                   1790:             }
                   1791:         };
                   1792:         saveState(lastresource);
                   1793:     }
                   1794: 
                   1795:     function saveState (lastresource) {
                   1796: 
                   1797:         var tag_list = getTagList();
                   1798:         if(tag_list != null){
                   1799:             var timestamp = new Date().getTime();
                   1800:             var key = lastresource;
                   1801: 
                   1802:             // the value pattern is: 'time;key1,value1;key2,value2; ... '
                   1803:             // starting with timestamp
                   1804:             var value = timestamp+';';
                   1805: 
                   1806:             // building the list of key-value pairs
                   1807:             for(var i = 0; i < tag_list.length; i++){
                   1808:                 value += tag_list[i]+',';
                   1809:                 value += document.getElementsByName(tag_list[i])[0].style.display+';';
                   1810:             }
                   1811: 
                   1812:             // only iterate whole storage if nothing to override
                   1813:             if(localStorage.getItem(key) == null){        
                   1814: 
                   1815:                 // prevent storage from growing large
                   1816:                 if(localStorage.length > 50){
                   1817:                     var regex_getTimestamp = /^(?:\d)+;/;
                   1818:                     var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
                   1819:                     var oldest_key;
                   1820:                     
                   1821:                     for(var i = 1; i < localStorage.length; i++){
                   1822:                         if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
                   1823:                             oldest_key = localStorage.key(i);
                   1824:                             oldest_timestamp = regex_getTimestamp.exec(oldest_key);
                   1825:                         }
                   1826:                     }
                   1827:                     localStorage.removeItem(oldest_key);
                   1828:                 }
                   1829:             }
                   1830:             localStorage.setItem(key,value);
                   1831:         }
                   1832:     }
                   1833: 
                   1834:     // restore folding status of blocks (on page load)
                   1835:     function restoreState (lastresource) {
                   1836:         if(localStorage.getItem(lastresource) != null){
                   1837:             var key = lastresource;
                   1838:             var value = localStorage.getItem(key);
                   1839:             var regex_delTimestamp = /^\d+;/;
                   1840: 
                   1841:             value.replace(regex_delTimestamp, '');
                   1842: 
                   1843:             var valueArr = value.split(';');
                   1844:             var pairs;
                   1845:             var elements;
                   1846:             for (var i = 0; i < valueArr.length; i++){
                   1847:                 pairs = valueArr[i].split(',');
                   1848:                 elements = document.getElementsByName(pairs[0]);
                   1849: 
                   1850:                 for (var j = 0; j < elements.length; j++){  
                   1851:                     elements[j].style.display = pairs[1];
                   1852:                     if (pairs[1] == "none"){
                   1853:                         var regex_id = /([_\\d]+)\$/;
                   1854:                         regex_id.exec(pairs[0]);
                   1855:                         document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
                   1856:                     }
                   1857:                 }
                   1858:             }
                   1859:         }
                   1860:     }
                   1861: 
                   1862:     function getTagList () {
                   1863:         
                   1864:         var stringToSearch = document.lonhomework.innerHTML;
                   1865: 
                   1866:         var ret = new Array();
                   1867:         var regex_findBlock = /(foldblock_.*?)"/g;
                   1868:         var tag_list = stringToSearch.match(regex_findBlock);
                   1869: 
                   1870:         if(tag_list != null){
                   1871:             for(var i = 0; i < tag_list.length; i++){            
                   1872:                 ret.push(tag_list[i].replace(/"/, ''));
                   1873:             }
                   1874:         }
                   1875:         return ret;
                   1876:     }
                   1877: 
                   1878:     function saveScrollPosition (resource) {
                   1879:         var tag_list = getTagList();
                   1880: 
                   1881:         // we dont always want to jump to the first block
                   1882:         // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
                   1883:         if(\$(window).scrollTop() > 170){
                   1884:             if(tag_list != null){
                   1885:                 var result;
                   1886:                 for(var i = 0; i < tag_list.length; i++){
                   1887:                     if(isElementInViewport(tag_list[i])){
                   1888:                         result += tag_list[i]+';';
                   1889:                     }
                   1890:                 }
                   1891:                 sessionStorage.setItem('anchor_'+resource, result);
                   1892:             }
                   1893:         } else {
                   1894:             // we dont need to save zero, just delete the item to leave everything tidy
                   1895:             sessionStorage.removeItem('anchor_'+resource);
                   1896:         }
                   1897:     }
                   1898: 
                   1899:     function restoreScrollPosition(resource){
                   1900: 
                   1901:         var elem = sessionStorage.getItem('anchor_'+resource);
                   1902:         if(elem != null){
                   1903:             var tag_list = elem.split(';');
                   1904:             var elem_list;
                   1905: 
                   1906:             for(var i = 0; i < tag_list.length; i++){
                   1907:                 elem_list = document.getElementsByName(tag_list[i]);
                   1908:                 
                   1909:                 if(elem_list.length > 0){
                   1910:                     elem = elem_list[0];
                   1911:                     break;
                   1912:                 }
                   1913:             }
                   1914:             elem.scrollIntoView();
                   1915:         }
                   1916:     }
                   1917: 
                   1918:     function isElementInViewport(el) {
                   1919: 
                   1920:         // change to last element instead of first
                   1921:         var elem = document.getElementsByName(el);
                   1922:         var rect = elem[0].getBoundingClientRect();
                   1923: 
                   1924:         return (
                   1925:             rect.top >= 0 &&
                   1926:             rect.left >= 0 &&
                   1927:             rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
                   1928:             rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
                   1929:         );
                   1930:     }
                   1931:     
                   1932:     function autosize(depth){
                   1933:         var cmInst = window['cm'+depth];
                   1934:         var fitsizeButton = document.getElementById('fitsize'+depth);
                   1935: 
                   1936:         // is fixed size, switching to dynamic
                   1937:         if (sessionStorage.getItem("autosized_"+depth) == null) {
                   1938:             cmInst.setSize("","auto");
                   1939:             fitsizeButton.value = "@{[&mt('Fixed size')]}";
                   1940:             sessionStorage.setItem("autosized_"+depth, "yes");
                   1941: 
                   1942:         // is dynamic size, switching to fixed
                   1943:         } else {
                   1944:             cmInst.setSize("","300px");
                   1945:             fitsizeButton.value = "@{[&mt('Dynamic size')]}";
                   1946:             sessionStorage.removeItem("autosized_"+depth);
                   1947:         }
                   1948:     }
                   1949: 
                   1950: 
                   1951: 
                   1952: // ]]>
                   1953: </script>
                   1954: COLORFULEDIT
                   1955: }
                   1956: 
                   1957: sub xmleditor_js {
                   1958:     return <<XMLEDIT
                   1959: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
                   1960: <script type="text/javascript">
                   1961: // <![CDATA[>
                   1962: 
                   1963:     function saveScrollPosition (resource) {
                   1964: 
                   1965:         var scrollPos = \$(window).scrollTop();
                   1966:         sessionStorage.setItem(resource,scrollPos);
                   1967:     }
                   1968: 
                   1969:     function restoreScrollPosition(resource){
                   1970: 
                   1971:         var scrollPos = sessionStorage.getItem(resource);
                   1972:         \$(window).scrollTop(scrollPos);
                   1973:     }
                   1974: 
                   1975:     // unless internet explorer
                   1976:     if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
                   1977: 
                   1978:         \$(document).ready(function() {
                   1979:              \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
                   1980:         });
                   1981:     }
                   1982: 
                   1983:     // inserts text at cursor position into codemirror (xml editor only)
                   1984:     function insertText(text){
                   1985:         cm.focus();
                   1986:         var curPos = cm.getCursor();
                   1987:         cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
                   1988:     }
                   1989: // ]]>
                   1990: </script>
                   1991: XMLEDIT
                   1992: }
                   1993: 
                   1994: sub insert_folding_button {
                   1995:     my $curDepth = $Apache::lonxml::curdepth;
                   1996:     my $lastresource = $env{'request.ambiguous'};
                   1997: 
                   1998:     return "<input type=\"button\" id=\"folding_btn_$curDepth\" 
                   1999:             value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
                   2000: }
                   2001: 
1.565     albertel 2002: =pod
                   2003: 
1.256     matthew  2004: =head1 Excel and CSV file utility routines
                   2005: 
                   2006: =cut
                   2007: 
                   2008: ###############################################################
                   2009: ###############################################################
                   2010: 
                   2011: =pod
                   2012: 
1.1162    raeburn  2013: =over 4
                   2014: 
1.648     raeburn  2015: =item * &csv_translate($text) 
1.37      matthew  2016: 
1.185     www      2017: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  2018: format.
                   2019: 
                   2020: =cut
                   2021: 
1.180     matthew  2022: ###############################################################
                   2023: ###############################################################
1.37      matthew  2024: sub csv_translate {
                   2025:     my $text = shift;
                   2026:     $text =~ s/\"/\"\"/g;
1.209     albertel 2027:     $text =~ s/\n/ /g;
1.37      matthew  2028:     return $text;
                   2029: }
1.180     matthew  2030: 
                   2031: ###############################################################
                   2032: ###############################################################
                   2033: 
                   2034: =pod
                   2035: 
1.648     raeburn  2036: =item * &define_excel_formats()
1.180     matthew  2037: 
                   2038: Define some commonly used Excel cell formats.
                   2039: 
                   2040: Currently supported formats:
                   2041: 
                   2042: =over 4
                   2043: 
                   2044: =item header
                   2045: 
                   2046: =item bold
                   2047: 
                   2048: =item h1
                   2049: 
                   2050: =item h2
                   2051: 
                   2052: =item h3
                   2053: 
1.256     matthew  2054: =item h4
                   2055: 
                   2056: =item i
                   2057: 
1.180     matthew  2058: =item date
                   2059: 
                   2060: =back
                   2061: 
                   2062: Inputs: $workbook
                   2063: 
                   2064: Returns: $format, a hash reference.
                   2065: 
1.1057    foxr     2066: 
1.180     matthew  2067: =cut
                   2068: 
                   2069: ###############################################################
                   2070: ###############################################################
                   2071: sub define_excel_formats {
                   2072:     my ($workbook) = @_;
                   2073:     my $format;
                   2074:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   2075:                                                 bottom    => 1,
                   2076:                                                 align     => 'center');
                   2077:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   2078:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   2079:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   2080:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  2081:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  2082:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  2083:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  2084:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  2085:     return $format;
                   2086: }
                   2087: 
                   2088: ###############################################################
                   2089: ###############################################################
1.113     bowersj2 2090: 
                   2091: =pod
                   2092: 
1.648     raeburn  2093: =item * &create_workbook()
1.255     matthew  2094: 
                   2095: Create an Excel worksheet.  If it fails, output message on the
                   2096: request object and return undefs.
                   2097: 
                   2098: Inputs: Apache request object
                   2099: 
                   2100: Returns (undef) on failure, 
                   2101:     Excel worksheet object, scalar with filename, and formats 
                   2102:     from &Apache::loncommon::define_excel_formats on success
                   2103: 
                   2104: =cut
                   2105: 
                   2106: ###############################################################
                   2107: ###############################################################
                   2108: sub create_workbook {
                   2109:     my ($r) = @_;
                   2110:         #
                   2111:     # Create the excel spreadsheet
                   2112:     my $filename = '/prtspool/'.
1.258     albertel 2113:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  2114:         time.'_'.rand(1000000000).'.xls';
                   2115:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   2116:     if (! defined($workbook)) {
                   2117:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   2118:         $r->print(
                   2119:             '<p class="LC_error">'
                   2120:            .&mt('Problems occurred in creating the new Excel file.')
                   2121:            .' '.&mt('This error has been logged.')
                   2122:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2123:            .'</p>'
                   2124:         );
1.255     matthew  2125:         return (undef);
                   2126:     }
                   2127:     #
1.1014    foxr     2128:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  2129:     #
                   2130:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   2131:     return ($workbook,$filename,$format);
                   2132: }
                   2133: 
                   2134: ###############################################################
                   2135: ###############################################################
                   2136: 
                   2137: =pod
                   2138: 
1.648     raeburn  2139: =item * &create_text_file()
1.113     bowersj2 2140: 
1.542     raeburn  2141: Create a file to write to and eventually make available to the user.
1.256     matthew  2142: If file creation fails, outputs an error message on the request object and 
                   2143: return undefs.
1.113     bowersj2 2144: 
1.256     matthew  2145: Inputs: Apache request object, and file suffix
1.113     bowersj2 2146: 
1.256     matthew  2147: Returns (undef) on failure, 
                   2148:     Filehandle and filename on success.
1.113     bowersj2 2149: 
                   2150: =cut
                   2151: 
1.256     matthew  2152: ###############################################################
                   2153: ###############################################################
                   2154: sub create_text_file {
                   2155:     my ($r,$suffix) = @_;
                   2156:     if (! defined($suffix)) { $suffix = 'txt'; };
                   2157:     my $fh;
                   2158:     my $filename = '/prtspool/'.
1.258     albertel 2159:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  2160:         time.'_'.rand(1000000000).'.'.$suffix;
                   2161:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   2162:     if (! defined($fh)) {
                   2163:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   2164:         $r->print(
                   2165:             '<p class="LC_error">'
                   2166:            .&mt('Problems occurred in creating the output file.')
                   2167:            .' '.&mt('This error has been logged.')
                   2168:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2169:            .'</p>'
                   2170:         );
1.113     bowersj2 2171:     }
1.256     matthew  2172:     return ($fh,$filename)
1.113     bowersj2 2173: }
                   2174: 
                   2175: 
1.256     matthew  2176: =pod 
1.113     bowersj2 2177: 
                   2178: =back
                   2179: 
                   2180: =cut
1.37      matthew  2181: 
                   2182: ###############################################################
1.33      matthew  2183: ##        Home server <option> list generating code          ##
                   2184: ###############################################################
1.35      matthew  2185: 
1.169     www      2186: # ------------------------------------------
                   2187: 
                   2188: sub domain_select {
                   2189:     my ($name,$value,$multiple)=@_;
                   2190:     my %domains=map { 
1.514     albertel 2191: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 2192:     } &Apache::lonnet::all_domains();
1.169     www      2193:     if ($multiple) {
                   2194: 	$domains{''}=&mt('Any domain');
1.550     albertel 2195: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 2196: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      2197:     } else {
1.550     albertel 2198: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  2199: 	return &select_form($name,$value,\%domains);
1.169     www      2200:     }
                   2201: }
                   2202: 
1.282     albertel 2203: #-------------------------------------------
                   2204: 
                   2205: =pod
                   2206: 
1.519     raeburn  2207: =head1 Routines for form select boxes
                   2208: 
                   2209: =over 4
                   2210: 
1.648     raeburn  2211: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 2212: 
                   2213: Returns a string containing a <select> element int multiple mode
                   2214: 
                   2215: 
                   2216: Args:
                   2217:   $name - name of the <select> element
1.506     raeburn  2218:   $value - scalar or array ref of values that should already be selected
1.282     albertel 2219:   $size - number of rows long the select element is
1.283     albertel 2220:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 2221:           (shown text should already have been &mt())
1.506     raeburn  2222:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 2223: 
1.282     albertel 2224: =cut
                   2225: 
                   2226: #-------------------------------------------
1.169     www      2227: sub multiple_select_form {
1.284     albertel 2228:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      2229:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   2230:     my $output='';
1.191     matthew  2231:     if (! defined($size)) {
                   2232:         $size = 4;
1.283     albertel 2233:         if (scalar(keys(%$hash))<4) {
                   2234:             $size = scalar(keys(%$hash));
1.191     matthew  2235:         }
                   2236:     }
1.734     bisitz   2237:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 2238:     my @order;
1.506     raeburn  2239:     if (ref($order) eq 'ARRAY')  {
                   2240:         @order = @{$order};
                   2241:     } else {
                   2242:         @order = sort(keys(%$hash));
1.501     banghart 2243:     }
                   2244:     if (exists($$hash{'select_form_order'})) {
                   2245:         @order = @{$$hash{'select_form_order'}};
                   2246:     }
                   2247:         
1.284     albertel 2248:     foreach my $key (@order) {
1.356     albertel 2249:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 2250:         $output.='selected="selected" ' if ($selected{$key});
                   2251:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      2252:     }
                   2253:     $output.="</select>\n";
                   2254:     return $output;
                   2255: }
                   2256: 
1.88      www      2257: #-------------------------------------------
                   2258: 
                   2259: =pod
                   2260: 
1.970     raeburn  2261: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      2262: 
                   2263: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  2264: allow a user to select options from a ref to a hash containing:
                   2265: option_name => displayed text. An optional $onchange can include
                   2266: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   2267: 
1.88      www      2268: See lonrights.pm for an example invocation and use.
                   2269: 
                   2270: =cut
                   2271: 
                   2272: #-------------------------------------------
                   2273: sub select_form {
1.970     raeburn  2274:     my ($def,$name,$hashref,$onchange) = @_;
                   2275:     return unless (ref($hashref) eq 'HASH');
                   2276:     if ($onchange) {
                   2277:         $onchange = ' onchange="'.$onchange.'"';
                   2278:     }
                   2279:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 2280:     my @keys;
1.970     raeburn  2281:     if (exists($hashref->{'select_form_order'})) {
                   2282: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2283:     } else {
1.970     raeburn  2284: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2285:     }
1.356     albertel 2286:     foreach my $key (@keys) {
                   2287:         $selectform.=
                   2288: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2289:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2290:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2291:     }
                   2292:     $selectform.="</select>";
                   2293:     return $selectform;
                   2294: }
                   2295: 
1.475     www      2296: # For display filters
                   2297: 
                   2298: sub display_filter {
1.1074    raeburn  2299:     my ($context) = @_;
1.475     www      2300:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2301:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2302:     my $phraseinput = 'hidden';
                   2303:     my $includeinput = 'hidden';
                   2304:     my ($checked,$includetypestext);
                   2305:     if ($env{'form.displayfilter'} eq 'containing') {
                   2306:         $phraseinput = 'text'; 
                   2307:         if ($context eq 'parmslog') {
                   2308:             $includeinput = 'checkbox';
                   2309:             if ($env{'form.includetypes'}) {
                   2310:                 $checked = ' checked="checked"';
                   2311:             }
                   2312:             $includetypestext = &mt('Include parameter types');
                   2313:         }
                   2314:     } else {
                   2315:         $includetypestext = '&nbsp;';
                   2316:     }
                   2317:     my ($additional,$secondid,$thirdid);
                   2318:     if ($context eq 'parmslog') {
                   2319:         $additional = 
                   2320:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2321:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2322:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2323:             '</label>';
                   2324:         $secondid = 'includetypes';
                   2325:         $thirdid = 'includetypestext';
                   2326:     }
                   2327:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2328:                                                     '$secondid','$thirdid')";
                   2329:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2330: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2331: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2332: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2333:            &mt('Filter: [_1]',
1.477     www      2334: 	   &select_form($env{'form.displayfilter'},
                   2335: 			'displayfilter',
1.970     raeburn  2336: 			{'currentfolder' => 'Current folder/page',
1.477     www      2337: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2338: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2339: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2340:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2341:                          '" />'.$additional;
                   2342: }
                   2343: 
                   2344: sub display_filter_js {
                   2345:     my $includetext = &mt('Include parameter types');
                   2346:     return <<"ENDJS";
                   2347:   
                   2348: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2349:     var firstType = 'hidden';
                   2350:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2351:         firstType = 'text';
                   2352:     }
                   2353:     firstObject = document.getElementById(firstid);
                   2354:     if (typeof(firstObject) == 'object') {
                   2355:         if (firstObject.type != firstType) {
                   2356:             changeInputType(firstObject,firstType);
                   2357:         }
                   2358:     }
                   2359:     if (context == 'parmslog') {
                   2360:         var secondType = 'hidden';
                   2361:         if (firstType == 'text') {
                   2362:             secondType = 'checkbox';
                   2363:         }
                   2364:         secondObject = document.getElementById(secondid);  
                   2365:         if (typeof(secondObject) == 'object') {
                   2366:             if (secondObject.type != secondType) {
                   2367:                 changeInputType(secondObject,secondType);
                   2368:             }
                   2369:         }
                   2370:         var textItem = document.getElementById(thirdid);
                   2371:         var currtext = textItem.innerHTML;
                   2372:         var newtext;
                   2373:         if (firstType == 'text') {
                   2374:             newtext = '$includetext';
                   2375:         } else {
                   2376:             newtext = '&nbsp;';
                   2377:         }
                   2378:         if (currtext != newtext) {
                   2379:             textItem.innerHTML = newtext;
                   2380:         }
                   2381:     }
                   2382:     return;
                   2383: }
                   2384: 
                   2385: function changeInputType(oldObject,newType) {
                   2386:     var newObject = document.createElement('input');
                   2387:     newObject.type = newType;
                   2388:     if (oldObject.size) {
                   2389:         newObject.size = oldObject.size;
                   2390:     }
                   2391:     if (oldObject.value) {
                   2392:         newObject.value = oldObject.value;
                   2393:     }
                   2394:     if (oldObject.name) {
                   2395:         newObject.name = oldObject.name;
                   2396:     }
                   2397:     if (oldObject.id) {
                   2398:         newObject.id = oldObject.id;
                   2399:     }
                   2400:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2401:     return;
                   2402: }
                   2403: 
                   2404: ENDJS
1.475     www      2405: }
                   2406: 
1.167     www      2407: sub gradeleveldescription {
                   2408:     my $gradelevel=shift;
                   2409:     my %gradelevels=(0 => 'Not specified',
                   2410: 		     1 => 'Grade 1',
                   2411: 		     2 => 'Grade 2',
                   2412: 		     3 => 'Grade 3',
                   2413: 		     4 => 'Grade 4',
                   2414: 		     5 => 'Grade 5',
                   2415: 		     6 => 'Grade 6',
                   2416: 		     7 => 'Grade 7',
                   2417: 		     8 => 'Grade 8',
                   2418: 		     9 => 'Grade 9',
                   2419: 		     10 => 'Grade 10',
                   2420: 		     11 => 'Grade 11',
                   2421: 		     12 => 'Grade 12',
                   2422: 		     13 => 'Grade 13',
                   2423: 		     14 => '100 Level',
                   2424: 		     15 => '200 Level',
                   2425: 		     16 => '300 Level',
                   2426: 		     17 => '400 Level',
                   2427: 		     18 => 'Graduate Level');
                   2428:     return &mt($gradelevels{$gradelevel});
                   2429: }
                   2430: 
1.163     www      2431: sub select_level_form {
                   2432:     my ($deflevel,$name)=@_;
                   2433:     unless ($deflevel) { $deflevel=0; }
1.167     www      2434:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2435:     for (my $i=0; $i<=18; $i++) {
                   2436:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2437:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2438:                 ">".&gradeleveldescription($i)."</option>\n";
                   2439:     }
                   2440:     $selectform.="</select>";
                   2441:     return $selectform;
1.163     www      2442: }
1.167     www      2443: 
1.35      matthew  2444: #-------------------------------------------
                   2445: 
1.45      matthew  2446: =pod
                   2447: 
1.1121    raeburn  2448: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35      matthew  2449: 
                   2450: Returns a string containing a <select name='$name' size='1'> form to 
                   2451: allow a user to select the domain to preform an operation in.  
                   2452: See loncreateuser.pm for an example invocation and use.
                   2453: 
1.90      www      2454: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2455: selected");
                   2456: 
1.743     raeburn  2457: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2458: 
1.910     raeburn  2459: 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.
                   2460: 
1.1121    raeburn  2461: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2462: 
                   2463: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563     raeburn  2464: 
1.35      matthew  2465: =cut
                   2466: 
                   2467: #-------------------------------------------
1.34      matthew  2468: sub select_dom_form {
1.1121    raeburn  2469:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872     raeburn  2470:     if ($onchange) {
1.874     raeburn  2471:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2472:     }
1.1121    raeburn  2473:     my (@domains,%exclude);
1.910     raeburn  2474:     if (ref($incdoms) eq 'ARRAY') {
                   2475:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2476:     } else {
                   2477:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2478:     }
1.90      www      2479:     if ($includeempty) { @domains=('',@domains); }
1.1121    raeburn  2480:     if (ref($excdoms) eq 'ARRAY') {
                   2481:         map { $exclude{$_} = 1; } @{$excdoms}; 
                   2482:     }
1.743     raeburn  2483:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2484:     foreach my $dom (@domains) {
1.1121    raeburn  2485:         next if ($exclude{$dom});
1.356     albertel 2486:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2487:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2488:         if ($showdomdesc) {
                   2489:             if ($dom ne '') {
                   2490:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2491:                 if ($domdesc ne '') {
                   2492:                     $selectdomain .= ' ('.$domdesc.')';
                   2493:                 }
                   2494:             } 
                   2495:         }
                   2496:         $selectdomain .= "</option>\n";
1.34      matthew  2497:     }
                   2498:     $selectdomain.="</select>";
                   2499:     return $selectdomain;
                   2500: }
                   2501: 
1.35      matthew  2502: #-------------------------------------------
                   2503: 
1.45      matthew  2504: =pod
                   2505: 
1.648     raeburn  2506: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2507: 
1.586     raeburn  2508: input: 4 arguments (two required, two optional) - 
                   2509:     $domain - domain of new user
                   2510:     $name - name of form element
                   2511:     $default - Value of 'default' causes a default item to be first 
                   2512:                             option, and selected by default. 
                   2513:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2514:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2515: output: returns 2 items: 
1.586     raeburn  2516: (a) form element which contains either:
                   2517:    (i) <select name="$name">
                   2518:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2519:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2520:        </select>
                   2521:        form item if there are multiple library servers in $domain, or
                   2522:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2523:        if there is only one library server in $domain.
                   2524: 
                   2525: (b) number of library servers found.
                   2526: 
                   2527: See loncreateuser.pm for example of use.
1.35      matthew  2528: 
                   2529: =cut
                   2530: 
                   2531: #-------------------------------------------
1.586     raeburn  2532: sub home_server_form_item {
                   2533:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2534:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2535:     my $result;
                   2536:     my $numlib = keys(%servers);
                   2537:     if ($numlib > 1) {
                   2538:         $result .= '<select name="'.$name.'" />'."\n";
                   2539:         if ($default) {
1.804     bisitz   2540:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2541:                        '</option>'."\n";
                   2542:         }
                   2543:         foreach my $hostid (sort(keys(%servers))) {
                   2544:             $result.= '<option value="'.$hostid.'">'.
                   2545: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2546:         }
                   2547:         $result .= '</select>'."\n";
                   2548:     } elsif ($numlib == 1) {
                   2549:         my $hostid;
                   2550:         foreach my $item (keys(%servers)) {
                   2551:             $hostid = $item;
                   2552:         }
                   2553:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2554:                    $hostid.'" />';
                   2555:                    if (!$hide) {
                   2556:                        $result .= $hostid.' '.$servers{$hostid};
                   2557:                    }
                   2558:                    $result .= "\n";
                   2559:     } elsif ($default) {
                   2560:         $result .= '<input type="hidden" name="'.$name.
                   2561:                    '" value="default" />';
                   2562:                    if (!$hide) {
                   2563:                        $result .= &mt('default');
                   2564:                    }
                   2565:                    $result .= "\n";
1.33      matthew  2566:     }
1.586     raeburn  2567:     return ($result,$numlib);
1.33      matthew  2568: }
1.112     bowersj2 2569: 
                   2570: =pod
                   2571: 
1.534     albertel 2572: =back 
                   2573: 
1.112     bowersj2 2574: =cut
1.87      matthew  2575: 
                   2576: ###############################################################
1.112     bowersj2 2577: ##                  Decoding User Agent                      ##
1.87      matthew  2578: ###############################################################
                   2579: 
                   2580: =pod
                   2581: 
1.112     bowersj2 2582: =head1 Decoding the User Agent
                   2583: 
                   2584: =over 4
                   2585: 
                   2586: =item * &decode_user_agent()
1.87      matthew  2587: 
                   2588: Inputs: $r
                   2589: 
                   2590: Outputs:
                   2591: 
                   2592: =over 4
                   2593: 
1.112     bowersj2 2594: =item * $httpbrowser
1.87      matthew  2595: 
1.112     bowersj2 2596: =item * $clientbrowser
1.87      matthew  2597: 
1.112     bowersj2 2598: =item * $clientversion
1.87      matthew  2599: 
1.112     bowersj2 2600: =item * $clientmathml
1.87      matthew  2601: 
1.112     bowersj2 2602: =item * $clientunicode
1.87      matthew  2603: 
1.112     bowersj2 2604: =item * $clientos
1.87      matthew  2605: 
1.1137    raeburn  2606: =item * $clientmobile
                   2607: 
1.1141    raeburn  2608: =item * $clientinfo
                   2609: 
1.1194    raeburn  2610: =item * $clientosversion
                   2611: 
1.87      matthew  2612: =back
                   2613: 
1.157     matthew  2614: =back 
                   2615: 
1.87      matthew  2616: =cut
                   2617: 
                   2618: ###############################################################
                   2619: ###############################################################
                   2620: sub decode_user_agent {
1.247     albertel 2621:     my ($r)=@_;
1.87      matthew  2622:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2623:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2624:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2625:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2626:     my $clientbrowser='unknown';
                   2627:     my $clientversion='0';
                   2628:     my $clientmathml='';
                   2629:     my $clientunicode='0';
1.1137    raeburn  2630:     my $clientmobile=0;
1.1194    raeburn  2631:     my $clientosversion='';
1.87      matthew  2632:     for (my $i=0;$i<=$#browsertype;$i++) {
1.1193    raeburn  2633:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87      matthew  2634: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2635: 	    $clientbrowser=$bname;
                   2636:             $httpbrowser=~/$vreg/i;
                   2637: 	    $clientversion=$1;
                   2638:             $clientmathml=($clientversion>=$minv);
                   2639:             $clientunicode=($clientversion>=$univ);
                   2640: 	}
                   2641:     }
                   2642:     my $clientos='unknown';
1.1141    raeburn  2643:     my $clientinfo;
1.87      matthew  2644:     if (($httpbrowser=~/linux/i) ||
                   2645:         ($httpbrowser=~/unix/i) ||
                   2646:         ($httpbrowser=~/ux/i) ||
                   2647:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2648:     if (($httpbrowser=~/vax/i) ||
                   2649:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2650:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2651:     if (($httpbrowser=~/mac/i) ||
                   2652:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194    raeburn  2653:     if ($httpbrowser=~/win/i) {
                   2654:         $clientos='win';
                   2655:         if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
                   2656:             $clientosversion = $1;
                   2657:         }
                   2658:     }
1.87      matthew  2659:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137    raeburn  2660:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2661:         $clientmobile=lc($1);
                   2662:     }
1.1141    raeburn  2663:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2664:         $clientinfo = 'firefox-'.$1;
                   2665:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2666:         $clientinfo = 'chromeframe-'.$1;
                   2667:     }
1.87      matthew  2668:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194    raeburn  2669:             $clientunicode,$clientos,$clientmobile,$clientinfo,
                   2670:             $clientosversion);
1.87      matthew  2671: }
                   2672: 
1.32      matthew  2673: ###############################################################
                   2674: ##    Authentication changing form generation subroutines    ##
                   2675: ###############################################################
                   2676: ##
                   2677: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2678: ## hash, and have reasonable default values.
                   2679: ##
                   2680: ##    formname = the name given in the <form> tag.
1.35      matthew  2681: #-------------------------------------------
                   2682: 
1.45      matthew  2683: =pod
                   2684: 
1.112     bowersj2 2685: =head1 Authentication Routines
                   2686: 
                   2687: =over 4
                   2688: 
1.648     raeburn  2689: =item * &authform_xxxxxx()
1.35      matthew  2690: 
                   2691: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2692: handle some of the conveniences required for authentication forms.  
                   2693: This is not an optimal method, but it works.  
                   2694: 
                   2695: =over 4
                   2696: 
1.112     bowersj2 2697: =item * authform_header
1.35      matthew  2698: 
1.112     bowersj2 2699: =item * authform_authorwarning
1.35      matthew  2700: 
1.112     bowersj2 2701: =item * authform_nochange
1.35      matthew  2702: 
1.112     bowersj2 2703: =item * authform_kerberos
1.35      matthew  2704: 
1.112     bowersj2 2705: =item * authform_internal
1.35      matthew  2706: 
1.112     bowersj2 2707: =item * authform_filesystem
1.35      matthew  2708: 
                   2709: =back
                   2710: 
1.648     raeburn  2711: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2712: 
1.35      matthew  2713: =cut
                   2714: 
                   2715: #-------------------------------------------
1.32      matthew  2716: sub authform_header{  
                   2717:     my %in = (
                   2718:         formname => 'cu',
1.80      albertel 2719:         kerb_def_dom => '',
1.32      matthew  2720:         @_,
                   2721:     );
                   2722:     $in{'formname'} = 'document.' . $in{'formname'};
                   2723:     my $result='';
1.80      albertel 2724: 
                   2725: #---------------------------------------------- Code for upper case translation
                   2726:     my $Javascript_toUpperCase;
                   2727:     unless ($in{kerb_def_dom}) {
                   2728:         $Javascript_toUpperCase =<<"END";
                   2729:         switch (choice) {
                   2730:            case 'krb': currentform.elements[choicearg].value =
                   2731:                currentform.elements[choicearg].value.toUpperCase();
                   2732:                break;
                   2733:            default:
                   2734:         }
                   2735: END
                   2736:     } else {
                   2737:         $Javascript_toUpperCase = "";
                   2738:     }
                   2739: 
1.165     raeburn  2740:     my $radioval = "'nochange'";
1.591     raeburn  2741:     if (defined($in{'curr_authtype'})) {
                   2742:         if ($in{'curr_authtype'} ne '') {
                   2743:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2744:         }
1.174     matthew  2745:     }
1.165     raeburn  2746:     my $argfield = 'null';
1.591     raeburn  2747:     if (defined($in{'mode'})) {
1.165     raeburn  2748:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2749:             if (defined($in{'curr_autharg'})) {
                   2750:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2751:                     $argfield = "'$in{'curr_autharg'}'";
                   2752:                 }
                   2753:             }
                   2754:         }
                   2755:     }
                   2756: 
1.32      matthew  2757:     $result.=<<"END";
                   2758: var current = new Object();
1.165     raeburn  2759: current.radiovalue = $radioval;
                   2760: current.argfield = $argfield;
1.32      matthew  2761: 
                   2762: function changed_radio(choice,currentform) {
                   2763:     var choicearg = choice + 'arg';
                   2764:     // If a radio button in changed, we need to change the argfield
                   2765:     if (current.radiovalue != choice) {
                   2766:         current.radiovalue = choice;
                   2767:         if (current.argfield != null) {
                   2768:             currentform.elements[current.argfield].value = '';
                   2769:         }
                   2770:         if (choice == 'nochange') {
                   2771:             current.argfield = null;
                   2772:         } else {
                   2773:             current.argfield = choicearg;
                   2774:             switch(choice) {
                   2775:                 case 'krb': 
                   2776:                     currentform.elements[current.argfield].value = 
                   2777:                         "$in{'kerb_def_dom'}";
                   2778:                 break;
                   2779:               default:
                   2780:                 break;
                   2781:             }
                   2782:         }
                   2783:     }
                   2784:     return;
                   2785: }
1.22      www      2786: 
1.32      matthew  2787: function changed_text(choice,currentform) {
                   2788:     var choicearg = choice + 'arg';
                   2789:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2790:         $Javascript_toUpperCase
1.32      matthew  2791:         // clear old field
                   2792:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2793:             currentform.elements[current.argfield].value = '';
                   2794:         }
                   2795:         current.argfield = choicearg;
                   2796:     }
                   2797:     set_auth_radio_buttons(choice,currentform);
                   2798:     return;
1.20      www      2799: }
1.32      matthew  2800: 
                   2801: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2802:     var numauthchoices = currentform.login.length;
                   2803:     if (typeof numauthchoices  == "undefined") {
                   2804:         return;
                   2805:     } 
1.32      matthew  2806:     var i=0;
1.986     raeburn  2807:     while (i < numauthchoices) {
1.32      matthew  2808:         if (currentform.login[i].value == newvalue) { break; }
                   2809:         i++;
                   2810:     }
1.986     raeburn  2811:     if (i == numauthchoices) {
1.32      matthew  2812:         return;
                   2813:     }
                   2814:     current.radiovalue = newvalue;
                   2815:     currentform.login[i].checked = true;
                   2816:     return;
                   2817: }
                   2818: END
                   2819:     return $result;
                   2820: }
                   2821: 
1.1106    raeburn  2822: sub authform_authorwarning {
1.32      matthew  2823:     my $result='';
1.144     matthew  2824:     $result='<i>'.
                   2825:         &mt('As a general rule, only authors or co-authors should be '.
                   2826:             'filesystem authenticated '.
                   2827:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2828:     return $result;
                   2829: }
                   2830: 
1.1106    raeburn  2831: sub authform_nochange {
1.32      matthew  2832:     my %in = (
                   2833:               formname => 'document.cu',
                   2834:               kerb_def_dom => 'MSU.EDU',
                   2835:               @_,
                   2836:           );
1.1106    raeburn  2837:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586     raeburn  2838:     my $result;
1.1104    raeburn  2839:     if (!$authnum) {
1.1105    raeburn  2840:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2841:     } else {
                   2842:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2843:                   '<input type="radio" name="login" value="nochange" '.
                   2844:                   'checked="checked" onclick="'.
1.281     albertel 2845:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2846: 	    '</label>';
1.586     raeburn  2847:     }
1.32      matthew  2848:     return $result;
                   2849: }
                   2850: 
1.591     raeburn  2851: sub authform_kerberos {
1.32      matthew  2852:     my %in = (
                   2853:               formname => 'document.cu',
                   2854:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2855:               kerb_def_auth => 'krb4',
1.32      matthew  2856:               @_,
                   2857:               );
1.586     raeburn  2858:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2859:         $autharg,$jscall);
1.1106    raeburn  2860:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2861:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2862:        $check5 = ' checked="checked"';
1.80      albertel 2863:     } else {
1.772     bisitz   2864:        $check4 = ' checked="checked"';
1.80      albertel 2865:     }
1.165     raeburn  2866:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2867:     if (defined($in{'curr_authtype'})) {
                   2868:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2869:             $krbcheck = ' checked="checked"';
1.623     raeburn  2870:             if (defined($in{'mode'})) {
                   2871:                 if ($in{'mode'} eq 'modifyuser') {
                   2872:                     $krbcheck = '';
                   2873:                 }
                   2874:             }
1.591     raeburn  2875:             if (defined($in{'curr_kerb_ver'})) {
                   2876:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2877:                     $check5 = ' checked="checked"';
1.591     raeburn  2878:                     $check4 = '';
                   2879:                 } else {
1.772     bisitz   2880:                     $check4 = ' checked="checked"';
1.591     raeburn  2881:                     $check5 = '';
                   2882:                 }
1.586     raeburn  2883:             }
1.591     raeburn  2884:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2885:                 $krbarg = $in{'curr_autharg'};
                   2886:             }
1.586     raeburn  2887:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2888:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2889:                     $result = 
                   2890:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2891:         $in{'curr_autharg'},$krbver);
                   2892:                 } else {
                   2893:                     $result =
                   2894:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2895:                 }
                   2896:                 return $result; 
                   2897:             }
                   2898:         }
                   2899:     } else {
                   2900:         if ($authnum == 1) {
1.784     bisitz   2901:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2902:         }
                   2903:     }
1.586     raeburn  2904:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2905:         return;
1.587     raeburn  2906:     } elsif ($authtype eq '') {
1.591     raeburn  2907:         if (defined($in{'mode'})) {
1.587     raeburn  2908:             if ($in{'mode'} eq 'modifycourse') {
                   2909:                 if ($authnum == 1) {
1.1104    raeburn  2910:                     $authtype = '<input type="radio" name="login" value="krb" />';
1.587     raeburn  2911:                 }
                   2912:             }
                   2913:         }
1.586     raeburn  2914:     }
                   2915:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2916:     if ($authtype eq '') {
                   2917:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2918:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2919:                     $krbcheck.' />';
                   2920:     }
                   2921:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106    raeburn  2922:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2923:          $in{'curr_authtype'} eq 'krb5') ||
1.1106    raeburn  2924:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2925:          $in{'curr_authtype'} eq 'krb4')) {
                   2926:         $result .= &mt
1.144     matthew  2927:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2928:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2929:          '<label>'.$authtype,
1.281     albertel 2930:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2931:              'value="'.$krbarg.'" '.
1.144     matthew  2932:              'onchange="'.$jscall.'" />',
1.281     albertel 2933:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2934:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2935: 	 '</label>');
1.586     raeburn  2936:     } elsif ($can_assign{'krb4'}) {
                   2937:         $result .= &mt
                   2938:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2939:          '[_3] Version 4 [_4]',
                   2940:          '<label>'.$authtype,
                   2941:          '</label><input type="text" size="10" name="krbarg" '.
                   2942:              'value="'.$krbarg.'" '.
                   2943:              'onchange="'.$jscall.'" />',
                   2944:          '<label><input type="hidden" name="krbver" value="4" />',
                   2945:          '</label>');
                   2946:     } elsif ($can_assign{'krb5'}) {
                   2947:         $result .= &mt
                   2948:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2949:          '[_3] Version 5 [_4]',
                   2950:          '<label>'.$authtype,
                   2951:          '</label><input type="text" size="10" name="krbarg" '.
                   2952:              'value="'.$krbarg.'" '.
                   2953:              'onchange="'.$jscall.'" />',
                   2954:          '<label><input type="hidden" name="krbver" value="5" />',
                   2955:          '</label>');
                   2956:     }
1.32      matthew  2957:     return $result;
                   2958: }
                   2959: 
1.1106    raeburn  2960: sub authform_internal {
1.586     raeburn  2961:     my %in = (
1.32      matthew  2962:                 formname => 'document.cu',
                   2963:                 kerb_def_dom => 'MSU.EDU',
                   2964:                 @_,
                   2965:                 );
1.586     raeburn  2966:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  2967:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2968:     if (defined($in{'curr_authtype'})) {
                   2969:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2970:             if ($can_assign{'int'}) {
1.772     bisitz   2971:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2972:                 if (defined($in{'mode'})) {
                   2973:                     if ($in{'mode'} eq 'modifyuser') {
                   2974:                         $intcheck = '';
                   2975:                     }
                   2976:                 }
1.591     raeburn  2977:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2978:                     $intarg = $in{'curr_autharg'};
                   2979:                 }
                   2980:             } else {
                   2981:                 $result = &mt('Currently internally authenticated.');
                   2982:                 return $result;
1.165     raeburn  2983:             }
                   2984:         }
1.586     raeburn  2985:     } else {
                   2986:         if ($authnum == 1) {
1.784     bisitz   2987:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2988:         }
                   2989:     }
                   2990:     if (!$can_assign{'int'}) {
                   2991:         return;
1.587     raeburn  2992:     } elsif ($authtype eq '') {
1.591     raeburn  2993:         if (defined($in{'mode'})) {
1.587     raeburn  2994:             if ($in{'mode'} eq 'modifycourse') {
                   2995:                 if ($authnum == 1) {
1.1104    raeburn  2996:                     $authtype = '<input type="radio" name="login" value="int" />';
1.587     raeburn  2997:                 }
                   2998:             }
                   2999:         }
1.165     raeburn  3000:     }
1.586     raeburn  3001:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   3002:     if ($authtype eq '') {
                   3003:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   3004:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   3005:     }
1.605     bisitz   3006:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  3007:                $intarg.'" onchange="'.$jscall.'" />';
                   3008:     $result = &mt
1.144     matthew  3009:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  3010:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   3011:     $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  3012:     return $result;
                   3013: }
                   3014: 
1.1104    raeburn  3015: sub authform_local {
1.32      matthew  3016:     my %in = (
                   3017:               formname => 'document.cu',
                   3018:               kerb_def_dom => 'MSU.EDU',
                   3019:               @_,
                   3020:               );
1.586     raeburn  3021:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  3022:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  3023:     if (defined($in{'curr_authtype'})) {
                   3024:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  3025:             if ($can_assign{'loc'}) {
1.772     bisitz   3026:                 $loccheck = 'checked="checked" ';
1.623     raeburn  3027:                 if (defined($in{'mode'})) {
                   3028:                     if ($in{'mode'} eq 'modifyuser') {
                   3029:                         $loccheck = '';
                   3030:                     }
                   3031:                 }
1.591     raeburn  3032:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3033:                     $locarg = $in{'curr_autharg'};
                   3034:                 }
                   3035:             } else {
                   3036:                 $result = &mt('Currently using local (institutional) authentication.');
                   3037:                 return $result;
1.165     raeburn  3038:             }
                   3039:         }
1.586     raeburn  3040:     } else {
                   3041:         if ($authnum == 1) {
1.784     bisitz   3042:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  3043:         }
                   3044:     }
                   3045:     if (!$can_assign{'loc'}) {
                   3046:         return;
1.587     raeburn  3047:     } elsif ($authtype eq '') {
1.591     raeburn  3048:         if (defined($in{'mode'})) {
1.587     raeburn  3049:             if ($in{'mode'} eq 'modifycourse') {
                   3050:                 if ($authnum == 1) {
1.1104    raeburn  3051:                     $authtype = '<input type="radio" name="login" value="loc" />';
1.587     raeburn  3052:                 }
                   3053:             }
                   3054:         }
1.165     raeburn  3055:     }
1.586     raeburn  3056:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   3057:     if ($authtype eq '') {
                   3058:         $authtype = '<input type="radio" name="login" value="loc" '.
                   3059:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   3060:                     $jscall.'" />';
                   3061:     }
                   3062:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   3063:                $locarg.'" onchange="'.$jscall.'" />';
                   3064:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   3065:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  3066:     return $result;
                   3067: }
                   3068: 
1.1106    raeburn  3069: sub authform_filesystem {
1.32      matthew  3070:     my %in = (
                   3071:               formname => 'document.cu',
                   3072:               kerb_def_dom => 'MSU.EDU',
                   3073:               @_,
                   3074:               );
1.586     raeburn  3075:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  3076:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  3077:     if (defined($in{'curr_authtype'})) {
                   3078:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  3079:             if ($can_assign{'fsys'}) {
1.772     bisitz   3080:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  3081:                 if (defined($in{'mode'})) {
                   3082:                     if ($in{'mode'} eq 'modifyuser') {
                   3083:                         $fsyscheck = '';
                   3084:                     }
                   3085:                 }
1.586     raeburn  3086:             } else {
                   3087:                 $result = &mt('Currently Filesystem Authenticated.');
                   3088:                 return $result;
                   3089:             }           
                   3090:         }
                   3091:     } else {
                   3092:         if ($authnum == 1) {
1.784     bisitz   3093:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  3094:         }
                   3095:     }
                   3096:     if (!$can_assign{'fsys'}) {
                   3097:         return;
1.587     raeburn  3098:     } elsif ($authtype eq '') {
1.591     raeburn  3099:         if (defined($in{'mode'})) {
1.587     raeburn  3100:             if ($in{'mode'} eq 'modifycourse') {
                   3101:                 if ($authnum == 1) {
1.1104    raeburn  3102:                     $authtype = '<input type="radio" name="login" value="fsys" />';
1.587     raeburn  3103:                 }
                   3104:             }
                   3105:         }
1.586     raeburn  3106:     }
                   3107:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   3108:     if ($authtype eq '') {
                   3109:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   3110:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   3111:                     $jscall.'" />';
                   3112:     }
                   3113:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   3114:                ' onchange="'.$jscall.'" />';
                   3115:     $result = &mt
1.144     matthew  3116:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 3117:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  3118:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   3119:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  3120:                   'onchange="'.$jscall.'" />');
1.32      matthew  3121:     return $result;
                   3122: }
                   3123: 
1.586     raeburn  3124: sub get_assignable_auth {
                   3125:     my ($dom) = @_;
                   3126:     if ($dom eq '') {
                   3127:         $dom = $env{'request.role.domain'};
                   3128:     }
                   3129:     my %can_assign = (
                   3130:                           krb4 => 1,
                   3131:                           krb5 => 1,
                   3132:                           int  => 1,
                   3133:                           loc  => 1,
                   3134:                      );
                   3135:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   3136:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   3137:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   3138:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   3139:             my $context;
                   3140:             if ($env{'request.role'} =~ /^au/) {
                   3141:                 $context = 'author';
                   3142:             } elsif ($env{'request.role'} =~ /^dc/) {
                   3143:                 $context = 'domain';
                   3144:             } elsif ($env{'request.course.id'}) {
                   3145:                 $context = 'course';
                   3146:             }
                   3147:             if ($context) {
                   3148:                 if (ref($authhash->{$context}) eq 'HASH') {
                   3149:                    %can_assign = %{$authhash->{$context}}; 
                   3150:                 }
                   3151:             }
                   3152:         }
                   3153:     }
                   3154:     my $authnum = 0;
                   3155:     foreach my $key (keys(%can_assign)) {
                   3156:         if ($can_assign{$key}) {
                   3157:             $authnum ++;
                   3158:         }
                   3159:     }
                   3160:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   3161:         $authnum --;
                   3162:     }
                   3163:     return ($authnum,%can_assign);
                   3164: }
                   3165: 
1.80      albertel 3166: ###############################################################
                   3167: ##    Get Kerberos Defaults for Domain                 ##
                   3168: ###############################################################
                   3169: ##
                   3170: ## Returns default kerberos version and an associated argument
                   3171: ## as listed in file domain.tab. If not listed, provides
                   3172: ## appropriate default domain and kerberos version.
                   3173: ##
                   3174: #-------------------------------------------
                   3175: 
                   3176: =pod
                   3177: 
1.648     raeburn  3178: =item * &get_kerberos_defaults()
1.80      albertel 3179: 
                   3180: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  3181: version and domain. If not found, it defaults to version 4 and the 
                   3182: domain of the server.
1.80      albertel 3183: 
1.648     raeburn  3184: =over 4
                   3185: 
1.80      albertel 3186: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   3187: 
1.648     raeburn  3188: =back
                   3189: 
                   3190: =back
                   3191: 
1.80      albertel 3192: =cut
                   3193: 
                   3194: #-------------------------------------------
                   3195: sub get_kerberos_defaults {
                   3196:     my $domain=shift;
1.641     raeburn  3197:     my ($krbdef,$krbdefdom);
                   3198:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   3199:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   3200:         $krbdef = $domdefaults{'auth_def'};
                   3201:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   3202:     } else {
1.80      albertel 3203:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   3204:         my $krbdefdom=$1;
                   3205:         $krbdefdom=~tr/a-z/A-Z/;
                   3206:         $krbdef = "krb4";
                   3207:     }
                   3208:     return ($krbdef,$krbdefdom);
                   3209: }
1.112     bowersj2 3210: 
1.32      matthew  3211: 
1.46      matthew  3212: ###############################################################
                   3213: ##                Thesaurus Functions                        ##
                   3214: ###############################################################
1.20      www      3215: 
1.46      matthew  3216: =pod
1.20      www      3217: 
1.112     bowersj2 3218: =head1 Thesaurus Functions
                   3219: 
                   3220: =over 4
                   3221: 
1.648     raeburn  3222: =item * &initialize_keywords()
1.46      matthew  3223: 
                   3224: Initializes the package variable %Keywords if it is empty.  Uses the
                   3225: package variable $thesaurus_db_file.
                   3226: 
                   3227: =cut
                   3228: 
                   3229: ###################################################
                   3230: 
                   3231: sub initialize_keywords {
                   3232:     return 1 if (scalar keys(%Keywords));
                   3233:     # If we are here, %Keywords is empty, so fill it up
                   3234:     #   Make sure the file we need exists...
                   3235:     if (! -e $thesaurus_db_file) {
                   3236:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   3237:                                  " failed because it does not exist");
                   3238:         return 0;
                   3239:     }
                   3240:     #   Set up the hash as a database
                   3241:     my %thesaurus_db;
                   3242:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3243:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3244:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   3245:                                  $thesaurus_db_file);
                   3246:         return 0;
                   3247:     } 
                   3248:     #  Get the average number of appearances of a word.
                   3249:     my $avecount = $thesaurus_db{'average.count'};
                   3250:     #  Put keywords (those that appear > average) into %Keywords
                   3251:     while (my ($word,$data)=each (%thesaurus_db)) {
                   3252:         my ($count,undef) = split /:/,$data;
                   3253:         $Keywords{$word}++ if ($count > $avecount);
                   3254:     }
                   3255:     untie %thesaurus_db;
                   3256:     # Remove special values from %Keywords.
1.356     albertel 3257:     foreach my $value ('total.count','average.count') {
                   3258:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  3259:   }
1.46      matthew  3260:     return 1;
                   3261: }
                   3262: 
                   3263: ###################################################
                   3264: 
                   3265: =pod
                   3266: 
1.648     raeburn  3267: =item * &keyword($word)
1.46      matthew  3268: 
                   3269: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   3270: than the average number of times in the thesaurus database.  Calls 
                   3271: &initialize_keywords
                   3272: 
                   3273: =cut
                   3274: 
                   3275: ###################################################
1.20      www      3276: 
                   3277: sub keyword {
1.46      matthew  3278:     return if (!&initialize_keywords());
                   3279:     my $word=lc(shift());
                   3280:     $word=~s/\W//g;
                   3281:     return exists($Keywords{$word});
1.20      www      3282: }
1.46      matthew  3283: 
                   3284: ###############################################################
                   3285: 
                   3286: =pod 
1.20      www      3287: 
1.648     raeburn  3288: =item * &get_related_words()
1.46      matthew  3289: 
1.160     matthew  3290: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  3291: an array of words.  If the keyword is not in the thesaurus, an empty array
                   3292: will be returned.  The order of the words returned is determined by the
                   3293: database which holds them.
                   3294: 
                   3295: Uses global $thesaurus_db_file.
                   3296: 
1.1057    foxr     3297: 
1.46      matthew  3298: =cut
                   3299: 
                   3300: ###############################################################
                   3301: sub get_related_words {
                   3302:     my $keyword = shift;
                   3303:     my %thesaurus_db;
                   3304:     if (! -e $thesaurus_db_file) {
                   3305:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3306:                                  "failed because the file does not exist");
                   3307:         return ();
                   3308:     }
                   3309:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3310:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3311:         return ();
                   3312:     } 
                   3313:     my @Words=();
1.429     www      3314:     my $count=0;
1.46      matthew  3315:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3316: 	# The first element is the number of times
                   3317: 	# the word appears.  We do not need it now.
1.429     www      3318: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3319: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3320: 	my $threshold=$mostfrequentcount/10;
                   3321:         foreach my $possibleword (@RelatedWords) {
                   3322:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3323:             if ($wordcount>$threshold) {
                   3324: 		push(@Words,$word);
                   3325:                 $count++;
                   3326:                 if ($count>10) { last; }
                   3327: 	    }
1.20      www      3328:         }
                   3329:     }
1.46      matthew  3330:     untie %thesaurus_db;
                   3331:     return @Words;
1.14      harris41 3332: }
1.1090    foxr     3333: ###############################################################
                   3334: #
                   3335: #  Spell checking
                   3336: #
                   3337: 
                   3338: =pod
                   3339: 
1.1142    raeburn  3340: =back
                   3341: 
1.1090    foxr     3342: =head1 Spell checking
                   3343: 
                   3344: =over 4
                   3345: 
                   3346: =item * &check_spelling($wordlist $language)
                   3347: 
                   3348: Takes a string containing words and feeds it to an external
                   3349: spellcheck program via a pipeline. Returns a string containing
                   3350: them mis-spelled words.
                   3351: 
                   3352: Parameters:
                   3353: 
                   3354: =over 4
                   3355: 
                   3356: =item - $wordlist
                   3357: 
                   3358: String that will be fed into the spellcheck program.
                   3359: 
                   3360: =item - $language
                   3361: 
                   3362: Language string that specifies the language for which the spell
                   3363: check will be performed.
                   3364: 
                   3365: =back
                   3366: 
                   3367: =back
                   3368: 
                   3369: Note: This sub assumes that aspell is installed.
                   3370: 
                   3371: 
                   3372: =cut
                   3373: 
1.46      matthew  3374: 
1.1090    foxr     3375: sub check_spelling {
                   3376:     my ($wordlist, $language) = @_;
1.1091    foxr     3377:     my @misspellings;
                   3378:     
                   3379:     # Generate the speller and set the langauge.
                   3380:     # if explicitly selected:
1.1090    foxr     3381: 
1.1091    foxr     3382:     my $speller = Text::Aspell->new;
1.1090    foxr     3383:     if ($language) {
1.1091    foxr     3384: 	$speller->set_option('lang', $language);
1.1090    foxr     3385:     }
                   3386: 
1.1091    foxr     3387:     # Turn the word list into an array of words by splittingon whitespace
1.1090    foxr     3388: 
1.1091    foxr     3389:     my @words = split(/\s+/, $wordlist);
1.1090    foxr     3390: 
1.1091    foxr     3391:     foreach my $word (@words) {
                   3392: 	if(! $speller->check($word)) {
                   3393: 	    push(@misspellings, $word);
1.1090    foxr     3394: 	}
                   3395:     }
1.1091    foxr     3396:     return join(' ', @misspellings);
                   3397:     
1.1090    foxr     3398: }
                   3399: 
1.61      www      3400: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3401: =pod
                   3402: 
1.112     bowersj2 3403: =head1 User Name Functions
                   3404: 
                   3405: =over 4
                   3406: 
1.648     raeburn  3407: =item * &plainname($uname,$udom,$first)
1.81      albertel 3408: 
1.112     bowersj2 3409: Takes a users logon name and returns it as a string in
1.226     albertel 3410: "first middle last generation" form 
                   3411: if $first is set to 'lastname' then it returns it as
                   3412: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3413: 
                   3414: =cut
1.61      www      3415: 
1.295     www      3416: 
1.81      albertel 3417: ###############################################################
1.61      www      3418: sub plainname {
1.226     albertel 3419:     my ($uname,$udom,$first)=@_;
1.537     albertel 3420:     return if (!defined($uname) || !defined($udom));
1.295     www      3421:     my %names=&getnames($uname,$udom);
1.226     albertel 3422:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3423: 					  $names{'middlename'},
                   3424: 					  $names{'lastname'},
                   3425: 					  $names{'generation'},$first);
                   3426:     $name=~s/^\s+//;
1.62      www      3427:     $name=~s/\s+$//;
                   3428:     $name=~s/\s+/ /g;
1.353     albertel 3429:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3430:     return $name;
1.61      www      3431: }
1.66      www      3432: 
                   3433: # -------------------------------------------------------------------- Nickname
1.81      albertel 3434: =pod
                   3435: 
1.648     raeburn  3436: =item * &nickname($uname,$udom)
1.81      albertel 3437: 
                   3438: Gets a users name and returns it as a string as
                   3439: 
                   3440: "&quot;nickname&quot;"
1.66      www      3441: 
1.81      albertel 3442: if the user has a nickname or
                   3443: 
                   3444: "first middle last generation"
                   3445: 
                   3446: if the user does not
                   3447: 
                   3448: =cut
1.66      www      3449: 
                   3450: sub nickname {
                   3451:     my ($uname,$udom)=@_;
1.537     albertel 3452:     return if (!defined($uname) || !defined($udom));
1.295     www      3453:     my %names=&getnames($uname,$udom);
1.68      albertel 3454:     my $name=$names{'nickname'};
1.66      www      3455:     if ($name) {
                   3456:        $name='&quot;'.$name.'&quot;'; 
                   3457:     } else {
                   3458:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3459: 	     $names{'lastname'}.' '.$names{'generation'};
                   3460:        $name=~s/\s+$//;
                   3461:        $name=~s/\s+/ /g;
                   3462:     }
                   3463:     return $name;
                   3464: }
                   3465: 
1.295     www      3466: sub getnames {
                   3467:     my ($uname,$udom)=@_;
1.537     albertel 3468:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3469:     if ($udom eq 'public' && $uname eq 'public') {
                   3470: 	return ('lastname' => &mt('Public'));
                   3471:     }
1.295     www      3472:     my $id=$uname.':'.$udom;
                   3473:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3474:     if ($cached) {
                   3475: 	return %{$names};
                   3476:     } else {
                   3477: 	my %loadnames=&Apache::lonnet::get('environment',
                   3478:                     ['firstname','middlename','lastname','generation','nickname'],
                   3479: 					 $udom,$uname);
                   3480: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3481: 	return %loadnames;
                   3482:     }
                   3483: }
1.61      www      3484: 
1.542     raeburn  3485: # -------------------------------------------------------------------- getemails
1.648     raeburn  3486: 
1.542     raeburn  3487: =pod
                   3488: 
1.648     raeburn  3489: =item * &getemails($uname,$udom)
1.542     raeburn  3490: 
                   3491: Gets a user's email information and returns it as a hash with keys:
                   3492: notification, critnotification, permanentemail
                   3493: 
                   3494: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3495: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3496:  
1.648     raeburn  3497: 
1.542     raeburn  3498: =cut
                   3499: 
1.648     raeburn  3500: 
1.466     albertel 3501: sub getemails {
                   3502:     my ($uname,$udom)=@_;
                   3503:     if ($udom eq 'public' && $uname eq 'public') {
                   3504: 	return;
                   3505:     }
1.467     www      3506:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3507:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3508:     my $id=$uname.':'.$udom;
                   3509:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3510:     if ($cached) {
                   3511: 	return %{$names};
                   3512:     } else {
                   3513: 	my %loadnames=&Apache::lonnet::get('environment',
                   3514:                     			   ['notification','critnotification',
                   3515: 					    'permanentemail'],
                   3516: 					   $udom,$uname);
                   3517: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3518: 	return %loadnames;
                   3519:     }
                   3520: }
                   3521: 
1.551     albertel 3522: sub flush_email_cache {
                   3523:     my ($uname,$udom)=@_;
                   3524:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3525:     if (!$uname) { $uname=$env{'user.name'};   }
                   3526:     return if ($udom eq 'public' && $uname eq 'public');
                   3527:     my $id=$uname.':'.$udom;
                   3528:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3529: }
                   3530: 
1.728     raeburn  3531: # -------------------------------------------------------------------- getlangs
                   3532: 
                   3533: =pod
                   3534: 
                   3535: =item * &getlangs($uname,$udom)
                   3536: 
                   3537: Gets a user's language preference and returns it as a hash with key:
                   3538: language.
                   3539: 
                   3540: =cut
                   3541: 
                   3542: 
                   3543: sub getlangs {
                   3544:     my ($uname,$udom) = @_;
                   3545:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3546:     if (!$uname) { $uname=$env{'user.name'};   }
                   3547:     my $id=$uname.':'.$udom;
                   3548:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3549:     if ($cached) {
                   3550:         return %{$langs};
                   3551:     } else {
                   3552:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3553:                                            $udom,$uname);
                   3554:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3555:         return %loadlangs;
                   3556:     }
                   3557: }
                   3558: 
                   3559: sub flush_langs_cache {
                   3560:     my ($uname,$udom)=@_;
                   3561:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3562:     if (!$uname) { $uname=$env{'user.name'};   }
                   3563:     return if ($udom eq 'public' && $uname eq 'public');
                   3564:     my $id=$uname.':'.$udom;
                   3565:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3566: }
                   3567: 
1.61      www      3568: # ------------------------------------------------------------------ Screenname
1.81      albertel 3569: 
                   3570: =pod
                   3571: 
1.648     raeburn  3572: =item * &screenname($uname,$udom)
1.81      albertel 3573: 
                   3574: Gets a users screenname and returns it as a string
                   3575: 
                   3576: =cut
1.61      www      3577: 
                   3578: sub screenname {
                   3579:     my ($uname,$udom)=@_;
1.258     albertel 3580:     if ($uname eq $env{'user.name'} &&
                   3581: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3582:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3583:     return $names{'screenname'};
1.62      www      3584: }
                   3585: 
1.212     albertel 3586: 
1.802     bisitz   3587: # ------------------------------------------------------------- Confirm Wrapper
                   3588: =pod
                   3589: 
1.1142    raeburn  3590: =item * &confirmwrapper($message)
1.802     bisitz   3591: 
                   3592: Wrap messages about completion of operation in box
                   3593: 
                   3594: =cut
                   3595: 
                   3596: sub confirmwrapper {
                   3597:     my ($message)=@_;
                   3598:     if ($message) {
                   3599:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3600:                .$message."\n"
                   3601:                .'</div>'."\n";
                   3602:     } else {
                   3603:         return $message;
                   3604:     }
                   3605: }
                   3606: 
1.62      www      3607: # ------------------------------------------------------------- Message Wrapper
                   3608: 
                   3609: sub messagewrapper {
1.369     www      3610:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3611:     return 
1.441     albertel 3612:         '<a href="/adm/email?compose=individual&amp;'.
                   3613:         'recname='.$username.'&amp;recdom='.$domain.
                   3614: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3615:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3616: }
1.802     bisitz   3617: 
1.74      www      3618: # --------------------------------------------------------------- Notes Wrapper
                   3619: 
                   3620: sub noteswrapper {
                   3621:     my ($link,$un,$do)=@_;
                   3622:     return 
1.896     amueller 3623: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3624: }
1.802     bisitz   3625: 
1.62      www      3626: # ------------------------------------------------------------- Aboutme Wrapper
                   3627: 
                   3628: sub aboutmewrapper {
1.1070    raeburn  3629:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3630:     if (!defined($username)  && !defined($domain)) {
                   3631:         return;
                   3632:     }
1.1096    raeburn  3633:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3634: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3635: }
                   3636: 
                   3637: # ------------------------------------------------------------ Syllabus Wrapper
                   3638: 
                   3639: sub syllabuswrapper {
1.707     bisitz   3640:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3641:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3642: }
1.14      harris41 3643: 
1.802     bisitz   3644: # -----------------------------------------------------------------------------
                   3645: 
1.208     matthew  3646: sub track_student_link {
1.887     raeburn  3647:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3648:     my $link ="/adm/trackstudent?";
1.208     matthew  3649:     my $title = 'View recent activity';
                   3650:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3651:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3652:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3653:         $title .= ' of this student';
1.268     albertel 3654:     } 
1.208     matthew  3655:     if (defined($target) && $target !~ /^\s*$/) {
                   3656:         $target = qq{target="$target"};
                   3657:     } else {
                   3658:         $target = '';
                   3659:     }
1.268     albertel 3660:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3661:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3662:     $title = &mt($title);
                   3663:     $linktext = &mt($linktext);
1.448     albertel 3664:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3665: 	&help_open_topic('View_recent_activity');
1.208     matthew  3666: }
                   3667: 
1.781     raeburn  3668: sub slot_reservations_link {
                   3669:     my ($linktext,$sname,$sdom,$target) = @_;
                   3670:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3671:     my $title = 'View slot reservation history';
                   3672:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3673:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3674:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3675:         $title .= ' of this student';
                   3676:     }
                   3677:     if (defined($target) && $target !~ /^\s*$/) {
                   3678:         $target = qq{target="$target"};
                   3679:     } else {
                   3680:         $target = '';
                   3681:     }
                   3682:     $title = &mt($title);
                   3683:     $linktext = &mt($linktext);
                   3684:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3685: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3686: 
                   3687: }
                   3688: 
1.508     www      3689: # ===================================================== Display a student photo
                   3690: 
                   3691: 
1.509     albertel 3692: sub student_image_tag {
1.508     www      3693:     my ($domain,$user)=@_;
                   3694:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3695:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3696: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3697:     } else {
                   3698: 	return '';
                   3699:     }
                   3700: }
                   3701: 
1.112     bowersj2 3702: =pod
                   3703: 
                   3704: =back
                   3705: 
                   3706: =head1 Access .tab File Data
                   3707: 
                   3708: =over 4
                   3709: 
1.648     raeburn  3710: =item * &languageids() 
1.112     bowersj2 3711: 
                   3712: returns list of all language ids
                   3713: 
                   3714: =cut
                   3715: 
1.14      harris41 3716: sub languageids {
1.16      harris41 3717:     return sort(keys(%language));
1.14      harris41 3718: }
                   3719: 
1.112     bowersj2 3720: =pod
                   3721: 
1.648     raeburn  3722: =item * &languagedescription() 
1.112     bowersj2 3723: 
                   3724: returns description of a specified language id
                   3725: 
                   3726: =cut
                   3727: 
1.14      harris41 3728: sub languagedescription {
1.125     www      3729:     my $code=shift;
                   3730:     return  ($supported_language{$code}?'* ':'').
                   3731:             $language{$code}.
1.126     www      3732: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3733: }
                   3734: 
1.1048    foxr     3735: =pod
                   3736: 
                   3737: =item * &plainlanguagedescription
                   3738: 
                   3739: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3740: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3741: 
                   3742: =cut
                   3743: 
1.145     www      3744: sub plainlanguagedescription {
                   3745:     my $code=shift;
                   3746:     return $language{$code};
                   3747: }
                   3748: 
1.1048    foxr     3749: =pod
                   3750: 
                   3751: =item * &supportedlanguagecode
                   3752: 
                   3753: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3754: code.
                   3755: 
                   3756: =cut
                   3757: 
1.145     www      3758: sub supportedlanguagecode {
                   3759:     my $code=shift;
                   3760:     return $supported_language{$code};
1.97      www      3761: }
                   3762: 
1.112     bowersj2 3763: =pod
                   3764: 
1.1048    foxr     3765: =item * &latexlanguage()
                   3766: 
                   3767: Given a language key code returns the correspondnig language to use
                   3768: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3769: is no supported hyphenation for the language code.
                   3770: 
                   3771: =cut
                   3772: 
                   3773: sub latexlanguage {
                   3774:     my $code = shift;
                   3775:     return $latex_language{$code};
                   3776: }
                   3777: 
                   3778: =pod
                   3779: 
                   3780: =item * &latexhyphenation()
                   3781: 
                   3782: Same as above but what's supplied is the language as it might be stored
                   3783: in the metadata.
                   3784: 
                   3785: =cut
                   3786: 
                   3787: sub latexhyphenation {
                   3788:     my $key = shift;
                   3789:     return $latex_language_bykey{$key};
                   3790: }
                   3791: 
                   3792: =pod
                   3793: 
1.648     raeburn  3794: =item * &copyrightids() 
1.112     bowersj2 3795: 
                   3796: returns list of all copyrights
                   3797: 
                   3798: =cut
                   3799: 
                   3800: sub copyrightids {
                   3801:     return sort(keys(%cprtag));
                   3802: }
                   3803: 
                   3804: =pod
                   3805: 
1.648     raeburn  3806: =item * &copyrightdescription() 
1.112     bowersj2 3807: 
                   3808: returns description of a specified copyright id
                   3809: 
                   3810: =cut
                   3811: 
                   3812: sub copyrightdescription {
1.166     www      3813:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3814: }
1.197     matthew  3815: 
                   3816: =pod
                   3817: 
1.648     raeburn  3818: =item * &source_copyrightids() 
1.192     taceyjo1 3819: 
                   3820: returns list of all source copyrights
                   3821: 
                   3822: =cut
                   3823: 
                   3824: sub source_copyrightids {
                   3825:     return sort(keys(%scprtag));
                   3826: }
                   3827: 
                   3828: =pod
                   3829: 
1.648     raeburn  3830: =item * &source_copyrightdescription() 
1.192     taceyjo1 3831: 
                   3832: returns description of a specified source copyright id
                   3833: 
                   3834: =cut
                   3835: 
                   3836: sub source_copyrightdescription {
                   3837:     return &mt($scprtag{shift(@_)});
                   3838: }
1.112     bowersj2 3839: 
                   3840: =pod
                   3841: 
1.648     raeburn  3842: =item * &filecategories() 
1.112     bowersj2 3843: 
                   3844: returns list of all file categories
                   3845: 
                   3846: =cut
                   3847: 
                   3848: sub filecategories {
                   3849:     return sort(keys(%category_extensions));
                   3850: }
                   3851: 
                   3852: =pod
                   3853: 
1.648     raeburn  3854: =item * &filecategorytypes() 
1.112     bowersj2 3855: 
                   3856: returns list of file types belonging to a given file
                   3857: category
                   3858: 
                   3859: =cut
                   3860: 
                   3861: sub filecategorytypes {
1.356     albertel 3862:     my ($cat) = @_;
                   3863:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3864: }
                   3865: 
                   3866: =pod
                   3867: 
1.648     raeburn  3868: =item * &fileembstyle() 
1.112     bowersj2 3869: 
                   3870: returns embedding style for a specified file type
                   3871: 
                   3872: =cut
                   3873: 
                   3874: sub fileembstyle {
                   3875:     return $fe{lc(shift(@_))};
1.169     www      3876: }
                   3877: 
1.351     www      3878: sub filemimetype {
                   3879:     return $fm{lc(shift(@_))};
                   3880: }
                   3881: 
1.169     www      3882: 
                   3883: sub filecategoryselect {
                   3884:     my ($name,$value)=@_;
1.189     matthew  3885:     return &select_form($value,$name,
1.970     raeburn  3886:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3887: }
                   3888: 
                   3889: =pod
                   3890: 
1.648     raeburn  3891: =item * &filedescription() 
1.112     bowersj2 3892: 
                   3893: returns description for a specified file type
                   3894: 
                   3895: =cut
                   3896: 
                   3897: sub filedescription {
1.188     matthew  3898:     my $file_description = $fd{lc(shift())};
                   3899:     $file_description =~ s:([\[\]]):~$1:g;
                   3900:     return &mt($file_description);
1.112     bowersj2 3901: }
                   3902: 
                   3903: =pod
                   3904: 
1.648     raeburn  3905: =item * &filedescriptionex() 
1.112     bowersj2 3906: 
                   3907: returns description for a specified file type with
                   3908: extra formatting
                   3909: 
                   3910: =cut
                   3911: 
                   3912: sub filedescriptionex {
                   3913:     my $ex=shift;
1.188     matthew  3914:     my $file_description = $fd{lc($ex)};
                   3915:     $file_description =~ s:([\[\]]):~$1:g;
                   3916:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3917: }
                   3918: 
                   3919: # End of .tab access
                   3920: =pod
                   3921: 
                   3922: =back
                   3923: 
                   3924: =cut
                   3925: 
                   3926: # ------------------------------------------------------------------ File Types
                   3927: sub fileextensions {
                   3928:     return sort(keys(%fe));
                   3929: }
                   3930: 
1.97      www      3931: # ----------------------------------------------------------- Display Languages
                   3932: # returns a hash with all desired display languages
                   3933: #
                   3934: 
                   3935: sub display_languages {
                   3936:     my %languages=();
1.695     raeburn  3937:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3938: 	$languages{$lang}=1;
1.97      www      3939:     }
                   3940:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3941:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3942: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3943: 	    $languages{$lang}=1;
1.97      www      3944:         }
                   3945:     }
                   3946:     return %languages;
1.14      harris41 3947: }
                   3948: 
1.582     albertel 3949: sub languages {
                   3950:     my ($possible_langs) = @_;
1.695     raeburn  3951:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3952:     if (!ref($possible_langs)) {
                   3953: 	if( wantarray ) {
                   3954: 	    return @preferred_langs;
                   3955: 	} else {
                   3956: 	    return $preferred_langs[0];
                   3957: 	}
                   3958:     }
                   3959:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3960:     my @preferred_possibilities;
                   3961:     foreach my $preferred_lang (@preferred_langs) {
                   3962: 	if (exists($possibilities{$preferred_lang})) {
                   3963: 	    push(@preferred_possibilities, $preferred_lang);
                   3964: 	}
                   3965:     }
                   3966:     if( wantarray ) {
                   3967: 	return @preferred_possibilities;
                   3968:     }
                   3969:     return $preferred_possibilities[0];
                   3970: }
                   3971: 
1.742     raeburn  3972: sub user_lang {
                   3973:     my ($touname,$toudom,$fromcid) = @_;
                   3974:     my @userlangs;
                   3975:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3976:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3977:                     $env{'course.'.$fromcid.'.languages'}));
                   3978:     } else {
                   3979:         my %langhash = &getlangs($touname,$toudom);
                   3980:         if ($langhash{'languages'} ne '') {
                   3981:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3982:         } else {
                   3983:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3984:             if ($domdefs{'lang_def'} ne '') {
                   3985:                 @userlangs = ($domdefs{'lang_def'});
                   3986:             }
                   3987:         }
                   3988:     }
                   3989:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3990:     my $user_lh = Apache::localize->get_handle(@languages);
                   3991:     return $user_lh;
                   3992: }
                   3993: 
                   3994: 
1.112     bowersj2 3995: ###############################################################
                   3996: ##               Student Answer Attempts                     ##
                   3997: ###############################################################
                   3998: 
                   3999: =pod
                   4000: 
                   4001: =head1 Alternate Problem Views
                   4002: 
                   4003: =over 4
                   4004: 
1.648     raeburn  4005: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199    raeburn  4006:     $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112     bowersj2 4007: 
                   4008: Return string with previous attempt on problem. Arguments:
                   4009: 
                   4010: =over 4
                   4011: 
                   4012: =item * $symb: Problem, including path
                   4013: 
                   4014: =item * $username: username of the desired student
                   4015: 
                   4016: =item * $domain: domain of the desired student
1.14      harris41 4017: 
1.112     bowersj2 4018: =item * $course: Course ID
1.14      harris41 4019: 
1.112     bowersj2 4020: =item * $getattempt: Leave blank for all attempts, otherwise put
                   4021:     something
1.14      harris41 4022: 
1.112     bowersj2 4023: =item * $regexp: if string matches this regexp, the string will be
                   4024:     sent to $gradesub
1.14      harris41 4025: 
1.112     bowersj2 4026: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 4027: 
1.1199    raeburn  4028: =item * $usec: section of the desired student
                   4029: 
                   4030: =item * $identifier: counter for student (multiple students one problem) or 
                   4031:     problem (one student; whole sequence).
                   4032: 
1.112     bowersj2 4033: =back
1.14      harris41 4034: 
1.112     bowersj2 4035: The output string is a table containing all desired attempts, if any.
1.16      harris41 4036: 
1.112     bowersj2 4037: =cut
1.1       albertel 4038: 
                   4039: sub get_previous_attempt {
1.1199    raeburn  4040:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1       albertel 4041:   my $prevattempts='';
1.43      ng       4042:   no strict 'refs';
1.1       albertel 4043:   if ($symb) {
1.3       albertel 4044:     my (%returnhash)=
                   4045:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 4046:     if ($returnhash{'version'}) {
                   4047:       my %lasthash=();
                   4048:       my $version;
                   4049:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212    raeburn  4050:         foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
                   4051:             if ($key =~ /\.rawrndseed$/) {
                   4052:                 my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
                   4053:                 $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
                   4054:             } else {
                   4055:                 $lasthash{$key}=$returnhash{$version.':'.$key};
                   4056:             }
1.19      harris41 4057:         }
1.1       albertel 4058:       }
1.596     albertel 4059:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   4060:       $prevattempts.='<th>'.&mt('History').'</th>';
1.1199    raeburn  4061:       my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945     raeburn  4062:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 4063:       foreach my $key (sort(keys(%lasthash))) {
                   4064: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       4065: 	if ($#parts > 0) {
1.31      albertel 4066: 	  my $data=$parts[-1];
1.989     raeburn  4067:           next if ($data eq 'foilorder');
1.31      albertel 4068: 	  pop(@parts);
1.1010    www      4069:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  4070:           if ($data eq 'type') {
                   4071:               unless ($showsurv) {
                   4072:                   my $id = join(',',@parts);
                   4073:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  4074:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   4075:                       $lasthidden{$ign.'.'.$id} = 1;
                   4076:                   }
1.945     raeburn  4077:               }
1.1199    raeburn  4078:               if ($identifier ne '') {
                   4079:                   my $id = join(',',@parts);
                   4080:                   if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
                   4081:                                                $domain,$username,$usec,undef,$course) =~ /^no/) {
                   4082:                       $hidestatus{$ign.'.'.$id} = 1;
                   4083:                   }
                   4084:               }
                   4085:           } elsif ($data eq 'regrader') {
                   4086:               if (($identifier ne '') && (@parts)) {
1.1200    raeburn  4087:                   my $id = join(',',@parts);
                   4088:                   $regraded{$ign.'.'.$id} = 1;
1.1199    raeburn  4089:               }
1.1010    www      4090:           } 
1.31      albertel 4091: 	} else {
1.41      ng       4092: 	  if ($#parts == 0) {
                   4093: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   4094: 	  } else {
                   4095: 	    $prevattempts.='<th>'.$ign.'</th>';
                   4096: 	  }
1.31      albertel 4097: 	}
1.16      harris41 4098:       }
1.596     albertel 4099:       $prevattempts.=&end_data_table_header_row();
1.40      ng       4100:       if ($getattempt eq '') {
1.1199    raeburn  4101:         my (%solved,%resets,%probstatus);
1.1200    raeburn  4102:         if (($identifier ne '') && (keys(%regraded) > 0)) {
                   4103:             for ($version=1;$version<=$returnhash{'version'};$version++) {
                   4104:                 foreach my $id (keys(%regraded)) {
                   4105:                     if (($returnhash{$version.':'.$id.'.regrader'}) &&
                   4106:                         ($returnhash{$version.':'.$id.'.tries'} eq '') &&
                   4107:                         ($returnhash{$version.':'.$id.'.award'} eq '')) {
                   4108:                         push(@{$resets{$id}},$version);
1.1199    raeburn  4109:                     }
                   4110:                 }
                   4111:             }
1.1200    raeburn  4112:         }
                   4113: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199    raeburn  4114:             my (@hidden,@unsolved);
1.945     raeburn  4115:             if (%typeparts) {
                   4116:                 foreach my $id (keys(%typeparts)) {
1.1199    raeburn  4117:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || 
                   4118:                         ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945     raeburn  4119:                         push(@hidden,$id);
1.1199    raeburn  4120:                     } elsif ($identifier ne '') {
                   4121:                         unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
                   4122:                                 ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
                   4123:                                 ($hidestatus{$id})) {
1.1200    raeburn  4124:                             next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199    raeburn  4125:                             if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
                   4126:                                 push(@{$solved{$id}},$version);
                   4127:                             } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
                   4128:                                      (ref($solved{$id}) eq 'ARRAY')) {
                   4129:                                 my $skip;
                   4130:                                 if (ref($resets{$id}) eq 'ARRAY') {
                   4131:                                     foreach my $reset (@{$resets{$id}}) {
                   4132:                                         if ($reset > $solved{$id}[-1]) {
                   4133:                                             $skip=1;
                   4134:                                             last;
                   4135:                                         }
                   4136:                                     }
                   4137:                                 }
                   4138:                                 unless ($skip) {
                   4139:                                     my ($ign,$partslist) = split(/\./,$id,2);
                   4140:                                     push(@unsolved,$partslist);
                   4141:                                 }
                   4142:                             }
                   4143:                         }
1.945     raeburn  4144:                     }
                   4145:                 }
                   4146:             }
                   4147:             $prevattempts.=&start_data_table_row().
1.1199    raeburn  4148:                            '<td>'.&mt('Transaction [_1]',$version);
                   4149:             if (@unsolved) {
                   4150:                 $prevattempts .= '<span class="LC_nobreak"><label>'.
                   4151:                                  '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
                   4152:                                  &mt('Hide').'</label></span>';
                   4153:             }
                   4154:             $prevattempts .= '</td>';
1.945     raeburn  4155:             if (@hidden) {
                   4156:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4157:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  4158:                     my $hide;
                   4159:                     foreach my $id (@hidden) {
                   4160:                         if ($key =~ /^\Q$id\E/) {
                   4161:                             $hide = 1;
                   4162:                             last;
                   4163:                         }
                   4164:                     }
                   4165:                     if ($hide) {
                   4166:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   4167:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   4168:                             my $value = &format_previous_attempt_value($key,
                   4169:                                              $returnhash{$version.':'.$key});
1.1173    kruse    4170:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  4171:                         } else {
                   4172:                             $prevattempts.='<td>&nbsp;</td>';
                   4173:                         }
                   4174:                     } else {
                   4175:                         if ($key =~ /\./) {
1.1212    raeburn  4176:                             my $value = $returnhash{$version.':'.$key};
                   4177:                             if ($key =~ /\.rndseed$/) {
                   4178:                                 my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                   4179:                                 if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4180:                                     $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4181:                                 }
                   4182:                             }
                   4183:                             $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4184:                                            '&nbsp;</td>';
1.945     raeburn  4185:                         } else {
                   4186:                             $prevattempts.='<td>&nbsp;</td>';
                   4187:                         }
                   4188:                     }
                   4189:                 }
                   4190:             } else {
                   4191: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4192:                     next if ($key =~ /\.foilorder$/);
1.1212    raeburn  4193:                     my $value = $returnhash{$version.':'.$key};
                   4194:                     if ($key =~ /\.rndseed$/) {
                   4195:                         my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                   4196:                         if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4197:                             $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4198:                         }
                   4199:                     }
                   4200:                     $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4201:                                    '&nbsp;</td>';
1.945     raeburn  4202: 	        }
                   4203:             }
                   4204: 	    $prevattempts.=&end_data_table_row();
1.40      ng       4205: 	 }
1.1       albertel 4206:       }
1.945     raeburn  4207:       my @currhidden = keys(%lasthidden);
1.596     albertel 4208:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 4209:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4210:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  4211:           if (%typeparts) {
                   4212:               my $hidden;
                   4213:               foreach my $id (@currhidden) {
                   4214:                   if ($key =~ /^\Q$id\E/) {
                   4215:                       $hidden = 1;
                   4216:                       last;
                   4217:                   }
                   4218:               }
                   4219:               if ($hidden) {
                   4220:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   4221:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   4222:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4223:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4224:                           $value = &$gradesub($value);
                   4225:                       }
1.1173    kruse    4226:                       $prevattempts.='<td>'. $value.'&nbsp;</td>';
1.945     raeburn  4227:                   } else {
                   4228:                       $prevattempts.='<td>&nbsp;</td>';
                   4229:                   }
                   4230:               } else {
                   4231:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4232:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4233:                       $value = &$gradesub($value);
                   4234:                   }
1.1173    kruse    4235:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  4236:               }
                   4237:           } else {
                   4238: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4239: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4240:                   $value = &$gradesub($value);
                   4241:               }
1.1173    kruse    4242: 	     $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  4243:           }
1.16      harris41 4244:       }
1.596     albertel 4245:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 4246:     } else {
1.596     albertel 4247:       $prevattempts=
                   4248: 	  &start_data_table().&start_data_table_row().
                   4249: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   4250: 	  &end_data_table_row().&end_data_table();
1.1       albertel 4251:     }
                   4252:   } else {
1.596     albertel 4253:     $prevattempts=
                   4254: 	  &start_data_table().&start_data_table_row().
                   4255: 	  '<td>'.&mt('No data.').'</td>'.
                   4256: 	  &end_data_table_row().&end_data_table();
1.1       albertel 4257:   }
1.10      albertel 4258: }
                   4259: 
1.581     albertel 4260: sub format_previous_attempt_value {
                   4261:     my ($key,$value) = @_;
1.1011    www      4262:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173    kruse    4263:         $value = &Apache::lonlocal::locallocaltime($value);
1.581     albertel 4264:     } elsif (ref($value) eq 'ARRAY') {
1.1173    kruse    4265:         $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988     raeburn  4266:     } elsif ($key =~ /answerstring$/) {
                   4267:         my %answers = &Apache::lonnet::str2hash($value);
1.1173    kruse    4268:         my @answer = %answers;
                   4269:         %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988     raeburn  4270:         my @anskeys = sort(keys(%answers));
                   4271:         if (@anskeys == 1) {
                   4272:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  4273:             if ($answer =~ m{\0}) {
                   4274:                 $answer =~ s{\0}{,}g;
1.988     raeburn  4275:             }
                   4276:             my $tag_internal_answer_name = 'INTERNAL';
                   4277:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   4278:                 $value = $answer; 
                   4279:             } else {
                   4280:                 $value = $anskeys[0].'='.$answer;
                   4281:             }
                   4282:         } else {
                   4283:             foreach my $ans (@anskeys) {
                   4284:                 my $answer = $answers{$ans};
1.1001    raeburn  4285:                 if ($answer =~ m{\0}) {
                   4286:                     $answer =~ s{\0}{,}g;
1.988     raeburn  4287:                 }
                   4288:                 $value .=  $ans.'='.$answer.'<br />';;
                   4289:             } 
                   4290:         }
1.581     albertel 4291:     } else {
1.1173    kruse    4292:         $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581     albertel 4293:     }
                   4294:     return $value;
                   4295: }
                   4296: 
                   4297: 
1.107     albertel 4298: sub relative_to_absolute {
                   4299:     my ($url,$output)=@_;
                   4300:     my $parser=HTML::TokeParser->new(\$output);
                   4301:     my $token;
                   4302:     my $thisdir=$url;
                   4303:     my @rlinks=();
                   4304:     while ($token=$parser->get_token) {
                   4305: 	if ($token->[0] eq 'S') {
                   4306: 	    if ($token->[1] eq 'a') {
                   4307: 		if ($token->[2]->{'href'}) {
                   4308: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   4309: 		}
                   4310: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   4311: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   4312: 	    } elsif ($token->[1] eq 'base') {
                   4313: 		$thisdir=$token->[2]->{'href'};
                   4314: 	    }
                   4315: 	}
                   4316:     }
                   4317:     $thisdir=~s-/[^/]*$--;
1.356     albertel 4318:     foreach my $link (@rlinks) {
1.726     raeburn  4319: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 4320: 		($link=~/^\//) ||
                   4321: 		($link=~/^javascript:/i) ||
                   4322: 		($link=~/^mailto:/i) ||
                   4323: 		($link=~/^\#/)) {
                   4324: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   4325: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 4326: 	}
                   4327:     }
                   4328: # -------------------------------------------------- Deal with Applet codebases
                   4329:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   4330:     return $output;
                   4331: }
                   4332: 
1.112     bowersj2 4333: =pod
                   4334: 
1.648     raeburn  4335: =item * &get_student_view()
1.112     bowersj2 4336: 
                   4337: show a snapshot of what student was looking at
                   4338: 
                   4339: =cut
                   4340: 
1.10      albertel 4341: sub get_student_view {
1.186     albertel 4342:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      4343:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4344:   my (%form);
1.10      albertel 4345:   my @elements=('symb','courseid','domain','username');
                   4346:   foreach my $element (@elements) {
1.186     albertel 4347:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4348:   }
1.186     albertel 4349:   if (defined($moreenv)) {
                   4350:       %form=(%form,%{$moreenv});
                   4351:   }
1.236     albertel 4352:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 4353:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      4354:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 4355:   $userview=~s/\<body[^\>]*\>//gi;
                   4356:   $userview=~s/\<\/body\>//gi;
                   4357:   $userview=~s/\<html\>//gi;
                   4358:   $userview=~s/\<\/html\>//gi;
                   4359:   $userview=~s/\<head\>//gi;
                   4360:   $userview=~s/\<\/head\>//gi;
                   4361:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 4362:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      4363:   if (wantarray) {
                   4364:      return ($userview,$response);
                   4365:   } else {
                   4366:      return $userview;
                   4367:   }
                   4368: }
                   4369: 
                   4370: sub get_student_view_with_retries {
                   4371:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   4372: 
                   4373:     my $ok = 0;                 # True if we got a good response.
                   4374:     my $content;
                   4375:     my $response;
                   4376: 
                   4377:     # Try to get the student_view done. within the retries count:
                   4378:     
                   4379:     do {
                   4380:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   4381:          $ok      = $response->is_success;
                   4382:          if (!$ok) {
                   4383:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   4384:          }
                   4385:          $retries--;
                   4386:     } while (!$ok && ($retries > 0));
                   4387:     
                   4388:     if (!$ok) {
                   4389:        $content = '';          # On error return an empty content.
                   4390:     }
1.651     www      4391:     if (wantarray) {
                   4392:        return ($content, $response);
                   4393:     } else {
                   4394:        return $content;
                   4395:     }
1.11      albertel 4396: }
                   4397: 
1.112     bowersj2 4398: =pod
                   4399: 
1.648     raeburn  4400: =item * &get_student_answers() 
1.112     bowersj2 4401: 
                   4402: show a snapshot of how student was answering problem
                   4403: 
                   4404: =cut
                   4405: 
1.11      albertel 4406: sub get_student_answers {
1.100     sakharuk 4407:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      4408:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4409:   my (%moreenv);
1.11      albertel 4410:   my @elements=('symb','courseid','domain','username');
                   4411:   foreach my $element (@elements) {
1.186     albertel 4412:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4413:   }
1.186     albertel 4414:   $moreenv{'grade_target'}='answer';
                   4415:   %moreenv=(%form,%moreenv);
1.497     raeburn  4416:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4417:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4418:   return $userview;
1.1       albertel 4419: }
1.116     albertel 4420: 
                   4421: =pod
                   4422: 
                   4423: =item * &submlink()
                   4424: 
1.242     albertel 4425: Inputs: $text $uname $udom $symb $target
1.116     albertel 4426: 
                   4427: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4428: 
                   4429: =cut
                   4430: 
                   4431: ###############################################
                   4432: sub submlink {
1.242     albertel 4433:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4434:     if (!($uname && $udom)) {
                   4435: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4436: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4437: 	if (!$symb) { $symb=$cursymb; }
                   4438:     }
1.254     matthew  4439:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4440:     $symb=&escape($symb);
1.960     bisitz   4441:     if ($target) { $target=" target=\"$target\""; }
                   4442:     return
                   4443:         '<a href="/adm/grades?command=submission'.
                   4444:         '&amp;symb='.$symb.
                   4445:         '&amp;student='.$uname.
                   4446:         '&amp;userdom='.$udom.'"'.
                   4447:         $target.'>'.$text.'</a>';
1.242     albertel 4448: }
                   4449: ##############################################
                   4450: 
                   4451: =pod
                   4452: 
                   4453: =item * &pgrdlink()
                   4454: 
                   4455: Inputs: $text $uname $udom $symb $target
                   4456: 
                   4457: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4458: 
                   4459: =cut
                   4460: 
                   4461: ###############################################
                   4462: sub pgrdlink {
                   4463:     my $link=&submlink(@_);
                   4464:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4465:     return $link;
                   4466: }
                   4467: ##############################################
                   4468: 
                   4469: =pod
                   4470: 
                   4471: =item * &pprmlink()
                   4472: 
                   4473: Inputs: $text $uname $udom $symb $target
                   4474: 
                   4475: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4476: student and a specific resource
1.242     albertel 4477: 
                   4478: =cut
                   4479: 
                   4480: ###############################################
                   4481: sub pprmlink {
                   4482:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4483:     if (!($uname && $udom)) {
                   4484: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4485: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4486: 	if (!$symb) { $symb=$cursymb; }
                   4487:     }
1.254     matthew  4488:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4489:     $symb=&escape($symb);
1.242     albertel 4490:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4491:     return '<a href="/adm/parmset?command=set&amp;'.
                   4492: 	'symb='.$symb.'&amp;uname='.$uname.
                   4493: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4494: }
                   4495: ##############################################
1.37      matthew  4496: 
1.112     bowersj2 4497: =pod
                   4498: 
                   4499: =back
                   4500: 
                   4501: =cut
                   4502: 
1.37      matthew  4503: ###############################################
1.51      www      4504: 
                   4505: 
                   4506: sub timehash {
1.687     raeburn  4507:     my ($thistime) = @_;
                   4508:     my $timezone = &Apache::lonlocal::gettimezone();
                   4509:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4510:                      ->set_time_zone($timezone);
                   4511:     my $wday = $dt->day_of_week();
                   4512:     if ($wday == 7) { $wday = 0; }
                   4513:     return ( 'second' => $dt->second(),
                   4514:              'minute' => $dt->minute(),
                   4515:              'hour'   => $dt->hour(),
                   4516:              'day'     => $dt->day_of_month(),
                   4517:              'month'   => $dt->month(),
                   4518:              'year'    => $dt->year(),
                   4519:              'weekday' => $wday,
                   4520:              'dayyear' => $dt->day_of_year(),
                   4521:              'dlsav'   => $dt->is_dst() );
1.51      www      4522: }
                   4523: 
1.370     www      4524: sub utc_string {
                   4525:     my ($date)=@_;
1.371     www      4526:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4527: }
                   4528: 
1.51      www      4529: sub maketime {
                   4530:     my %th=@_;
1.687     raeburn  4531:     my ($epoch_time,$timezone,$dt);
                   4532:     $timezone = &Apache::lonlocal::gettimezone();
                   4533:     eval {
                   4534:         $dt = DateTime->new( year   => $th{'year'},
                   4535:                              month  => $th{'month'},
                   4536:                              day    => $th{'day'},
                   4537:                              hour   => $th{'hour'},
                   4538:                              minute => $th{'minute'},
                   4539:                              second => $th{'second'},
                   4540:                              time_zone => $timezone,
                   4541:                          );
                   4542:     };
                   4543:     if (!$@) {
                   4544:         $epoch_time = $dt->epoch;
                   4545:         if ($epoch_time) {
                   4546:             return $epoch_time;
                   4547:         }
                   4548:     }
1.51      www      4549:     return POSIX::mktime(
                   4550:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4551:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4552: }
                   4553: 
                   4554: #########################################
1.51      www      4555: 
                   4556: sub findallcourses {
1.482     raeburn  4557:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4558:     my %roles;
                   4559:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4560:     my %courses;
1.51      www      4561:     my $now=time;
1.482     raeburn  4562:     if (!defined($uname)) {
                   4563:         $uname = $env{'user.name'};
                   4564:     }
                   4565:     if (!defined($udom)) {
                   4566:         $udom = $env{'user.domain'};
                   4567:     }
                   4568:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4569:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4570:         if (!%roles) {
                   4571:             %roles = (
                   4572:                        cc => 1,
1.907     raeburn  4573:                        co => 1,
1.482     raeburn  4574:                        in => 1,
                   4575:                        ep => 1,
                   4576:                        ta => 1,
                   4577:                        cr => 1,
                   4578:                        st => 1,
                   4579:              );
                   4580:         }
                   4581:         foreach my $entry (keys(%roleshash)) {
                   4582:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4583:             if ($trole =~ /^cr/) { 
                   4584:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4585:             } else {
                   4586:                 next if (!exists($roles{$trole}));
                   4587:             }
                   4588:             if ($tend) {
                   4589:                 next if ($tend < $now);
                   4590:             }
                   4591:             if ($tstart) {
                   4592:                 next if ($tstart > $now);
                   4593:             }
1.1058    raeburn  4594:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4595:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4596:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4597:             if ($secpart eq '') {
                   4598:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4599:                 $sec = 'none';
1.1058    raeburn  4600:                 $value .= $cnum.'/';
1.482     raeburn  4601:             } else {
                   4602:                 $cnum = $cnumpart;
                   4603:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4604:                 $value .= $cnum.'/'.$sec;
                   4605:             }
                   4606:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4607:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4608:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4609:                 }
                   4610:             } else {
                   4611:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4612:             }
1.482     raeburn  4613:         }
                   4614:     } else {
                   4615:         foreach my $key (keys(%env)) {
1.483     albertel 4616: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4617:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4618: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4619: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4620: 	        next if (%roles && !exists($roles{$role}));
                   4621: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4622:                 my $active=1;
                   4623:                 if ($starttime) {
                   4624: 		    if ($now<$starttime) { $active=0; }
                   4625:                 }
                   4626:                 if ($endtime) {
                   4627:                     if ($now>$endtime) { $active=0; }
                   4628:                 }
                   4629:                 if ($active) {
1.1058    raeburn  4630:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4631:                     if ($sec eq '') {
                   4632:                         $sec = 'none';
1.1058    raeburn  4633:                     } else {
                   4634:                         $value .= $sec;
                   4635:                     }
                   4636:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4637:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4638:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4639:                         }
                   4640:                     } else {
                   4641:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4642:                     }
1.474     raeburn  4643:                 }
                   4644:             }
1.51      www      4645:         }
                   4646:     }
1.474     raeburn  4647:     return %courses;
1.51      www      4648: }
1.37      matthew  4649: 
1.54      www      4650: ###############################################
1.474     raeburn  4651: 
                   4652: sub blockcheck {
1.1189    raeburn  4653:     my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490     raeburn  4654: 
1.1189    raeburn  4655:     if (defined($udom) && defined($uname)) {
                   4656:         # If uname and udom are for a course, check for blocks in the course.
                   4657:         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
                   4658:             my ($startblock,$endblock,$triggerblock) =
                   4659:                 &get_blocks($setters,$activity,$udom,$uname,$url);
                   4660:             return ($startblock,$endblock,$triggerblock);
                   4661:         }
                   4662:     } else {
1.490     raeburn  4663:         $udom = $env{'user.domain'};
                   4664:         $uname = $env{'user.name'};
                   4665:     }
                   4666: 
1.502     raeburn  4667:     my $startblock = 0;
                   4668:     my $endblock = 0;
1.1062    raeburn  4669:     my $triggerblock = '';
1.482     raeburn  4670:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4671: 
1.490     raeburn  4672:     # If uname is for a user, and activity is course-specific, i.e.,
                   4673:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4674: 
1.490     raeburn  4675:     if (($activity eq 'boards' || $activity eq 'chat' ||
1.1189    raeburn  4676:          $activity eq 'groups' || $activity eq 'printout') &&
                   4677:         ($env{'request.course.id'})) {
1.490     raeburn  4678:         foreach my $key (keys(%live_courses)) {
                   4679:             if ($key ne $env{'request.course.id'}) {
                   4680:                 delete($live_courses{$key});
                   4681:             }
                   4682:         }
                   4683:     }
                   4684: 
                   4685:     my $otheruser = 0;
                   4686:     my %own_courses;
                   4687:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4688:         # Resource belongs to user other than current user.
                   4689:         $otheruser = 1;
                   4690:         # Gather courses for current user
                   4691:         %own_courses = 
                   4692:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4693:     }
                   4694: 
                   4695:     # Gather active course roles - course coordinator, instructor, 
                   4696:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4697: 
                   4698:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4699:         my ($cdom,$cnum);
                   4700:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4701:             $cdom = $env{'course.'.$course.'.domain'};
                   4702:             $cnum = $env{'course.'.$course.'.num'};
                   4703:         } else {
1.490     raeburn  4704:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4705:         }
                   4706:         my $no_ownblock = 0;
                   4707:         my $no_userblock = 0;
1.533     raeburn  4708:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4709:             # Check if current user has 'evb' priv for this
                   4710:             if (defined($own_courses{$course})) {
                   4711:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4712:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4713:                     if ($sec ne 'none') {
                   4714:                         $checkrole .= '/'.$sec;
                   4715:                     }
                   4716:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4717:                         $no_ownblock = 1;
                   4718:                         last;
                   4719:                     }
                   4720:                 }
                   4721:             }
                   4722:             # if they have 'evb' priv and are currently not playing student
                   4723:             next if (($no_ownblock) &&
                   4724:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4725:         }
1.474     raeburn  4726:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4727:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4728:             if ($sec ne 'none') {
1.482     raeburn  4729:                 $checkrole .= '/'.$sec;
1.474     raeburn  4730:             }
1.490     raeburn  4731:             if ($otheruser) {
                   4732:                 # Resource belongs to user other than current user.
                   4733:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4734:                 my (%allroles,%userroles);
                   4735:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4736:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4737:                         my ($trole,$tdom,$tnum,$tsec);
                   4738:                         if ($entry =~ /^cr/) {
                   4739:                             ($trole,$tdom,$tnum,$tsec) = 
                   4740:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4741:                         } else {
                   4742:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4743:                         }
                   4744:                         my ($spec,$area,$trest);
                   4745:                         $area = '/'.$tdom.'/'.$tnum;
                   4746:                         $trest = $tnum;
                   4747:                         if ($tsec ne '') {
                   4748:                             $area .= '/'.$tsec;
                   4749:                             $trest .= '/'.$tsec;
                   4750:                         }
                   4751:                         $spec = $trole.'.'.$area;
                   4752:                         if ($trole =~ /^cr/) {
                   4753:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4754:                                                               $tdom,$spec,$trest,$area);
                   4755:                         } else {
                   4756:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4757:                                                                 $tdom,$spec,$trest,$area);
                   4758:                         }
                   4759:                     }
                   4760:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4761:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4762:                         if ($1) {
                   4763:                             $no_userblock = 1;
                   4764:                             last;
                   4765:                         }
1.486     raeburn  4766:                     }
                   4767:                 }
1.490     raeburn  4768:             } else {
                   4769:                 # Resource belongs to current user
                   4770:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4771:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4772:                     $no_ownblock = 1;
                   4773:                     last;
                   4774:                 }
1.474     raeburn  4775:             }
                   4776:         }
                   4777:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4778:         next if (($no_ownblock) &&
1.491     albertel 4779:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4780:         next if ($no_userblock);
1.474     raeburn  4781: 
1.866     kalberla 4782:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4783:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4784:         
1.1062    raeburn  4785:         my ($start,$end,$trigger) = 
                   4786:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4787:         if (($start != 0) && 
                   4788:             (($startblock == 0) || ($startblock > $start))) {
                   4789:             $startblock = $start;
1.1062    raeburn  4790:             if ($trigger ne '') {
                   4791:                 $triggerblock = $trigger;
                   4792:             }
1.502     raeburn  4793:         }
                   4794:         if (($end != 0)  &&
                   4795:             (($endblock == 0) || ($endblock < $end))) {
                   4796:             $endblock = $end;
1.1062    raeburn  4797:             if ($trigger ne '') {
                   4798:                 $triggerblock = $trigger;
                   4799:             }
1.502     raeburn  4800:         }
1.490     raeburn  4801:     }
1.1062    raeburn  4802:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4803: }
                   4804: 
                   4805: sub get_blocks {
1.1062    raeburn  4806:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4807:     my $startblock = 0;
                   4808:     my $endblock = 0;
1.1062    raeburn  4809:     my $triggerblock = '';
1.490     raeburn  4810:     my $course = $cdom.'_'.$cnum;
                   4811:     $setters->{$course} = {};
                   4812:     $setters->{$course}{'staff'} = [];
                   4813:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4814:     $setters->{$course}{'triggers'} = [];
                   4815:     my (@blockers,%triggered);
                   4816:     my $now = time;
                   4817:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4818:     if ($activity eq 'docs') {
                   4819:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4820:         foreach my $block (@blockers) {
                   4821:             if ($block =~ /^firstaccess____(.+)$/) {
                   4822:                 my $item = $1;
                   4823:                 my $type = 'map';
                   4824:                 my $timersymb = $item;
                   4825:                 if ($item eq 'course') {
                   4826:                     $type = 'course';
                   4827:                 } elsif ($item =~ /___\d+___/) {
                   4828:                     $type = 'resource';
                   4829:                 } else {
                   4830:                     $timersymb = &Apache::lonnet::symbread($item);
                   4831:                 }
                   4832:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4833:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4834:                 $triggered{$block} = {
                   4835:                                        start => $start,
                   4836:                                        end   => $end,
                   4837:                                        type  => $type,
                   4838:                                      };
                   4839:             }
                   4840:         }
                   4841:     } else {
                   4842:         foreach my $block (keys(%commblocks)) {
                   4843:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4844:                 my ($start,$end) = ($1,$2);
                   4845:                 if ($start <= time && $end >= time) {
                   4846:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4847:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4848:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4849:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4850:                                     push(@blockers,$block);
                   4851:                                 }
                   4852:                             }
                   4853:                         }
                   4854:                     }
                   4855:                 }
                   4856:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4857:                 my $item = $1;
                   4858:                 my $timersymb = $item; 
                   4859:                 my $type = 'map';
                   4860:                 if ($item eq 'course') {
                   4861:                     $type = 'course';
                   4862:                 } elsif ($item =~ /___\d+___/) {
                   4863:                     $type = 'resource';
                   4864:                 } else {
                   4865:                     $timersymb = &Apache::lonnet::symbread($item);
                   4866:                 }
                   4867:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4868:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4869:                 if ($start && $end) {
                   4870:                     if (($start <= time) && ($end >= time)) {
                   4871:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4872:                             push(@blockers,$block);
                   4873:                             $triggered{$block} = {
                   4874:                                                    start => $start,
                   4875:                                                    end   => $end,
                   4876:                                                    type  => $type,
                   4877:                                                  };
                   4878:                         }
                   4879:                     }
1.490     raeburn  4880:                 }
1.1062    raeburn  4881:             }
                   4882:         }
                   4883:     }
                   4884:     foreach my $blocker (@blockers) {
                   4885:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4886:             &parse_block_record($commblocks{$blocker});
                   4887:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4888:         my ($start,$end,$triggertype);
                   4889:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4890:             ($start,$end) = ($1,$2);
                   4891:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4892:             $start = $triggered{$blocker}{'start'};
                   4893:             $end = $triggered{$blocker}{'end'};
                   4894:             $triggertype = $triggered{$blocker}{'type'};
                   4895:         }
                   4896:         if ($start) {
                   4897:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4898:             if ($triggertype) {
                   4899:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4900:             } else {
                   4901:                 push(@{$$setters{$course}{'triggers'}},0);
                   4902:             }
                   4903:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4904:                 $startblock = $start;
                   4905:                 if ($triggertype) {
                   4906:                     $triggerblock = $blocker;
1.474     raeburn  4907:                 }
                   4908:             }
1.1062    raeburn  4909:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4910:                $endblock = $end;
                   4911:                if ($triggertype) {
                   4912:                    $triggerblock = $blocker;
                   4913:                }
                   4914:             }
1.474     raeburn  4915:         }
                   4916:     }
1.1062    raeburn  4917:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4918: }
                   4919: 
                   4920: sub parse_block_record {
                   4921:     my ($record) = @_;
                   4922:     my ($setuname,$setudom,$title,$blocks);
                   4923:     if (ref($record) eq 'HASH') {
                   4924:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4925:         $title = &unescape($record->{'event'});
                   4926:         $blocks = $record->{'blocks'};
                   4927:     } else {
                   4928:         my @data = split(/:/,$record,3);
                   4929:         if (scalar(@data) eq 2) {
                   4930:             $title = $data[1];
                   4931:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4932:         } else {
                   4933:             ($setuname,$setudom,$title) = @data;
                   4934:         }
                   4935:         $blocks = { 'com' => 'on' };
                   4936:     }
                   4937:     return ($setuname,$setudom,$title,$blocks);
                   4938: }
                   4939: 
1.854     kalberla 4940: sub blocking_status {
1.1189    raeburn  4941:     my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061    raeburn  4942:     my %setters;
1.890     droeschl 4943: 
1.1061    raeburn  4944: # check for active blocking
1.1062    raeburn  4945:     my ($startblock,$endblock,$triggerblock) = 
1.1189    raeburn  4946:         &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062    raeburn  4947:     my $blocked = 0;
                   4948:     if ($startblock && $endblock) {
                   4949:         $blocked = 1;
                   4950:     }
1.890     droeschl 4951: 
1.1061    raeburn  4952: # caller just wants to know whether a block is active
                   4953:     if (!wantarray) { return $blocked; }
                   4954: 
                   4955: # build a link to a popup window containing the details
                   4956:     my $querystring  = "?activity=$activity";
                   4957: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062    raeburn  4958:     if ($activity eq 'port') {
                   4959:         $querystring .= "&amp;udom=$udom"      if $udom;
                   4960:         $querystring .= "&amp;uname=$uname"    if $uname;
                   4961:     } elsif ($activity eq 'docs') {
                   4962:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4963:     }
1.1061    raeburn  4964: 
                   4965:     my $output .= <<'END_MYBLOCK';
                   4966: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4967:     var options = "width=" + w + ",height=" + h + ",";
                   4968:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4969:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4970:     var newWin = window.open(url, wdwName, options);
                   4971:     newWin.focus();
                   4972: }
1.890     droeschl 4973: END_MYBLOCK
1.854     kalberla 4974: 
1.1061    raeburn  4975:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4976:   
1.1061    raeburn  4977:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4978:     my $text = &mt('Communication Blocked');
1.1217    raeburn  4979:     my $class = 'LC_comblock';
1.1062    raeburn  4980:     if ($activity eq 'docs') {
                   4981:         $text = &mt('Content Access Blocked');
1.1217    raeburn  4982:         $class = '';
1.1063    raeburn  4983:     } elsif ($activity eq 'printout') {
                   4984:         $text = &mt('Printing Blocked');
1.1062    raeburn  4985:     }
1.1061    raeburn  4986:     $output .= <<"END_BLOCK";
1.1217    raeburn  4987: <div class='$class'>
1.869     kalberla 4988:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4989:   title='$text'>
                   4990:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4991:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4992:   title='$text'>$text</a>
1.867     kalberla 4993: </div>
                   4994: 
                   4995: END_BLOCK
1.474     raeburn  4996: 
1.1061    raeburn  4997:     return ($blocked, $output);
1.854     kalberla 4998: }
1.490     raeburn  4999: 
1.60      matthew  5000: ###############################################
                   5001: 
1.682     raeburn  5002: sub check_ip_acc {
1.1201    raeburn  5003:     my ($acc,$clientip)=@_;
1.682     raeburn  5004:     &Apache::lonxml::debug("acc is $acc");
                   5005:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   5006:         return 1;
                   5007:     }
1.1219    raeburn  5008:     my $allowed;
1.1201    raeburn  5009:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
1.682     raeburn  5010: 
                   5011:     my $name;
1.1219    raeburn  5012:     my %access = (
                   5013:                      allowfrom => 1,
                   5014:                      denyfrom  => 0,
                   5015:                  );
                   5016:     my @allows;
                   5017:     my @denies;
                   5018:     foreach my $item (split(',',$acc)) {
                   5019:         $item =~ s/^\s*//;
                   5020:         $item =~ s/\s*$//;
                   5021:         my $pattern;
                   5022:         if ($item =~ /^\!(.+)$/) {
                   5023:             push(@denies,$1);
                   5024:         } else {
                   5025:             push(@allows,$item);
                   5026:         }
                   5027:    }
                   5028:    my $numdenies = scalar(@denies);
                   5029:    my $numallows = scalar(@allows);
                   5030:    my $count = 0;
                   5031:    foreach my $pattern (@denies,@allows) {
                   5032:         $count ++; 
                   5033:         my $acctype = 'allowfrom';
                   5034:         if ($count <= $numdenies) {
                   5035:             $acctype = 'denyfrom';
                   5036:         }
1.682     raeburn  5037:         if ($pattern =~ /\*$/) {
                   5038:             #35.8.*
                   5039:             $pattern=~s/\*//;
1.1219    raeburn  5040:             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682     raeburn  5041:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   5042:             #35.8.3.[34-56]
                   5043:             my $low=$2;
                   5044:             my $high=$3;
                   5045:             $pattern=$1;
                   5046:             if ($ip =~ /^\Q$pattern\E/) {
                   5047:                 my $last=(split(/\./,$ip))[3];
1.1219    raeburn  5048:                 if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682     raeburn  5049:             }
                   5050:         } elsif ($pattern =~ /^\*/) {
                   5051:             #*.msu.edu
                   5052:             $pattern=~s/\*//;
                   5053:             if (!defined($name)) {
                   5054:                 use Socket;
                   5055:                 my $netaddr=inet_aton($ip);
                   5056:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   5057:             }
1.1219    raeburn  5058:             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682     raeburn  5059:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   5060:             #127.0.0.1
1.1219    raeburn  5061:             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682     raeburn  5062:         } else {
                   5063:             #some.name.com
                   5064:             if (!defined($name)) {
                   5065:                 use Socket;
                   5066:                 my $netaddr=inet_aton($ip);
                   5067:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   5068:             }
1.1219    raeburn  5069:             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
                   5070:         }
                   5071:         if ($allowed =~ /^(0|1)$/) { last; }
                   5072:     }
                   5073:     if ($allowed eq '') {
                   5074:         if ($numdenies && !$numallows) {
                   5075:             $allowed = 1;
                   5076:         } else {
                   5077:             $allowed = 0;
1.682     raeburn  5078:         }
                   5079:     }
                   5080:     return $allowed;
                   5081: }
                   5082: 
                   5083: ###############################################
                   5084: 
1.60      matthew  5085: =pod
                   5086: 
1.112     bowersj2 5087: =head1 Domain Template Functions
                   5088: 
                   5089: =over 4
                   5090: 
                   5091: =item * &determinedomain()
1.60      matthew  5092: 
                   5093: Inputs: $domain (usually will be undef)
                   5094: 
1.63      www      5095: Returns: Determines which domain should be used for designs
1.60      matthew  5096: 
                   5097: =cut
1.54      www      5098: 
1.60      matthew  5099: ###############################################
1.63      www      5100: sub determinedomain {
                   5101:     my $domain=shift;
1.531     albertel 5102:     if (! $domain) {
1.60      matthew  5103:         # Determine domain if we have not been given one
1.893     raeburn  5104:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 5105:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   5106:         if ($env{'request.role.domain'}) { 
                   5107:             $domain=$env{'request.role.domain'}; 
1.60      matthew  5108:         }
                   5109:     }
1.63      www      5110:     return $domain;
                   5111: }
                   5112: ###############################################
1.517     raeburn  5113: 
1.518     albertel 5114: sub devalidate_domconfig_cache {
                   5115:     my ($udom)=@_;
                   5116:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   5117: }
                   5118: 
                   5119: # ---------------------- Get domain configuration for a domain
                   5120: sub get_domainconf {
                   5121:     my ($udom) = @_;
                   5122:     my $cachetime=1800;
                   5123:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   5124:     if (defined($cached)) { return %{$result}; }
                   5125: 
                   5126:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  5127: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  5128:     my (%designhash,%legacy);
1.518     albertel 5129:     if (keys(%domconfig) > 0) {
                   5130:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  5131:             if (keys(%{$domconfig{'login'}})) {
                   5132:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  5133:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208    raeburn  5134:                         if (($key eq 'loginvia') || ($key eq 'headtag')) {
                   5135:                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                   5136:                                 foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
                   5137:                                     if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
                   5138:                                         if ($key eq 'loginvia') {
                   5139:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   5140:                                                 my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   5141:                                                 $designhash{$udom.'.login.loginvia'} = $server;
                   5142:                                                 if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   5143: 
                   5144:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   5145:                                                 } else {
                   5146:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
                   5147:                                                 }
1.948     raeburn  5148:                                             }
1.1208    raeburn  5149:                                         } elsif ($key eq 'headtag') {
                   5150:                                             if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
                   5151:                                                 $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948     raeburn  5152:                                             }
1.946     raeburn  5153:                                         }
1.1208    raeburn  5154:                                         if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
                   5155:                                             $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
                   5156:                                         }
1.946     raeburn  5157:                                     }
                   5158:                                 }
                   5159:                             }
                   5160:                         } else {
                   5161:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   5162:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   5163:                                     $domconfig{'login'}{$key}{$img};
                   5164:                             }
1.699     raeburn  5165:                         }
                   5166:                     } else {
                   5167:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   5168:                     }
1.632     raeburn  5169:                 }
                   5170:             } else {
                   5171:                 $legacy{'login'} = 1;
1.518     albertel 5172:             }
1.632     raeburn  5173:         } else {
                   5174:             $legacy{'login'} = 1;
1.518     albertel 5175:         }
                   5176:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  5177:             if (keys(%{$domconfig{'rolecolors'}})) {
                   5178:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   5179:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   5180:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   5181:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   5182:                         }
1.518     albertel 5183:                     }
                   5184:                 }
1.632     raeburn  5185:             } else {
                   5186:                 $legacy{'rolecolors'} = 1;
1.518     albertel 5187:             }
1.632     raeburn  5188:         } else {
                   5189:             $legacy{'rolecolors'} = 1;
1.518     albertel 5190:         }
1.948     raeburn  5191:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   5192:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   5193:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   5194:             }
                   5195:         }
1.632     raeburn  5196:         if (keys(%legacy) > 0) {
                   5197:             my %legacyhash = &get_legacy_domconf($udom);
                   5198:             foreach my $item (keys(%legacyhash)) {
                   5199:                 if ($item =~ /^\Q$udom\E\.login/) {
                   5200:                     if ($legacy{'login'}) { 
                   5201:                         $designhash{$item} = $legacyhash{$item};
                   5202:                     }
                   5203:                 } else {
                   5204:                     if ($legacy{'rolecolors'}) {
                   5205:                         $designhash{$item} = $legacyhash{$item};
                   5206:                     }
1.518     albertel 5207:                 }
                   5208:             }
                   5209:         }
1.632     raeburn  5210:     } else {
                   5211:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 5212:     }
                   5213:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   5214: 				  $cachetime);
                   5215:     return %designhash;
                   5216: }
                   5217: 
1.632     raeburn  5218: sub get_legacy_domconf {
                   5219:     my ($udom) = @_;
                   5220:     my %legacyhash;
                   5221:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   5222:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   5223:     if (-e $designfile) {
                   5224:         if ( open (my $fh,"<$designfile") ) {
                   5225:             while (my $line = <$fh>) {
                   5226:                 next if ($line =~ /^\#/);
                   5227:                 chomp($line);
                   5228:                 my ($key,$val)=(split(/\=/,$line));
                   5229:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   5230:             }
                   5231:             close($fh);
                   5232:         }
                   5233:     }
1.1026    raeburn  5234:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  5235:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   5236:     }
                   5237:     return %legacyhash;
                   5238: }
                   5239: 
1.63      www      5240: =pod
                   5241: 
1.112     bowersj2 5242: =item * &domainlogo()
1.63      www      5243: 
                   5244: Inputs: $domain (usually will be undef)
                   5245: 
                   5246: Returns: A link to a domain logo, if the domain logo exists.
                   5247: If the domain logo does not exist, a description of the domain.
                   5248: 
                   5249: =cut
1.112     bowersj2 5250: 
1.63      www      5251: ###############################################
                   5252: sub domainlogo {
1.517     raeburn  5253:     my $domain = &determinedomain(shift);
1.518     albertel 5254:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  5255:     # See if there is a logo
                   5256:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  5257:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 5258:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   5259: 	    if ($imgsrc =~ m{^/res/}) {
                   5260: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   5261: 		&Apache::lonnet::repcopy($local_name);
                   5262: 	    }
                   5263: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  5264:         } 
                   5265:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 5266:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   5267:         return &Apache::lonnet::domain($domain,'description');
1.59      www      5268:     } else {
1.60      matthew  5269:         return '';
1.59      www      5270:     }
                   5271: }
1.63      www      5272: ##############################################
                   5273: 
                   5274: =pod
                   5275: 
1.112     bowersj2 5276: =item * &designparm()
1.63      www      5277: 
                   5278: Inputs: $which parameter; $domain (usually will be undef)
                   5279: 
                   5280: Returns: value of designparamter $which
                   5281: 
                   5282: =cut
1.112     bowersj2 5283: 
1.397     albertel 5284: 
1.400     albertel 5285: ##############################################
1.397     albertel 5286: sub designparm {
                   5287:     my ($which,$domain)=@_;
                   5288:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   5289:         return $env{'environment.color.'.$which};
1.96      www      5290:     }
1.63      www      5291:     $domain=&determinedomain($domain);
1.1016    raeburn  5292:     my %domdesign;
                   5293:     unless ($domain eq 'public') {
                   5294:         %domdesign = &get_domainconf($domain);
                   5295:     }
1.520     raeburn  5296:     my $output;
1.517     raeburn  5297:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   5298:         $output = $domdesign{$domain.'.'.$which};
1.63      www      5299:     } else {
1.520     raeburn  5300:         $output = $defaultdesign{$which};
                   5301:     }
                   5302:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  5303:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 5304:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   5305:             if ($output =~ m{^/res/}) {
                   5306:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   5307:                 &Apache::lonnet::repcopy($local_name);
                   5308:             }
1.520     raeburn  5309:             $output = &lonhttpdurl($output);
                   5310:         }
1.63      www      5311:     }
1.520     raeburn  5312:     return $output;
1.63      www      5313: }
1.59      www      5314: 
1.822     bisitz   5315: ##############################################
                   5316: =pod
                   5317: 
1.832     bisitz   5318: =item * &authorspace()
                   5319: 
1.1028    raeburn  5320: Inputs: $url (usually will be undef).
1.832     bisitz   5321: 
1.1132    raeburn  5322: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  5323:          directory being viewed (or for which action is being taken). 
                   5324:          If $url is provided, and begins /priv/<domain>/<uname>
                   5325:          the path will be that portion of the $context argument.
                   5326:          Otherwise the path will be for the author space of the current
                   5327:          user when the current role is author, or for that of the 
                   5328:          co-author/assistant co-author space when the current role 
                   5329:          is co-author or assistant co-author.
1.832     bisitz   5330: 
                   5331: =cut
                   5332: 
                   5333: sub authorspace {
1.1028    raeburn  5334:     my ($url) = @_;
                   5335:     if ($url ne '') {
                   5336:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   5337:            return $1;
                   5338:         }
                   5339:     }
1.832     bisitz   5340:     my $caname = '';
1.1024    www      5341:     my $cadom = '';
1.1028    raeburn  5342:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      5343:         ($cadom,$caname) =
1.832     bisitz   5344:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  5345:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   5346:         $caname = $env{'user.name'};
1.1024    www      5347:         $cadom = $env{'user.domain'};
1.832     bisitz   5348:     }
1.1028    raeburn  5349:     if (($caname ne '') && ($cadom ne '')) {
                   5350:         return "/priv/$cadom/$caname/";
                   5351:     }
                   5352:     return;
1.832     bisitz   5353: }
                   5354: 
                   5355: ##############################################
                   5356: =pod
                   5357: 
1.822     bisitz   5358: =item * &head_subbox()
                   5359: 
                   5360: Inputs: $content (contains HTML code with page functions, etc.)
                   5361: 
                   5362: Returns: HTML div with $content
                   5363:          To be included in page header
                   5364: 
                   5365: =cut
                   5366: 
                   5367: sub head_subbox {
                   5368:     my ($content)=@_;
                   5369:     my $output =
1.993     raeburn  5370:         '<div class="LC_head_subbox">'
1.822     bisitz   5371:        .$content
                   5372:        .'</div>'
                   5373: }
                   5374: 
                   5375: ##############################################
                   5376: =pod
                   5377: 
                   5378: =item * &CSTR_pageheader()
                   5379: 
1.1026    raeburn  5380: Input: (optional) filename from which breadcrumb trail is built.
                   5381:        In most cases no input as needed, as $env{'request.filename'}
                   5382:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   5383: 
                   5384: Returns: HTML div with CSTR path and recent box
1.1132    raeburn  5385:          To be included on Authoring Space pages
1.822     bisitz   5386: 
                   5387: =cut
                   5388: 
                   5389: sub CSTR_pageheader {
1.1026    raeburn  5390:     my ($trailfile) = @_;
                   5391:     if ($trailfile eq '') {
                   5392:         $trailfile = $env{'request.filename'};
                   5393:     }
                   5394: 
                   5395: # this is for resources; directories have customtitle, and crumbs
                   5396: # and select recent are created in lonpubdir.pm
                   5397: 
                   5398:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      5399:     my ($udom,$uname,$thisdisfn)=
1.1113    raeburn  5400:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  5401:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   5402:     $formaction =~ s{/+}{/}g;
1.822     bisitz   5403: 
                   5404:     my $parentpath = '';
                   5405:     my $lastitem = '';
                   5406:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   5407:         $parentpath = $1;
                   5408:         $lastitem = $2;
                   5409:     } else {
                   5410:         $lastitem = $thisdisfn;
                   5411:     }
1.921     bisitz   5412: 
                   5413:     my $output =
1.822     bisitz   5414:          '<div>'
                   5415:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1132    raeburn  5416:         .'<b>'.&mt('Authoring Space:').'</b> '
1.822     bisitz   5417:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   5418:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      5419:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   5420: 
                   5421:     if ($lastitem) {
                   5422:         $output .=
                   5423:              '<span class="LC_filename">'
                   5424:             .$lastitem
                   5425:             .'</span>';
                   5426:     }
                   5427:     $output .=
                   5428:          '<br />'
1.822     bisitz   5429:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   5430:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   5431:         .'</form>'
                   5432:         .&Apache::lonmenu::constspaceform()
                   5433:         .'</div>';
1.921     bisitz   5434: 
                   5435:     return $output;
1.822     bisitz   5436: }
                   5437: 
1.60      matthew  5438: ###############################################
                   5439: ###############################################
                   5440: 
                   5441: =pod
                   5442: 
1.112     bowersj2 5443: =back
                   5444: 
1.549     albertel 5445: =head1 HTML Helpers
1.112     bowersj2 5446: 
                   5447: =over 4
                   5448: 
                   5449: =item * &bodytag()
1.60      matthew  5450: 
                   5451: Returns a uniform header for LON-CAPA web pages.
                   5452: 
                   5453: Inputs: 
                   5454: 
1.112     bowersj2 5455: =over 4
                   5456: 
                   5457: =item * $title, A title to be displayed on the page.
                   5458: 
                   5459: =item * $function, the current role (can be undef).
                   5460: 
                   5461: =item * $addentries, extra parameters for the <body> tag.
                   5462: 
                   5463: =item * $bodyonly, if defined, only return the <body> tag.
                   5464: 
                   5465: =item * $domain, if defined, force a given domain.
                   5466: 
                   5467: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5468:             text interface only)
1.60      matthew  5469: 
1.814     bisitz   5470: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5471:                      navigational links
1.317     albertel 5472: 
1.338     albertel 5473: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5474: 
1.460     albertel 5475: =item * $args, optional argument valid values are
                   5476:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 5477:             inherit_jsmath -> when creating popup window in a page,
                   5478:                               should it have jsmath forced on by the
                   5479:                               current page
1.460     albertel 5480: 
1.1096    raeburn  5481: =item * $advtoolsref, optional argument, ref to an array containing
                   5482:             inlineremote items to be added in "Functions" menu below
                   5483:             breadcrumbs.
                   5484: 
1.112     bowersj2 5485: =back
                   5486: 
1.60      matthew  5487: Returns: A uniform header for LON-CAPA web pages.  
                   5488: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5489: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5490: other decorations will be returned.
                   5491: 
                   5492: =cut
                   5493: 
1.54      www      5494: sub bodytag {
1.831     bisitz   5495:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096    raeburn  5496:         $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339     albertel 5497: 
1.954     raeburn  5498:     my $public;
                   5499:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5500:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5501:         $public = 1;
                   5502:     }
1.460     albertel 5503:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154    raeburn  5504:     my $httphost = $args->{'use_absolute'};
1.339     albertel 5505: 
1.183     matthew  5506:     $function = &get_users_function() if (!$function);
1.339     albertel 5507:     my $img =    &designparm($function.'.img',$domain);
                   5508:     my $font =   &designparm($function.'.font',$domain);
                   5509:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5510: 
1.803     bisitz   5511:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5512: 		   'bgcolor' => $pgbg,
1.339     albertel 5513: 		   'text'    => $font,
                   5514:                    'alink'   => &designparm($function.'.alink',$domain),
                   5515: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5516: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5517:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5518: 
1.63      www      5519:  # role and realm
1.1178    raeburn  5520:     my ($role,$realm) = split(m{\./},$env{'request.role'},2);
                   5521:     if ($realm) {
                   5522:         $realm = '/'.$realm;
                   5523:     }
1.378     raeburn  5524:     if ($role  eq 'ca') {
1.479     albertel 5525:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5526:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5527:     } 
1.55      www      5528: # realm
1.258     albertel 5529:     if ($env{'request.course.id'}) {
1.378     raeburn  5530:         if ($env{'request.role'} !~ /^cr/) {
                   5531:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5532:         }
1.898     raeburn  5533:         if ($env{'request.course.sec'}) {
                   5534:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5535:         }   
1.359     albertel 5536: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5537:     } else {
                   5538:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5539:     }
1.433     albertel 5540: 
1.359     albertel 5541:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5542: 
1.438     albertel 5543:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5544: 
1.101     www      5545: # construct main body tag
1.359     albertel 5546:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 5547: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 5548: 
1.1131    raeburn  5549:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5550: 
1.1130    raeburn  5551:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5552:         return $bodytag;
1.1130    raeburn  5553:     }
1.359     albertel 5554: 
1.954     raeburn  5555:     if ($public) {
1.433     albertel 5556: 	undef($role);
                   5557:     }
1.359     albertel 5558:     
1.762     bisitz   5559:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5560:     #
                   5561:     # Extra info if you are the DC
                   5562:     my $dc_info = '';
                   5563:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5564:                         $env{'course.'.$env{'request.course.id'}.
                   5565:                                  '.domain'}.'/'})) {
                   5566:         my $cid = $env{'request.course.id'};
1.917     raeburn  5567:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5568:         $dc_info =~ s/\s+$//;
1.359     albertel 5569:     }
                   5570: 
1.898     raeburn  5571:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853     droeschl 5572: 
1.903     droeschl 5573:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5574: 
                   5575:         #    if ($env{'request.state'} eq 'construct') {
                   5576:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5577:         #    }
                   5578: 
1.1130    raeburn  5579:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154    raeburn  5580:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 5581: 
1.1130    raeburn  5582:         my ($left,$right) = Apache::lonmenu::primary_menu();
1.359     albertel 5583: 
1.916     droeschl 5584:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917     raeburn  5585:              if ($dc_info) {
                   5586:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   5587:              }
1.1130    raeburn  5588:              $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916     droeschl 5589:                 <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5590:             return $bodytag;
                   5591:         }
1.894     droeschl 5592: 
1.927     raeburn  5593:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130    raeburn  5594:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5595:         }
1.916     droeschl 5596: 
1.1130    raeburn  5597:         $bodytag .= $right;
1.852     droeschl 5598: 
1.917     raeburn  5599:         if ($dc_info) {
                   5600:             $dc_info = &dc_courseid_toggle($dc_info);
                   5601:         }
                   5602:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5603: 
1.1169    raeburn  5604:         #if directed to not display the secondary menu, don't.  
1.1168    raeburn  5605:         if ($args->{'no_secondary_menu'}) {
                   5606:             return $bodytag;
                   5607:         }
1.1169    raeburn  5608:         #don't show menus for public users
1.954     raeburn  5609:         if (!$public){
1.1154    raeburn  5610:             $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903     droeschl 5611:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5612:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5613:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5614:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5615:                                 $args->{'bread_crumbs'});
1.1096    raeburn  5616:             } elsif ($forcereg) {
                   5617:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                   5618:                                                             $args->{'group'});
                   5619:             } else {
                   5620:                 $bodytag .= 
                   5621:                     &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5622:                                                         $forcereg,$args->{'group'},
                   5623:                                                         $args->{'bread_crumbs'},
                   5624:                                                         $advtoolsref);
1.920     raeburn  5625:             }
1.903     droeschl 5626:         }else{
                   5627:             # this is to seperate menu from content when there's no secondary
                   5628:             # menu. Especially needed for public accessible ressources.
                   5629:             $bodytag .= '<hr style="clear:both" />';
                   5630:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5631:         }
1.903     droeschl 5632: 
1.235     raeburn  5633:         return $bodytag;
1.182     matthew  5634: }
                   5635: 
1.917     raeburn  5636: sub dc_courseid_toggle {
                   5637:     my ($dc_info) = @_;
1.980     raeburn  5638:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5639:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5640:            &mt('(More ...)').'</a></span>'.
                   5641:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5642: }
                   5643: 
1.330     albertel 5644: sub make_attr_string {
                   5645:     my ($register,$attr_ref) = @_;
                   5646: 
                   5647:     if ($attr_ref && !ref($attr_ref)) {
                   5648: 	die("addentries Must be a hash ref ".
                   5649: 	    join(':',caller(1))." ".
                   5650: 	    join(':',caller(0))." ");
                   5651:     }
                   5652: 
                   5653:     if ($register) {
1.339     albertel 5654: 	my ($on_load,$on_unload);
                   5655: 	foreach my $key (keys(%{$attr_ref})) {
                   5656: 	    if      (lc($key) eq 'onload') {
                   5657: 		$on_load.=$attr_ref->{$key}.';';
                   5658: 		delete($attr_ref->{$key});
                   5659: 
                   5660: 	    } elsif (lc($key) eq 'onunload') {
                   5661: 		$on_unload.=$attr_ref->{$key}.';';
                   5662: 		delete($attr_ref->{$key});
                   5663: 	    }
                   5664: 	}
1.953     droeschl 5665: 	$attr_ref->{'onload'}  = $on_load;
                   5666: 	$attr_ref->{'onunload'}= $on_unload;
1.330     albertel 5667:     }
1.339     albertel 5668: 
1.330     albertel 5669:     my $attr_string;
1.1159    raeburn  5670:     foreach my $attr (sort(keys(%$attr_ref))) {
1.330     albertel 5671: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5672:     }
                   5673:     return $attr_string;
                   5674: }
                   5675: 
                   5676: 
1.182     matthew  5677: ###############################################
1.251     albertel 5678: ###############################################
                   5679: 
                   5680: =pod
                   5681: 
                   5682: =item * &endbodytag()
                   5683: 
                   5684: Returns a uniform footer for LON-CAPA web pages.
                   5685: 
1.635     raeburn  5686: Inputs: 1 - optional reference to an args hash
                   5687: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5688: a 'Continue' link is not displayed if the page contains an
                   5689: internal redirect in the <head></head> section,
                   5690: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5691: 
                   5692: =cut
                   5693: 
                   5694: sub endbodytag {
1.635     raeburn  5695:     my ($args) = @_;
1.1080    raeburn  5696:     my $endbodytag;
                   5697:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5698:         $endbodytag='</body>';
                   5699:     }
1.269     albertel 5700:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 5701:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5702:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5703: 	    $endbodytag=
                   5704: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5705: 	        &mt('Continue').'</a>'.
                   5706: 	        $endbodytag;
                   5707:         }
1.315     albertel 5708:     }
1.251     albertel 5709:     return $endbodytag;
                   5710: }
                   5711: 
1.352     albertel 5712: =pod
                   5713: 
                   5714: =item * &standard_css()
                   5715: 
                   5716: Returns a style sheet
                   5717: 
                   5718: Inputs: (all optional)
                   5719:             domain         -> force to color decorate a page for a specific
                   5720:                                domain
                   5721:             function       -> force usage of a specific rolish color scheme
                   5722:             bgcolor        -> override the default page bgcolor
                   5723: 
                   5724: =cut
                   5725: 
1.343     albertel 5726: sub standard_css {
1.345     albertel 5727:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5728:     $function  = &get_users_function() if (!$function);
                   5729:     my $img    = &designparm($function.'.img',   $domain);
                   5730:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5731:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5732:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5733: #second colour for later usage
1.345     albertel 5734:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5735:     my $pgbg_or_bgcolor =
                   5736: 	         $bgcolor ||
1.352     albertel 5737: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5738:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5739:     my $alink  = &designparm($function.'.alink', $domain);
                   5740:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5741:     my $link   = &designparm($function.'.link',  $domain);
                   5742: 
1.602     albertel 5743:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5744:     my $mono                 = 'monospace';
1.850     bisitz   5745:     my $data_table_head      = $sidebg;
                   5746:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5747:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5748:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5749:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5750:     my $mail_new             = '#FFBB77';
                   5751:     my $mail_new_hover       = '#DD9955';
                   5752:     my $mail_read            = '#BBBB77';
                   5753:     my $mail_read_hover      = '#999944';
                   5754:     my $mail_replied         = '#AAAA88';
                   5755:     my $mail_replied_hover   = '#888855';
                   5756:     my $mail_other           = '#99BBBB';
                   5757:     my $mail_other_hover     = '#669999';
1.391     albertel 5758:     my $table_header         = '#DDDDDD';
1.489     raeburn  5759:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5760:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5761:     my $button_hover         = '#BF2317';
1.392     albertel 5762: 
1.608     albertel 5763:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5764:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5765:                                              : '0 3px 0 4px';
1.448     albertel 5766: 
1.523     albertel 5767: 
1.343     albertel 5768:     return <<END;
1.947     droeschl 5769: 
                   5770: /* needed for iframe to allow 100% height in FF */
                   5771: body, html { 
                   5772:     margin: 0;
                   5773:     padding: 0 0.5%;
                   5774:     height: 99%; /* to avoid scrollbars */
                   5775: }
                   5776: 
1.795     www      5777: body {
1.911     bisitz   5778:   font-family: $sans;
                   5779:   line-height:130%;
                   5780:   font-size:0.83em;
                   5781:   color:$font;
1.795     www      5782: }
                   5783: 
1.959     onken    5784: a:focus,
                   5785: a:focus img {
1.795     www      5786:   color: red;
                   5787: }
1.698     harmsja  5788: 
1.911     bisitz   5789: form, .inline {
                   5790:   display: inline;
1.795     www      5791: }
1.721     harmsja  5792: 
1.795     www      5793: .LC_right {
1.911     bisitz   5794:   text-align:right;
1.795     www      5795: }
                   5796: 
                   5797: .LC_middle {
1.911     bisitz   5798:   vertical-align:middle;
1.795     www      5799: }
1.721     harmsja  5800: 
1.1130    raeburn  5801: .LC_floatleft {
                   5802:   float: left;
                   5803: }
                   5804: 
                   5805: .LC_floatright {
                   5806:   float: right;
                   5807: }
                   5808: 
1.911     bisitz   5809: .LC_400Box {
                   5810:   width:400px;
                   5811: }
1.721     harmsja  5812: 
1.947     droeschl 5813: .LC_iframecontainer {
                   5814:     width: 98%;
                   5815:     margin: 0;
                   5816:     position: fixed;
                   5817:     top: 8.5em;
                   5818:     bottom: 0;
                   5819: }
                   5820: 
                   5821: .LC_iframecontainer iframe{
                   5822:     border: none;
                   5823:     width: 100%;
                   5824:     height: 100%;
                   5825: }
                   5826: 
1.778     bisitz   5827: .LC_filename {
                   5828:   font-family: $mono;
                   5829:   white-space:pre;
1.921     bisitz   5830:   font-size: 120%;
1.778     bisitz   5831: }
                   5832: 
                   5833: .LC_fileicon {
                   5834:   border: none;
                   5835:   height: 1.3em;
                   5836:   vertical-align: text-bottom;
                   5837:   margin-right: 0.3em;
                   5838:   text-decoration:none;
                   5839: }
                   5840: 
1.1008    www      5841: .LC_setting {
                   5842:   text-decoration:underline;
                   5843: }
                   5844: 
1.350     albertel 5845: .LC_error {
                   5846:   color: red;
                   5847: }
1.795     www      5848: 
1.1097    bisitz   5849: .LC_warning {
                   5850:   color: darkorange;
                   5851: }
                   5852: 
1.457     albertel 5853: .LC_diff_removed {
1.733     bisitz   5854:   color: red;
1.394     albertel 5855: }
1.532     albertel 5856: 
                   5857: .LC_info,
1.457     albertel 5858: .LC_success,
                   5859: .LC_diff_added {
1.350     albertel 5860:   color: green;
                   5861: }
1.795     www      5862: 
1.802     bisitz   5863: div.LC_confirm_box {
                   5864:   background-color: #FAFAFA;
                   5865:   border: 1px solid $lg_border_color;
                   5866:   margin-right: 0;
                   5867:   padding: 5px;
                   5868: }
                   5869: 
                   5870: div.LC_confirm_box .LC_error img,
                   5871: div.LC_confirm_box .LC_success img {
                   5872:   vertical-align: middle;
                   5873: }
                   5874: 
1.440     albertel 5875: .LC_icon {
1.771     droeschl 5876:   border: none;
1.790     droeschl 5877:   vertical-align: middle;
1.771     droeschl 5878: }
                   5879: 
1.543     albertel 5880: .LC_docs_spacer {
                   5881:   width: 25px;
                   5882:   height: 1px;
1.771     droeschl 5883:   border: none;
1.543     albertel 5884: }
1.346     albertel 5885: 
1.532     albertel 5886: .LC_internal_info {
1.735     bisitz   5887:   color: #999999;
1.532     albertel 5888: }
                   5889: 
1.794     www      5890: .LC_discussion {
1.1050    www      5891:   background: $data_table_dark;
1.911     bisitz   5892:   border: 1px solid black;
                   5893:   margin: 2px;
1.794     www      5894: }
                   5895: 
                   5896: .LC_disc_action_left {
1.1050    www      5897:   background: $sidebg;
1.911     bisitz   5898:   text-align: left;
1.1050    www      5899:   padding: 4px;
                   5900:   margin: 2px;
1.794     www      5901: }
                   5902: 
                   5903: .LC_disc_action_right {
1.1050    www      5904:   background: $sidebg;
1.911     bisitz   5905:   text-align: right;
1.1050    www      5906:   padding: 4px;
                   5907:   margin: 2px;
1.794     www      5908: }
                   5909: 
                   5910: .LC_disc_new_item {
1.911     bisitz   5911:   background: white;
                   5912:   border: 2px solid red;
1.1050    www      5913:   margin: 4px;
                   5914:   padding: 4px;
1.794     www      5915: }
                   5916: 
                   5917: .LC_disc_old_item {
1.911     bisitz   5918:   background: white;
1.1050    www      5919:   margin: 4px;
                   5920:   padding: 4px;
1.794     www      5921: }
                   5922: 
1.458     albertel 5923: table.LC_pastsubmission {
                   5924:   border: 1px solid black;
                   5925:   margin: 2px;
                   5926: }
                   5927: 
1.924     bisitz   5928: table#LC_menubuttons {
1.345     albertel 5929:   width: 100%;
                   5930:   background: $pgbg;
1.392     albertel 5931:   border: 2px;
1.402     albertel 5932:   border-collapse: separate;
1.803     bisitz   5933:   padding: 0;
1.345     albertel 5934: }
1.392     albertel 5935: 
1.801     tempelho 5936: table#LC_title_bar a {
                   5937:   color: $fontmenu;
                   5938: }
1.836     bisitz   5939: 
1.807     droeschl 5940: table#LC_title_bar {
1.819     tempelho 5941:   clear: both;
1.836     bisitz   5942:   display: none;
1.807     droeschl 5943: }
                   5944: 
1.795     www      5945: table#LC_title_bar,
1.933     droeschl 5946: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5947: table#LC_title_bar.LC_with_remote {
1.359     albertel 5948:   width: 100%;
1.392     albertel 5949:   border-color: $pgbg;
                   5950:   border-style: solid;
                   5951:   border-width: $border;
1.379     albertel 5952:   background: $pgbg;
1.801     tempelho 5953:   color: $fontmenu;
1.392     albertel 5954:   border-collapse: collapse;
1.803     bisitz   5955:   padding: 0;
1.819     tempelho 5956:   margin: 0;
1.359     albertel 5957: }
1.795     www      5958: 
1.933     droeschl 5959: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5960:     margin: 0;
                   5961:     padding: 0;
1.933     droeschl 5962:     position: relative;
                   5963:     list-style: none;
1.913     droeschl 5964: }
1.933     droeschl 5965: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5966:     display: inline;
                   5967: }
1.933     droeschl 5968: 
                   5969: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5970:     padding: 0;
1.933     droeschl 5971:     margin: 0;
                   5972:     float: left;
1.913     droeschl 5973: }
1.933     droeschl 5974: .LC_breadcrumb_tools_tools {
                   5975:     padding: 0;
                   5976:     margin: 0;
1.913     droeschl 5977:     float: right;
                   5978: }
                   5979: 
1.359     albertel 5980: table#LC_title_bar td {
                   5981:   background: $tabbg;
                   5982: }
1.795     www      5983: 
1.911     bisitz   5984: table#LC_menubuttons img {
1.803     bisitz   5985:   border: none;
1.346     albertel 5986: }
1.795     www      5987: 
1.842     droeschl 5988: .LC_breadcrumbs_component {
1.911     bisitz   5989:   float: right;
                   5990:   margin: 0 1em;
1.357     albertel 5991: }
1.842     droeschl 5992: .LC_breadcrumbs_component img {
1.911     bisitz   5993:   vertical-align: middle;
1.777     tempelho 5994: }
1.795     www      5995: 
1.383     albertel 5996: td.LC_table_cell_checkbox {
                   5997:   text-align: center;
                   5998: }
1.795     www      5999: 
                   6000: .LC_fontsize_small {
1.911     bisitz   6001:   font-size: 70%;
1.705     tempelho 6002: }
                   6003: 
1.844     bisitz   6004: #LC_breadcrumbs {
1.911     bisitz   6005:   clear:both;
                   6006:   background: $sidebg;
                   6007:   border-bottom: 1px solid $lg_border_color;
                   6008:   line-height: 2.5em;
1.933     droeschl 6009:   overflow: hidden;
1.911     bisitz   6010:   margin: 0;
                   6011:   padding: 0;
1.995     raeburn  6012:   text-align: left;
1.819     tempelho 6013: }
1.862     bisitz   6014: 
1.1098    bisitz   6015: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   6016:   clear:both;
                   6017:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 6018:   border: 1px solid $sidebg;
1.1098    bisitz   6019:   margin: 0 0 10px 0;
1.966     bisitz   6020:   padding: 3px;
1.995     raeburn  6021:   text-align: left;
1.822     bisitz   6022: }
                   6023: 
1.795     www      6024: .LC_fontsize_medium {
1.911     bisitz   6025:   font-size: 85%;
1.705     tempelho 6026: }
                   6027: 
1.795     www      6028: .LC_fontsize_large {
1.911     bisitz   6029:   font-size: 120%;
1.705     tempelho 6030: }
                   6031: 
1.346     albertel 6032: .LC_menubuttons_inline_text {
                   6033:   color: $font;
1.698     harmsja  6034:   font-size: 90%;
1.701     harmsja  6035:   padding-left:3px;
1.346     albertel 6036: }
                   6037: 
1.934     droeschl 6038: .LC_menubuttons_inline_text img{
                   6039:   vertical-align: middle;
                   6040: }
                   6041: 
1.1051    www      6042: li.LC_menubuttons_inline_text img {
1.951     onken    6043:   cursor:pointer;
1.1002    droeschl 6044:   text-decoration: none;
1.951     onken    6045: }
                   6046: 
1.526     www      6047: .LC_menubuttons_link {
                   6048:   text-decoration: none;
                   6049: }
1.795     www      6050: 
1.522     albertel 6051: .LC_menubuttons_category {
1.521     www      6052:   color: $font;
1.526     www      6053:   background: $pgbg;
1.521     www      6054:   font-size: larger;
                   6055:   font-weight: bold;
                   6056: }
                   6057: 
1.346     albertel 6058: td.LC_menubuttons_text {
1.911     bisitz   6059:   color: $font;
1.346     albertel 6060: }
1.706     harmsja  6061: 
1.346     albertel 6062: .LC_current_location {
                   6063:   background: $tabbg;
                   6064: }
1.795     www      6065: 
1.938     bisitz   6066: table.LC_data_table {
1.347     albertel 6067:   border: 1px solid #000000;
1.402     albertel 6068:   border-collapse: separate;
1.426     albertel 6069:   border-spacing: 1px;
1.610     albertel 6070:   background: $pgbg;
1.347     albertel 6071: }
1.795     www      6072: 
1.422     albertel 6073: .LC_data_table_dense {
                   6074:   font-size: small;
                   6075: }
1.795     www      6076: 
1.507     raeburn  6077: table.LC_nested_outer {
                   6078:   border: 1px solid #000000;
1.589     raeburn  6079:   border-collapse: collapse;
1.803     bisitz   6080:   border-spacing: 0;
1.507     raeburn  6081:   width: 100%;
                   6082: }
1.795     www      6083: 
1.879     raeburn  6084: table.LC_innerpickbox,
1.507     raeburn  6085: table.LC_nested {
1.803     bisitz   6086:   border: none;
1.589     raeburn  6087:   border-collapse: collapse;
1.803     bisitz   6088:   border-spacing: 0;
1.507     raeburn  6089:   width: 100%;
                   6090: }
1.795     www      6091: 
1.911     bisitz   6092: table.LC_data_table tr th,
                   6093: table.LC_calendar tr th,
1.879     raeburn  6094: table.LC_prior_tries tr th,
                   6095: table.LC_innerpickbox tr th {
1.349     albertel 6096:   font-weight: bold;
                   6097:   background-color: $data_table_head;
1.801     tempelho 6098:   color:$fontmenu;
1.701     harmsja  6099:   font-size:90%;
1.347     albertel 6100: }
1.795     www      6101: 
1.879     raeburn  6102: table.LC_innerpickbox tr th,
                   6103: table.LC_innerpickbox tr td {
                   6104:   vertical-align: top;
                   6105: }
                   6106: 
1.711     raeburn  6107: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   6108:   background-color: #CCCCCC;
1.711     raeburn  6109:   font-weight: bold;
                   6110:   text-align: left;
                   6111: }
1.795     www      6112: 
1.912     bisitz   6113: table.LC_data_table tr.LC_odd_row > td {
                   6114:   background-color: $data_table_light;
                   6115:   padding: 2px;
                   6116:   vertical-align: top;
                   6117: }
                   6118: 
1.809     bisitz   6119: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 6120:   background-color: $data_table_light;
1.912     bisitz   6121:   vertical-align: top;
                   6122: }
                   6123: 
                   6124: table.LC_data_table tr.LC_even_row > td {
                   6125:   background-color: $data_table_dark;
1.425     albertel 6126:   padding: 2px;
1.900     bisitz   6127:   vertical-align: top;
1.347     albertel 6128: }
1.795     www      6129: 
1.809     bisitz   6130: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 6131:   background-color: $data_table_dark;
1.900     bisitz   6132:   vertical-align: top;
1.347     albertel 6133: }
1.795     www      6134: 
1.425     albertel 6135: table.LC_data_table tr.LC_data_table_highlight td {
                   6136:   background-color: $data_table_darker;
                   6137: }
1.795     www      6138: 
1.639     raeburn  6139: table.LC_data_table tr td.LC_leftcol_header {
                   6140:   background-color: $data_table_head;
                   6141:   font-weight: bold;
                   6142: }
1.795     www      6143: 
1.451     albertel 6144: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  6145: table.LC_nested tr.LC_empty_row td {
1.421     albertel 6146:   font-weight: bold;
                   6147:   font-style: italic;
                   6148:   text-align: center;
                   6149:   padding: 8px;
1.347     albertel 6150: }
1.795     www      6151: 
1.1114    raeburn  6152: table.LC_data_table tr.LC_empty_row td,
                   6153: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   6154:   background-color: $sidebg;
                   6155: }
                   6156: 
                   6157: table.LC_nested tr.LC_empty_row td {
                   6158:   background-color: #FFFFFF;
                   6159: }
                   6160: 
1.890     droeschl 6161: table.LC_caption {
                   6162: }
                   6163: 
1.507     raeburn  6164: table.LC_nested tr.LC_empty_row td {
1.465     albertel 6165:   padding: 4ex
                   6166: }
1.795     www      6167: 
1.507     raeburn  6168: table.LC_nested_outer tr th {
                   6169:   font-weight: bold;
1.801     tempelho 6170:   color:$fontmenu;
1.507     raeburn  6171:   background-color: $data_table_head;
1.701     harmsja  6172:   font-size: small;
1.507     raeburn  6173:   border-bottom: 1px solid #000000;
                   6174: }
1.795     www      6175: 
1.507     raeburn  6176: table.LC_nested_outer tr td.LC_subheader {
                   6177:   background-color: $data_table_head;
                   6178:   font-weight: bold;
                   6179:   font-size: small;
                   6180:   border-bottom: 1px solid #000000;
                   6181:   text-align: right;
1.451     albertel 6182: }
1.795     www      6183: 
1.507     raeburn  6184: table.LC_nested tr.LC_info_row td {
1.735     bisitz   6185:   background-color: #CCCCCC;
1.451     albertel 6186:   font-weight: bold;
                   6187:   font-size: small;
1.507     raeburn  6188:   text-align: center;
                   6189: }
1.795     www      6190: 
1.589     raeburn  6191: table.LC_nested tr.LC_info_row td.LC_left_item,
                   6192: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  6193:   text-align: left;
1.451     albertel 6194: }
1.795     www      6195: 
1.507     raeburn  6196: table.LC_nested td {
1.735     bisitz   6197:   background-color: #FFFFFF;
1.451     albertel 6198:   font-size: small;
1.507     raeburn  6199: }
1.795     www      6200: 
1.507     raeburn  6201: table.LC_nested_outer tr th.LC_right_item,
                   6202: table.LC_nested tr.LC_info_row td.LC_right_item,
                   6203: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   6204: table.LC_nested tr td.LC_right_item {
1.451     albertel 6205:   text-align: right;
                   6206: }
                   6207: 
1.507     raeburn  6208: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   6209:   background-color: #EEEEEE;
1.451     albertel 6210: }
                   6211: 
1.473     raeburn  6212: table.LC_createuser {
                   6213: }
                   6214: 
                   6215: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  6216:   font-size: small;
1.473     raeburn  6217: }
                   6218: 
                   6219: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   6220:   background-color: #CCCCCC;
1.473     raeburn  6221:   font-weight: bold;
                   6222:   text-align: center;
                   6223: }
                   6224: 
1.349     albertel 6225: table.LC_calendar {
                   6226:   border: 1px solid #000000;
                   6227:   border-collapse: collapse;
1.917     raeburn  6228:   width: 98%;
1.349     albertel 6229: }
1.795     www      6230: 
1.349     albertel 6231: table.LC_calendar_pickdate {
                   6232:   font-size: xx-small;
                   6233: }
1.795     www      6234: 
1.349     albertel 6235: table.LC_calendar tr td {
                   6236:   border: 1px solid #000000;
                   6237:   vertical-align: top;
1.917     raeburn  6238:   width: 14%;
1.349     albertel 6239: }
1.795     www      6240: 
1.349     albertel 6241: table.LC_calendar tr td.LC_calendar_day_empty {
                   6242:   background-color: $data_table_dark;
                   6243: }
1.795     www      6244: 
1.779     bisitz   6245: table.LC_calendar tr td.LC_calendar_day_current {
                   6246:   background-color: $data_table_highlight;
1.777     tempelho 6247: }
1.795     www      6248: 
1.938     bisitz   6249: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 6250:   background-color: $mail_new;
                   6251: }
1.795     www      6252: 
1.938     bisitz   6253: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 6254:   background-color: $mail_new_hover;
                   6255: }
1.795     www      6256: 
1.938     bisitz   6257: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 6258:   background-color: $mail_read;
                   6259: }
1.795     www      6260: 
1.938     bisitz   6261: /*
                   6262: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 6263:   background-color: $mail_read_hover;
                   6264: }
1.938     bisitz   6265: */
1.795     www      6266: 
1.938     bisitz   6267: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 6268:   background-color: $mail_replied;
                   6269: }
1.795     www      6270: 
1.938     bisitz   6271: /*
                   6272: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 6273:   background-color: $mail_replied_hover;
                   6274: }
1.938     bisitz   6275: */
1.795     www      6276: 
1.938     bisitz   6277: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 6278:   background-color: $mail_other;
                   6279: }
1.795     www      6280: 
1.938     bisitz   6281: /*
                   6282: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 6283:   background-color: $mail_other_hover;
                   6284: }
1.938     bisitz   6285: */
1.494     raeburn  6286: 
1.777     tempelho 6287: table.LC_data_table tr > td.LC_browser_file,
                   6288: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   6289:   background: #AAEE77;
1.389     albertel 6290: }
1.795     www      6291: 
1.777     tempelho 6292: table.LC_data_table tr > td.LC_browser_file_locked,
                   6293: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 6294:   background: #FFAA99;
1.387     albertel 6295: }
1.795     www      6296: 
1.777     tempelho 6297: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   6298:   background: #888888;
1.779     bisitz   6299: }
1.795     www      6300: 
1.777     tempelho 6301: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   6302: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   6303:   background: #F8F866;
1.777     tempelho 6304: }
1.795     www      6305: 
1.696     bisitz   6306: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   6307:   background: #E0E8FF;
1.387     albertel 6308: }
1.696     bisitz   6309: 
1.707     bisitz   6310: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   6311:   /* background: #77FF77; */
1.707     bisitz   6312: }
1.795     www      6313: 
1.707     bisitz   6314: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   6315:   border-right: 8px solid #FFFF77;
1.707     bisitz   6316: }
1.795     www      6317: 
1.707     bisitz   6318: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   6319:   border-right: 8px solid #FFAA77;
1.707     bisitz   6320: }
1.795     www      6321: 
1.707     bisitz   6322: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   6323:   border-right: 8px solid #FF7777;
1.707     bisitz   6324: }
1.795     www      6325: 
1.707     bisitz   6326: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   6327:   border-right: 8px solid #AAFF77;
1.707     bisitz   6328: }
1.795     www      6329: 
1.707     bisitz   6330: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   6331:   border-right: 8px solid #11CC55;
1.707     bisitz   6332: }
                   6333: 
1.388     albertel 6334: span.LC_current_location {
1.701     harmsja  6335:   font-size:larger;
1.388     albertel 6336:   background: $pgbg;
                   6337: }
1.387     albertel 6338: 
1.1029    www      6339: span.LC_current_nav_location {
                   6340:   font-weight:bold;
                   6341:   background: $sidebg;
                   6342: }
                   6343: 
1.395     albertel 6344: span.LC_parm_menu_item {
                   6345:   font-size: larger;
                   6346: }
1.795     www      6347: 
1.395     albertel 6348: span.LC_parm_scope_all {
                   6349:   color: red;
                   6350: }
1.795     www      6351: 
1.395     albertel 6352: span.LC_parm_scope_folder {
                   6353:   color: green;
                   6354: }
1.795     www      6355: 
1.395     albertel 6356: span.LC_parm_scope_resource {
                   6357:   color: orange;
                   6358: }
1.795     www      6359: 
1.395     albertel 6360: span.LC_parm_part {
                   6361:   color: blue;
                   6362: }
1.795     www      6363: 
1.911     bisitz   6364: span.LC_parm_folder,
                   6365: span.LC_parm_symb {
1.395     albertel 6366:   font-size: x-small;
                   6367:   font-family: $mono;
                   6368:   color: #AAAAAA;
                   6369: }
                   6370: 
1.977     bisitz   6371: ul.LC_parm_parmlist li {
                   6372:   display: inline-block;
                   6373:   padding: 0.3em 0.8em;
                   6374:   vertical-align: top;
                   6375:   width: 150px;
                   6376:   border-top:1px solid $lg_border_color;
                   6377: }
                   6378: 
1.795     www      6379: td.LC_parm_overview_level_menu,
                   6380: td.LC_parm_overview_map_menu,
                   6381: td.LC_parm_overview_parm_selectors,
                   6382: td.LC_parm_overview_restrictions  {
1.396     albertel 6383:   border: 1px solid black;
                   6384:   border-collapse: collapse;
                   6385: }
1.795     www      6386: 
1.396     albertel 6387: table.LC_parm_overview_restrictions td {
                   6388:   border-width: 1px 4px 1px 4px;
                   6389:   border-style: solid;
                   6390:   border-color: $pgbg;
                   6391:   text-align: center;
                   6392: }
1.795     www      6393: 
1.396     albertel 6394: table.LC_parm_overview_restrictions th {
                   6395:   background: $tabbg;
                   6396:   border-width: 1px 4px 1px 4px;
                   6397:   border-style: solid;
                   6398:   border-color: $pgbg;
                   6399: }
1.795     www      6400: 
1.398     albertel 6401: table#LC_helpmenu {
1.803     bisitz   6402:   border: none;
1.398     albertel 6403:   height: 55px;
1.803     bisitz   6404:   border-spacing: 0;
1.398     albertel 6405: }
                   6406: 
                   6407: table#LC_helpmenu fieldset legend {
                   6408:   font-size: larger;
                   6409: }
1.795     www      6410: 
1.397     albertel 6411: table#LC_helpmenu_links {
                   6412:   width: 100%;
                   6413:   border: 1px solid black;
                   6414:   background: $pgbg;
1.803     bisitz   6415:   padding: 0;
1.397     albertel 6416:   border-spacing: 1px;
                   6417: }
1.795     www      6418: 
1.397     albertel 6419: table#LC_helpmenu_links tr td {
                   6420:   padding: 1px;
                   6421:   background: $tabbg;
1.399     albertel 6422:   text-align: center;
                   6423:   font-weight: bold;
1.397     albertel 6424: }
1.396     albertel 6425: 
1.795     www      6426: table#LC_helpmenu_links a:link,
                   6427: table#LC_helpmenu_links a:visited,
1.397     albertel 6428: table#LC_helpmenu_links a:active {
                   6429:   text-decoration: none;
                   6430:   color: $font;
                   6431: }
1.795     www      6432: 
1.397     albertel 6433: table#LC_helpmenu_links a:hover {
                   6434:   text-decoration: underline;
                   6435:   color: $vlink;
                   6436: }
1.396     albertel 6437: 
1.417     albertel 6438: .LC_chrt_popup_exists {
                   6439:   border: 1px solid #339933;
                   6440:   margin: -1px;
                   6441: }
1.795     www      6442: 
1.417     albertel 6443: .LC_chrt_popup_up {
                   6444:   border: 1px solid yellow;
                   6445:   margin: -1px;
                   6446: }
1.795     www      6447: 
1.417     albertel 6448: .LC_chrt_popup {
                   6449:   border: 1px solid #8888FF;
                   6450:   background: #CCCCFF;
                   6451: }
1.795     www      6452: 
1.421     albertel 6453: table.LC_pick_box {
                   6454:   border-collapse: separate;
                   6455:   background: white;
                   6456:   border: 1px solid black;
                   6457:   border-spacing: 1px;
                   6458: }
1.795     www      6459: 
1.421     albertel 6460: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6461:   background: $sidebg;
1.421     albertel 6462:   font-weight: bold;
1.900     bisitz   6463:   text-align: left;
1.740     bisitz   6464:   vertical-align: top;
1.421     albertel 6465:   width: 184px;
                   6466:   padding: 8px;
                   6467: }
1.795     www      6468: 
1.579     raeburn  6469: table.LC_pick_box td.LC_pick_box_value {
                   6470:   text-align: left;
                   6471:   padding: 8px;
                   6472: }
1.795     www      6473: 
1.579     raeburn  6474: table.LC_pick_box td.LC_pick_box_select {
                   6475:   text-align: left;
                   6476:   padding: 8px;
                   6477: }
1.795     www      6478: 
1.424     albertel 6479: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6480:   padding: 0;
1.421     albertel 6481:   height: 1px;
                   6482:   background: black;
                   6483: }
1.795     www      6484: 
1.421     albertel 6485: table.LC_pick_box td.LC_pick_box_submit {
                   6486:   text-align: right;
                   6487: }
1.795     www      6488: 
1.579     raeburn  6489: table.LC_pick_box td.LC_evenrow_value {
                   6490:   text-align: left;
                   6491:   padding: 8px;
                   6492:   background-color: $data_table_light;
                   6493: }
1.795     www      6494: 
1.579     raeburn  6495: table.LC_pick_box td.LC_oddrow_value {
                   6496:   text-align: left;
                   6497:   padding: 8px;
                   6498:   background-color: $data_table_light;
                   6499: }
1.795     www      6500: 
1.579     raeburn  6501: span.LC_helpform_receipt_cat {
                   6502:   font-weight: bold;
                   6503: }
1.795     www      6504: 
1.424     albertel 6505: table.LC_group_priv_box {
                   6506:   background: white;
                   6507:   border: 1px solid black;
                   6508:   border-spacing: 1px;
                   6509: }
1.795     www      6510: 
1.424     albertel 6511: table.LC_group_priv_box td.LC_pick_box_title {
                   6512:   background: $tabbg;
                   6513:   font-weight: bold;
                   6514:   text-align: right;
                   6515:   width: 184px;
                   6516: }
1.795     www      6517: 
1.424     albertel 6518: table.LC_group_priv_box td.LC_groups_fixed {
                   6519:   background: $data_table_light;
                   6520:   text-align: center;
                   6521: }
1.795     www      6522: 
1.424     albertel 6523: table.LC_group_priv_box td.LC_groups_optional {
                   6524:   background: $data_table_dark;
                   6525:   text-align: center;
                   6526: }
1.795     www      6527: 
1.424     albertel 6528: table.LC_group_priv_box td.LC_groups_functionality {
                   6529:   background: $data_table_darker;
                   6530:   text-align: center;
                   6531:   font-weight: bold;
                   6532: }
1.795     www      6533: 
1.424     albertel 6534: table.LC_group_priv td {
                   6535:   text-align: left;
1.803     bisitz   6536:   padding: 0;
1.424     albertel 6537: }
                   6538: 
                   6539: .LC_navbuttons {
                   6540:   margin: 2ex 0ex 2ex 0ex;
                   6541: }
1.795     www      6542: 
1.423     albertel 6543: .LC_topic_bar {
                   6544:   font-weight: bold;
                   6545:   background: $tabbg;
1.918     wenzelju 6546:   margin: 1em 0em 1em 2em;
1.805     bisitz   6547:   padding: 3px;
1.918     wenzelju 6548:   font-size: 1.2em;
1.423     albertel 6549: }
1.795     www      6550: 
1.423     albertel 6551: .LC_topic_bar span {
1.918     wenzelju 6552:   left: 0.5em;
                   6553:   position: absolute;
1.423     albertel 6554:   vertical-align: middle;
1.918     wenzelju 6555:   font-size: 1.2em;
1.423     albertel 6556: }
1.795     www      6557: 
1.423     albertel 6558: table.LC_course_group_status {
                   6559:   margin: 20px;
                   6560: }
1.795     www      6561: 
1.423     albertel 6562: table.LC_status_selector td {
                   6563:   vertical-align: top;
                   6564:   text-align: center;
1.424     albertel 6565:   padding: 4px;
                   6566: }
1.795     www      6567: 
1.599     albertel 6568: div.LC_feedback_link {
1.616     albertel 6569:   clear: both;
1.829     kalberla 6570:   background: $sidebg;
1.779     bisitz   6571:   width: 100%;
1.829     kalberla 6572:   padding-bottom: 10px;
                   6573:   border: 1px $tabbg solid;
1.833     kalberla 6574:   height: 22px;
                   6575:   line-height: 22px;
                   6576:   padding-top: 5px;
                   6577: }
                   6578: 
                   6579: div.LC_feedback_link img {
                   6580:   height: 22px;
1.867     kalberla 6581:   vertical-align:middle;
1.829     kalberla 6582: }
                   6583: 
1.911     bisitz   6584: div.LC_feedback_link a {
1.829     kalberla 6585:   text-decoration: none;
1.489     raeburn  6586: }
1.795     www      6587: 
1.867     kalberla 6588: div.LC_comblock {
1.911     bisitz   6589:   display:inline;
1.867     kalberla 6590:   color:$font;
                   6591:   font-size:90%;
                   6592: }
                   6593: 
                   6594: div.LC_feedback_link div.LC_comblock {
                   6595:   padding-left:5px;
                   6596: }
                   6597: 
                   6598: div.LC_feedback_link div.LC_comblock a {
                   6599:   color:$font;
                   6600: }
                   6601: 
1.489     raeburn  6602: span.LC_feedback_link {
1.858     bisitz   6603:   /* background: $feedback_link_bg; */
1.599     albertel 6604:   font-size: larger;
                   6605: }
1.795     www      6606: 
1.599     albertel 6607: span.LC_message_link {
1.858     bisitz   6608:   /* background: $feedback_link_bg; */
1.599     albertel 6609:   font-size: larger;
                   6610:   position: absolute;
                   6611:   right: 1em;
1.489     raeburn  6612: }
1.421     albertel 6613: 
1.515     albertel 6614: table.LC_prior_tries {
1.524     albertel 6615:   border: 1px solid #000000;
                   6616:   border-collapse: separate;
                   6617:   border-spacing: 1px;
1.515     albertel 6618: }
1.523     albertel 6619: 
1.515     albertel 6620: table.LC_prior_tries td {
1.524     albertel 6621:   padding: 2px;
1.515     albertel 6622: }
1.523     albertel 6623: 
                   6624: .LC_answer_correct {
1.795     www      6625:   background: lightgreen;
                   6626:   color: darkgreen;
                   6627:   padding: 6px;
1.523     albertel 6628: }
1.795     www      6629: 
1.523     albertel 6630: .LC_answer_charged_try {
1.797     www      6631:   background: #FFAAAA;
1.795     www      6632:   color: darkred;
                   6633:   padding: 6px;
1.523     albertel 6634: }
1.795     www      6635: 
1.779     bisitz   6636: .LC_answer_not_charged_try,
1.523     albertel 6637: .LC_answer_no_grade,
                   6638: .LC_answer_late {
1.795     www      6639:   background: lightyellow;
1.523     albertel 6640:   color: black;
1.795     www      6641:   padding: 6px;
1.523     albertel 6642: }
1.795     www      6643: 
1.523     albertel 6644: .LC_answer_previous {
1.795     www      6645:   background: lightblue;
                   6646:   color: darkblue;
                   6647:   padding: 6px;
1.523     albertel 6648: }
1.795     www      6649: 
1.779     bisitz   6650: .LC_answer_no_message {
1.777     tempelho 6651:   background: #FFFFFF;
                   6652:   color: black;
1.795     www      6653:   padding: 6px;
1.779     bisitz   6654: }
1.795     www      6655: 
1.779     bisitz   6656: .LC_answer_unknown {
                   6657:   background: orange;
                   6658:   color: black;
1.795     www      6659:   padding: 6px;
1.777     tempelho 6660: }
1.795     www      6661: 
1.529     albertel 6662: span.LC_prior_numerical,
                   6663: span.LC_prior_string,
                   6664: span.LC_prior_custom,
                   6665: span.LC_prior_reaction,
                   6666: span.LC_prior_math {
1.925     bisitz   6667:   font-family: $mono;
1.523     albertel 6668:   white-space: pre;
                   6669: }
                   6670: 
1.525     albertel 6671: span.LC_prior_string {
1.925     bisitz   6672:   font-family: $mono;
1.525     albertel 6673:   white-space: pre;
                   6674: }
                   6675: 
1.523     albertel 6676: table.LC_prior_option {
                   6677:   width: 100%;
                   6678:   border-collapse: collapse;
                   6679: }
1.795     www      6680: 
1.911     bisitz   6681: table.LC_prior_rank,
1.795     www      6682: table.LC_prior_match {
1.528     albertel 6683:   border-collapse: collapse;
                   6684: }
1.795     www      6685: 
1.528     albertel 6686: table.LC_prior_option tr td,
                   6687: table.LC_prior_rank tr td,
                   6688: table.LC_prior_match tr td {
1.524     albertel 6689:   border: 1px solid #000000;
1.515     albertel 6690: }
                   6691: 
1.855     bisitz   6692: .LC_nobreak {
1.544     albertel 6693:   white-space: nowrap;
1.519     raeburn  6694: }
                   6695: 
1.576     raeburn  6696: span.LC_cusr_emph {
                   6697:   font-style: italic;
                   6698: }
                   6699: 
1.633     raeburn  6700: span.LC_cusr_subheading {
                   6701:   font-weight: normal;
                   6702:   font-size: 85%;
                   6703: }
                   6704: 
1.861     bisitz   6705: div.LC_docs_entry_move {
1.859     bisitz   6706:   border: 1px solid #BBBBBB;
1.545     albertel 6707:   background: #DDDDDD;
1.861     bisitz   6708:   width: 22px;
1.859     bisitz   6709:   padding: 1px;
                   6710:   margin: 0;
1.545     albertel 6711: }
                   6712: 
1.861     bisitz   6713: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6714: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6715:   font-size: x-small;
                   6716: }
1.795     www      6717: 
1.861     bisitz   6718: .LC_docs_entry_parameter {
                   6719:   white-space: nowrap;
                   6720: }
                   6721: 
1.544     albertel 6722: .LC_docs_copy {
1.545     albertel 6723:   color: #000099;
1.544     albertel 6724: }
1.795     www      6725: 
1.544     albertel 6726: .LC_docs_cut {
1.545     albertel 6727:   color: #550044;
1.544     albertel 6728: }
1.795     www      6729: 
1.544     albertel 6730: .LC_docs_rename {
1.545     albertel 6731:   color: #009900;
1.544     albertel 6732: }
1.795     www      6733: 
1.544     albertel 6734: .LC_docs_remove {
1.545     albertel 6735:   color: #990000;
                   6736: }
                   6737: 
1.547     albertel 6738: .LC_docs_reinit_warn,
                   6739: .LC_docs_ext_edit {
                   6740:   font-size: x-small;
                   6741: }
                   6742: 
1.545     albertel 6743: table.LC_docs_adddocs td,
                   6744: table.LC_docs_adddocs th {
                   6745:   border: 1px solid #BBBBBB;
                   6746:   padding: 4px;
                   6747:   background: #DDDDDD;
1.543     albertel 6748: }
                   6749: 
1.584     albertel 6750: table.LC_sty_begin {
                   6751:   background: #BBFFBB;
                   6752: }
1.795     www      6753: 
1.584     albertel 6754: table.LC_sty_end {
                   6755:   background: #FFBBBB;
                   6756: }
                   6757: 
1.589     raeburn  6758: table.LC_double_column {
1.803     bisitz   6759:   border-width: 0;
1.589     raeburn  6760:   border-collapse: collapse;
                   6761:   width: 100%;
                   6762:   padding: 2px;
                   6763: }
                   6764: 
                   6765: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6766:   top: 2px;
1.589     raeburn  6767:   left: 2px;
                   6768:   width: 47%;
                   6769:   vertical-align: top;
                   6770: }
                   6771: 
                   6772: table.LC_double_column tr td.LC_right_col {
                   6773:   top: 2px;
1.779     bisitz   6774:   right: 2px;
1.589     raeburn  6775:   width: 47%;
                   6776:   vertical-align: top;
                   6777: }
                   6778: 
1.591     raeburn  6779: div.LC_left_float {
                   6780:   float: left;
                   6781:   padding-right: 5%;
1.597     albertel 6782:   padding-bottom: 4px;
1.591     raeburn  6783: }
                   6784: 
                   6785: div.LC_clear_float_header {
1.597     albertel 6786:   padding-bottom: 2px;
1.591     raeburn  6787: }
                   6788: 
                   6789: div.LC_clear_float_footer {
1.597     albertel 6790:   padding-top: 10px;
1.591     raeburn  6791:   clear: both;
                   6792: }
                   6793: 
1.597     albertel 6794: div.LC_grade_show_user {
1.941     bisitz   6795: /*  border-left: 5px solid $sidebg; */
                   6796:   border-top: 5px solid #000000;
                   6797:   margin: 50px 0 0 0;
1.936     bisitz   6798:   padding: 15px 0 5px 10px;
1.597     albertel 6799: }
1.795     www      6800: 
1.936     bisitz   6801: div.LC_grade_show_user_odd_row {
1.941     bisitz   6802: /*  border-left: 5px solid #000000; */
                   6803: }
                   6804: 
                   6805: div.LC_grade_show_user div.LC_Box {
                   6806:   margin-right: 50px;
1.597     albertel 6807: }
                   6808: 
                   6809: div.LC_grade_submissions,
                   6810: div.LC_grade_message_center,
1.936     bisitz   6811: div.LC_grade_info_links {
1.597     albertel 6812:   margin: 5px;
                   6813:   width: 99%;
                   6814:   background: #FFFFFF;
                   6815: }
1.795     www      6816: 
1.597     albertel 6817: div.LC_grade_submissions_header,
1.936     bisitz   6818: div.LC_grade_message_center_header {
1.705     tempelho 6819:   font-weight: bold;
                   6820:   font-size: large;
1.597     albertel 6821: }
1.795     www      6822: 
1.597     albertel 6823: div.LC_grade_submissions_body,
1.936     bisitz   6824: div.LC_grade_message_center_body {
1.597     albertel 6825:   border: 1px solid black;
                   6826:   width: 99%;
                   6827:   background: #FFFFFF;
                   6828: }
1.795     www      6829: 
1.613     albertel 6830: table.LC_scantron_action {
                   6831:   width: 100%;
                   6832: }
1.795     www      6833: 
1.613     albertel 6834: table.LC_scantron_action tr th {
1.698     harmsja  6835:   font-weight:bold;
                   6836:   font-style:normal;
1.613     albertel 6837: }
1.795     www      6838: 
1.779     bisitz   6839: .LC_edit_problem_header,
1.614     albertel 6840: div.LC_edit_problem_footer {
1.705     tempelho 6841:   font-weight: normal;
                   6842:   font-size:  medium;
1.602     albertel 6843:   margin: 2px;
1.1060    bisitz   6844:   background-color: $sidebg;
1.600     albertel 6845: }
1.795     www      6846: 
1.600     albertel 6847: div.LC_edit_problem_header,
1.602     albertel 6848: div.LC_edit_problem_header div,
1.614     albertel 6849: div.LC_edit_problem_footer,
                   6850: div.LC_edit_problem_footer div,
1.602     albertel 6851: div.LC_edit_problem_editxml_header,
                   6852: div.LC_edit_problem_editxml_header div {
1.1205    golterma 6853:   z-index: 100;
1.600     albertel 6854: }
1.795     www      6855: 
1.600     albertel 6856: div.LC_edit_problem_header_title {
1.705     tempelho 6857:   font-weight: bold;
                   6858:   font-size: larger;
1.602     albertel 6859:   background: $tabbg;
                   6860:   padding: 3px;
1.1060    bisitz   6861:   margin: 0 0 5px 0;
1.602     albertel 6862: }
1.795     www      6863: 
1.602     albertel 6864: table.LC_edit_problem_header_title {
                   6865:   width: 100%;
1.600     albertel 6866:   background: $tabbg;
1.602     albertel 6867: }
                   6868: 
1.1205    golterma 6869: div.LC_edit_actionbar {
                   6870:     background-color: $sidebg;
1.1218    droeschl 6871:     margin: 0;
                   6872:     padding: 0;
                   6873:     line-height: 200%;
1.602     albertel 6874: }
1.795     www      6875: 
1.1218    droeschl 6876: div.LC_edit_actionbar div{
                   6877:     padding: 0;
                   6878:     margin: 0;
                   6879:     display: inline-block;
1.600     albertel 6880: }
1.795     www      6881: 
1.1124    bisitz   6882: .LC_edit_opt {
                   6883:   padding-left: 1em;
                   6884:   white-space: nowrap;
                   6885: }
                   6886: 
1.1152    golterma 6887: .LC_edit_problem_latexhelper{
                   6888:     text-align: right;
                   6889: }
                   6890: 
                   6891: #LC_edit_problem_colorful div{
                   6892:     margin-left: 40px;
                   6893: }
                   6894: 
1.1205    golterma 6895: #LC_edit_problem_codemirror div{
                   6896:     margin-left: 0px;
                   6897: }
                   6898: 
1.911     bisitz   6899: img.stift {
1.803     bisitz   6900:   border-width: 0;
                   6901:   vertical-align: middle;
1.677     riegler  6902: }
1.680     riegler  6903: 
1.923     bisitz   6904: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6905:   vertical-align: top;
1.777     tempelho 6906: }
1.795     www      6907: 
1.716     raeburn  6908: div.LC_createcourse {
1.911     bisitz   6909:   margin: 10px 10px 10px 10px;
1.716     raeburn  6910: }
                   6911: 
1.917     raeburn  6912: .LC_dccid {
1.1130    raeburn  6913:   float: right;
1.917     raeburn  6914:   margin: 0.2em 0 0 0;
                   6915:   padding: 0;
                   6916:   font-size: 90%;
                   6917:   display:none;
                   6918: }
                   6919: 
1.897     wenzelju 6920: ol.LC_primary_menu a:hover,
1.721     harmsja  6921: ol#LC_MenuBreadcrumbs a:hover,
                   6922: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6923: ul#LC_secondary_menu a:hover,
1.721     harmsja  6924: .LC_FormSectionClearButton input:hover
1.795     www      6925: ul.LC_TabContent   li:hover a {
1.952     onken    6926:   color:$button_hover;
1.911     bisitz   6927:   text-decoration:none;
1.693     droeschl 6928: }
                   6929: 
1.779     bisitz   6930: h1 {
1.911     bisitz   6931:   padding: 0;
                   6932:   line-height:130%;
1.693     droeschl 6933: }
1.698     harmsja  6934: 
1.911     bisitz   6935: h2,
                   6936: h3,
                   6937: h4,
                   6938: h5,
                   6939: h6 {
                   6940:   margin: 5px 0 5px 0;
                   6941:   padding: 0;
                   6942:   line-height:130%;
1.693     droeschl 6943: }
1.795     www      6944: 
                   6945: .LC_hcell {
1.911     bisitz   6946:   padding:3px 15px 3px 15px;
                   6947:   margin: 0;
                   6948:   background-color:$tabbg;
                   6949:   color:$fontmenu;
                   6950:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6951: }
1.795     www      6952: 
1.840     bisitz   6953: .LC_Box > .LC_hcell {
1.911     bisitz   6954:   margin: 0 -10px 10px -10px;
1.835     bisitz   6955: }
                   6956: 
1.721     harmsja  6957: .LC_noBorder {
1.911     bisitz   6958:   border: 0;
1.698     harmsja  6959: }
1.693     droeschl 6960: 
1.721     harmsja  6961: .LC_FormSectionClearButton input {
1.911     bisitz   6962:   background-color:transparent;
                   6963:   border: none;
                   6964:   cursor:pointer;
                   6965:   text-decoration:underline;
1.693     droeschl 6966: }
1.763     bisitz   6967: 
                   6968: .LC_help_open_topic {
1.911     bisitz   6969:   color: #FFFFFF;
                   6970:   background-color: #EEEEFF;
                   6971:   margin: 1px;
                   6972:   padding: 4px;
                   6973:   border: 1px solid #000033;
                   6974:   white-space: nowrap;
                   6975:   /* vertical-align: middle; */
1.759     neumanie 6976: }
1.693     droeschl 6977: 
1.911     bisitz   6978: dl,
                   6979: ul,
                   6980: div,
                   6981: fieldset {
                   6982:   margin: 10px 10px 10px 0;
                   6983:   /* overflow: hidden; */
1.693     droeschl 6984: }
1.795     www      6985: 
1.1211    raeburn  6986: article.geogebraweb div {
                   6987:     margin: 0;
                   6988: }
                   6989: 
1.838     bisitz   6990: fieldset > legend {
1.911     bisitz   6991:   font-weight: bold;
                   6992:   padding: 0 5px 0 5px;
1.838     bisitz   6993: }
                   6994: 
1.813     bisitz   6995: #LC_nav_bar {
1.911     bisitz   6996:   float: left;
1.995     raeburn  6997:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6998:   margin: 0 0 2px 0;
1.807     droeschl 6999: }
                   7000: 
1.916     droeschl 7001: #LC_realm {
                   7002:   margin: 0.2em 0 0 0;
                   7003:   padding: 0;
                   7004:   font-weight: bold;
                   7005:   text-align: center;
1.995     raeburn  7006:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 7007: }
                   7008: 
1.911     bisitz   7009: #LC_nav_bar em {
                   7010:   font-weight: bold;
                   7011:   font-style: normal;
1.807     droeschl 7012: }
                   7013: 
1.897     wenzelju 7014: ol.LC_primary_menu {
1.934     droeschl 7015:   margin: 0;
1.1076    raeburn  7016:   padding: 0;
1.807     droeschl 7017: }
                   7018: 
1.852     droeschl 7019: ol#LC_PathBreadcrumbs {
1.911     bisitz   7020:   margin: 0;
1.693     droeschl 7021: }
                   7022: 
1.897     wenzelju 7023: ol.LC_primary_menu li {
1.1076    raeburn  7024:   color: RGB(80, 80, 80);
                   7025:   vertical-align: middle;
                   7026:   text-align: left;
                   7027:   list-style: none;
1.1205    golterma 7028:   position: relative;
1.1076    raeburn  7029:   float: left;
1.1205    golterma 7030:   z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
                   7031:   line-height: 1.5em;
1.1076    raeburn  7032: }
                   7033: 
1.1205    golterma 7034: ol.LC_primary_menu li a,
                   7035: ol.LC_primary_menu li p {
1.1076    raeburn  7036:   display: block;
                   7037:   margin: 0;
                   7038:   padding: 0 5px 0 10px;
                   7039:   text-decoration: none;
                   7040: }
                   7041: 
1.1205    golterma 7042: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
                   7043:   display: inline-block;
                   7044:   width: 95%;
                   7045:   text-align: left;
                   7046: }
                   7047: 
                   7048: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
                   7049:   display: inline-block;	
                   7050:   width: 5%;
                   7051:   float: right;
                   7052:   text-align: right;
                   7053:   font-size: 70%;
                   7054: }
                   7055: 
                   7056: ol.LC_primary_menu ul {
1.1076    raeburn  7057:   display: none;
1.1205    golterma 7058:   width: 15em;
1.1076    raeburn  7059:   background-color: $data_table_light;
1.1205    golterma 7060:   position: absolute;
                   7061:   top: 100%;
1.1076    raeburn  7062: }
                   7063: 
1.1205    golterma 7064: ol.LC_primary_menu ul ul {
                   7065:   left: 100%;
                   7066:   top: 0;
                   7067: }
                   7068: 
                   7069: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076    raeburn  7070:   display: block;
                   7071:   position: absolute;
                   7072:   margin: 0;
                   7073:   padding: 0;
1.1078    raeburn  7074:   z-index: 2;
1.1076    raeburn  7075: }
                   7076: 
                   7077: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205    golterma 7078: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076    raeburn  7079:   font-size: 90%;
1.911     bisitz   7080:   vertical-align: top;
1.1076    raeburn  7081:   float: none;
1.1079    raeburn  7082:   border-left: 1px solid black;
                   7083:   border-right: 1px solid black;
1.1205    golterma 7084: /* A dark bottom border to visualize different menu options; 
                   7085: overwritten in the create_submenu routine for the last border-bottom of the menu */
                   7086:   border-bottom: 1px solid $data_table_dark; 
1.1076    raeburn  7087: }
                   7088: 
1.1205    golterma 7089: ol.LC_primary_menu li li p:hover {
                   7090:   color:$button_hover;
                   7091:   text-decoration:none;
                   7092:   background-color:$data_table_dark;
1.1076    raeburn  7093: }
                   7094: 
                   7095: ol.LC_primary_menu li li a:hover {
                   7096:    color:$button_hover;
                   7097:    background-color:$data_table_dark;
1.693     droeschl 7098: }
                   7099: 
1.1205    golterma 7100: /* Font-size equal to the size of the predecessors*/
                   7101: ol.LC_primary_menu li:hover li li {
                   7102:   font-size: 100%;
                   7103: }
                   7104: 
1.897     wenzelju 7105: ol.LC_primary_menu li img {
1.911     bisitz   7106:   vertical-align: bottom;
1.934     droeschl 7107:   height: 1.1em;
1.1077    raeburn  7108:   margin: 0.2em 0 0 0;
1.693     droeschl 7109: }
                   7110: 
1.897     wenzelju 7111: ol.LC_primary_menu a {
1.911     bisitz   7112:   color: RGB(80, 80, 80);
                   7113:   text-decoration: none;
1.693     droeschl 7114: }
1.795     www      7115: 
1.949     droeschl 7116: ol.LC_primary_menu a.LC_new_message {
                   7117:   font-weight:bold;
                   7118:   color: darkred;
                   7119: }
                   7120: 
1.975     raeburn  7121: ol.LC_docs_parameters {
                   7122:   margin-left: 0;
                   7123:   padding: 0;
                   7124:   list-style: none;
                   7125: }
                   7126: 
                   7127: ol.LC_docs_parameters li {
                   7128:   margin: 0;
                   7129:   padding-right: 20px;
                   7130:   display: inline;
                   7131: }
                   7132: 
1.976     raeburn  7133: ol.LC_docs_parameters li:before {
                   7134:   content: "\\002022 \\0020";
                   7135: }
                   7136: 
                   7137: li.LC_docs_parameters_title {
                   7138:   font-weight: bold;
                   7139: }
                   7140: 
                   7141: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   7142:   content: "";
                   7143: }
                   7144: 
1.897     wenzelju 7145: ul#LC_secondary_menu {
1.1107    raeburn  7146:   clear: right;
1.911     bisitz   7147:   color: $fontmenu;
                   7148:   background: $tabbg;
                   7149:   list-style: none;
                   7150:   padding: 0;
                   7151:   margin: 0;
                   7152:   width: 100%;
1.995     raeburn  7153:   text-align: left;
1.1107    raeburn  7154:   float: left;
1.808     droeschl 7155: }
                   7156: 
1.897     wenzelju 7157: ul#LC_secondary_menu li {
1.911     bisitz   7158:   font-weight: bold;
                   7159:   line-height: 1.8em;
1.1107    raeburn  7160:   border-right: 1px solid black;
                   7161:   float: left;
                   7162: }
                   7163: 
                   7164: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   7165:   background-color: $data_table_light;
                   7166: }
                   7167: 
                   7168: ul#LC_secondary_menu li a {
1.911     bisitz   7169:   padding: 0 0.8em;
1.1107    raeburn  7170: }
                   7171: 
                   7172: ul#LC_secondary_menu li ul {
                   7173:   display: none;
                   7174: }
                   7175: 
                   7176: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   7177:   display: block;
                   7178:   position: absolute;
                   7179:   margin: 0;
                   7180:   padding: 0;
                   7181:   list-style:none;
                   7182:   float: none;
                   7183:   background-color: $data_table_light;
                   7184:   z-index: 2;
                   7185:   margin-left: -1px;
                   7186: }
                   7187: 
                   7188: ul#LC_secondary_menu li ul li {
                   7189:   font-size: 90%;
                   7190:   vertical-align: top;
                   7191:   border-left: 1px solid black;
1.911     bisitz   7192:   border-right: 1px solid black;
1.1119    raeburn  7193:   background-color: $data_table_light;
1.1107    raeburn  7194:   list-style:none;
                   7195:   float: none;
                   7196: }
                   7197: 
                   7198: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   7199:   background-color: $data_table_dark;
1.807     droeschl 7200: }
                   7201: 
1.847     tempelho 7202: ul.LC_TabContent {
1.911     bisitz   7203:   display:block;
                   7204:   background: $sidebg;
                   7205:   border-bottom: solid 1px $lg_border_color;
                   7206:   list-style:none;
1.1020    raeburn  7207:   margin: -1px -10px 0 -10px;
1.911     bisitz   7208:   padding: 0;
1.693     droeschl 7209: }
                   7210: 
1.795     www      7211: ul.LC_TabContent li,
                   7212: ul.LC_TabContentBigger li {
1.911     bisitz   7213:   float:left;
1.741     harmsja  7214: }
1.795     www      7215: 
1.897     wenzelju 7216: ul#LC_secondary_menu li a {
1.911     bisitz   7217:   color: $fontmenu;
                   7218:   text-decoration: none;
1.693     droeschl 7219: }
1.795     www      7220: 
1.721     harmsja  7221: ul.LC_TabContent {
1.952     onken    7222:   min-height:20px;
1.721     harmsja  7223: }
1.795     www      7224: 
                   7225: ul.LC_TabContent li {
1.911     bisitz   7226:   vertical-align:middle;
1.959     onken    7227:   padding: 0 16px 0 10px;
1.911     bisitz   7228:   background-color:$tabbg;
                   7229:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  7230:   border-left: solid 1px $font;
1.721     harmsja  7231: }
1.795     www      7232: 
1.847     tempelho 7233: ul.LC_TabContent .right {
1.911     bisitz   7234:   float:right;
1.847     tempelho 7235: }
                   7236: 
1.911     bisitz   7237: ul.LC_TabContent li a,
                   7238: ul.LC_TabContent li {
                   7239:   color:rgb(47,47,47);
                   7240:   text-decoration:none;
                   7241:   font-size:95%;
                   7242:   font-weight:bold;
1.952     onken    7243:   min-height:20px;
                   7244: }
                   7245: 
1.959     onken    7246: ul.LC_TabContent li a:hover,
                   7247: ul.LC_TabContent li a:focus {
1.952     onken    7248:   color: $button_hover;
1.959     onken    7249:   background:none;
                   7250:   outline:none;
1.952     onken    7251: }
                   7252: 
                   7253: ul.LC_TabContent li:hover {
                   7254:   color: $button_hover;
                   7255:   cursor:pointer;
1.721     harmsja  7256: }
1.795     www      7257: 
1.911     bisitz   7258: ul.LC_TabContent li.active {
1.952     onken    7259:   color: $font;
1.911     bisitz   7260:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    7261:   border-bottom:solid 1px #FFFFFF;
                   7262:   cursor: default;
1.744     ehlerst  7263: }
1.795     www      7264: 
1.959     onken    7265: ul.LC_TabContent li.active a {
                   7266:   color:$font;
                   7267:   background:#FFFFFF;
                   7268:   outline: none;
                   7269: }
1.1047    raeburn  7270: 
                   7271: ul.LC_TabContent li.goback {
                   7272:   float: left;
                   7273:   border-left: none;
                   7274: }
                   7275: 
1.870     tempelho 7276: #maincoursedoc {
1.911     bisitz   7277:   clear:both;
1.870     tempelho 7278: }
                   7279: 
                   7280: ul.LC_TabContentBigger {
1.911     bisitz   7281:   display:block;
                   7282:   list-style:none;
                   7283:   padding: 0;
1.870     tempelho 7284: }
                   7285: 
1.795     www      7286: ul.LC_TabContentBigger li {
1.911     bisitz   7287:   vertical-align:bottom;
                   7288:   height: 30px;
                   7289:   font-size:110%;
                   7290:   font-weight:bold;
                   7291:   color: #737373;
1.841     tempelho 7292: }
                   7293: 
1.957     onken    7294: ul.LC_TabContentBigger li.active {
                   7295:   position: relative;
                   7296:   top: 1px;
                   7297: }
                   7298: 
1.870     tempelho 7299: ul.LC_TabContentBigger li a {
1.911     bisitz   7300:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   7301:   height: 30px;
                   7302:   line-height: 30px;
                   7303:   text-align: center;
                   7304:   display: block;
                   7305:   text-decoration: none;
1.958     onken    7306:   outline: none;  
1.741     harmsja  7307: }
1.795     www      7308: 
1.870     tempelho 7309: ul.LC_TabContentBigger li.active a {
1.911     bisitz   7310:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   7311:   color:$font;
1.744     ehlerst  7312: }
1.795     www      7313: 
1.870     tempelho 7314: ul.LC_TabContentBigger li b {
1.911     bisitz   7315:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   7316:   display: block;
                   7317:   float: left;
                   7318:   padding: 0 30px;
1.957     onken    7319:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 7320: }
                   7321: 
1.956     onken    7322: ul.LC_TabContentBigger li:hover b {
                   7323:   color:$button_hover;
                   7324: }
                   7325: 
1.870     tempelho 7326: ul.LC_TabContentBigger li.active b {
1.911     bisitz   7327:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   7328:   color:$font;
1.957     onken    7329:   border: 0;
1.741     harmsja  7330: }
1.693     droeschl 7331: 
1.870     tempelho 7332: 
1.862     bisitz   7333: ul.LC_CourseBreadcrumbs {
                   7334:   background: $sidebg;
1.1020    raeburn  7335:   height: 2em;
1.862     bisitz   7336:   padding-left: 10px;
1.1020    raeburn  7337:   margin: 0;
1.862     bisitz   7338:   list-style-position: inside;
                   7339: }
                   7340: 
1.911     bisitz   7341: ol#LC_MenuBreadcrumbs,
1.862     bisitz   7342: ol#LC_PathBreadcrumbs {
1.911     bisitz   7343:   padding-left: 10px;
                   7344:   margin: 0;
1.933     droeschl 7345:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 7346: }
                   7347: 
1.911     bisitz   7348: ol#LC_MenuBreadcrumbs li,
                   7349: ol#LC_PathBreadcrumbs li,
1.862     bisitz   7350: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   7351:   display: inline;
1.933     droeschl 7352:   white-space: normal;  
1.693     droeschl 7353: }
                   7354: 
1.823     bisitz   7355: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   7356: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   7357:   text-decoration: none;
                   7358:   font-size:90%;
1.693     droeschl 7359: }
1.795     www      7360: 
1.969     droeschl 7361: ol#LC_MenuBreadcrumbs h1 {
                   7362:   display: inline;
                   7363:   font-size: 90%;
                   7364:   line-height: 2.5em;
                   7365:   margin: 0;
                   7366:   padding: 0;
                   7367: }
                   7368: 
1.795     www      7369: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   7370:   text-decoration:none;
                   7371:   font-size:100%;
                   7372:   font-weight:bold;
1.693     droeschl 7373: }
1.795     www      7374: 
1.840     bisitz   7375: .LC_Box {
1.911     bisitz   7376:   border: solid 1px $lg_border_color;
                   7377:   padding: 0 10px 10px 10px;
1.746     neumanie 7378: }
1.795     www      7379: 
1.1020    raeburn  7380: .LC_DocsBox {
                   7381:   border: solid 1px $lg_border_color;
                   7382:   padding: 0 0 10px 10px;
                   7383: }
                   7384: 
1.795     www      7385: .LC_AboutMe_Image {
1.911     bisitz   7386:   float:left;
                   7387:   margin-right:10px;
1.747     neumanie 7388: }
1.795     www      7389: 
                   7390: .LC_Clear_AboutMe_Image {
1.911     bisitz   7391:   clear:left;
1.747     neumanie 7392: }
1.795     www      7393: 
1.721     harmsja  7394: dl.LC_ListStyleClean dt {
1.911     bisitz   7395:   padding-right: 5px;
                   7396:   display: table-header-group;
1.693     droeschl 7397: }
                   7398: 
1.721     harmsja  7399: dl.LC_ListStyleClean dd {
1.911     bisitz   7400:   display: table-row;
1.693     droeschl 7401: }
                   7402: 
1.721     harmsja  7403: .LC_ListStyleClean,
                   7404: .LC_ListStyleSimple,
                   7405: .LC_ListStyleNormal,
1.795     www      7406: .LC_ListStyleSpecial {
1.911     bisitz   7407:   /* display:block; */
                   7408:   list-style-position: inside;
                   7409:   list-style-type: none;
                   7410:   overflow: hidden;
                   7411:   padding: 0;
1.693     droeschl 7412: }
                   7413: 
1.721     harmsja  7414: .LC_ListStyleSimple li,
                   7415: .LC_ListStyleSimple dd,
                   7416: .LC_ListStyleNormal li,
                   7417: .LC_ListStyleNormal dd,
                   7418: .LC_ListStyleSpecial li,
1.795     www      7419: .LC_ListStyleSpecial dd {
1.911     bisitz   7420:   margin: 0;
                   7421:   padding: 5px 5px 5px 10px;
                   7422:   clear: both;
1.693     droeschl 7423: }
                   7424: 
1.721     harmsja  7425: .LC_ListStyleClean li,
                   7426: .LC_ListStyleClean dd {
1.911     bisitz   7427:   padding-top: 0;
                   7428:   padding-bottom: 0;
1.693     droeschl 7429: }
                   7430: 
1.721     harmsja  7431: .LC_ListStyleSimple dd,
1.795     www      7432: .LC_ListStyleSimple li {
1.911     bisitz   7433:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 7434: }
                   7435: 
1.721     harmsja  7436: .LC_ListStyleSpecial li,
                   7437: .LC_ListStyleSpecial dd {
1.911     bisitz   7438:   list-style-type: none;
                   7439:   background-color: RGB(220, 220, 220);
                   7440:   margin-bottom: 4px;
1.693     droeschl 7441: }
                   7442: 
1.721     harmsja  7443: table.LC_SimpleTable {
1.911     bisitz   7444:   margin:5px;
                   7445:   border:solid 1px $lg_border_color;
1.795     www      7446: }
1.693     droeschl 7447: 
1.721     harmsja  7448: table.LC_SimpleTable tr {
1.911     bisitz   7449:   padding: 0;
                   7450:   border:solid 1px $lg_border_color;
1.693     droeschl 7451: }
1.795     www      7452: 
                   7453: table.LC_SimpleTable thead {
1.911     bisitz   7454:   background:rgb(220,220,220);
1.693     droeschl 7455: }
                   7456: 
1.721     harmsja  7457: div.LC_columnSection {
1.911     bisitz   7458:   display: block;
                   7459:   clear: both;
                   7460:   overflow: hidden;
                   7461:   margin: 0;
1.693     droeschl 7462: }
                   7463: 
1.721     harmsja  7464: div.LC_columnSection>* {
1.911     bisitz   7465:   float: left;
                   7466:   margin: 10px 20px 10px 0;
                   7467:   overflow:hidden;
1.693     droeschl 7468: }
1.721     harmsja  7469: 
1.795     www      7470: table em {
1.911     bisitz   7471:   font-weight: bold;
                   7472:   font-style: normal;
1.748     schulted 7473: }
1.795     www      7474: 
1.779     bisitz   7475: table.LC_tableBrowseRes,
1.795     www      7476: table.LC_tableOfContent {
1.911     bisitz   7477:   border:none;
                   7478:   border-spacing: 1px;
                   7479:   padding: 3px;
                   7480:   background-color: #FFFFFF;
                   7481:   font-size: 90%;
1.753     droeschl 7482: }
1.789     droeschl 7483: 
1.911     bisitz   7484: table.LC_tableOfContent {
                   7485:   border-collapse: collapse;
1.789     droeschl 7486: }
                   7487: 
1.771     droeschl 7488: table.LC_tableBrowseRes a,
1.768     schulted 7489: table.LC_tableOfContent a {
1.911     bisitz   7490:   background-color: transparent;
                   7491:   text-decoration: none;
1.753     droeschl 7492: }
                   7493: 
1.795     www      7494: table.LC_tableOfContent img {
1.911     bisitz   7495:   border: none;
                   7496:   height: 1.3em;
                   7497:   vertical-align: text-bottom;
                   7498:   margin-right: 0.3em;
1.753     droeschl 7499: }
1.757     schulted 7500: 
1.795     www      7501: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7502:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7503: }
                   7504: 
1.795     www      7505: a#LC_content_toolbar_everything {
1.911     bisitz   7506:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7507: }
                   7508: 
1.795     www      7509: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7510:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7511: }
                   7512: 
1.795     www      7513: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7514:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7515: }
                   7516: 
1.795     www      7517: a#LC_content_toolbar_changefolder {
1.911     bisitz   7518:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7519: }
                   7520: 
1.795     www      7521: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7522:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7523: }
                   7524: 
1.1043    raeburn  7525: a#LC_content_toolbar_edittoplevel {
                   7526:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7527: }
                   7528: 
1.795     www      7529: ul#LC_toolbar li a:hover {
1.911     bisitz   7530:   background-position: bottom center;
1.757     schulted 7531: }
                   7532: 
1.795     www      7533: ul#LC_toolbar {
1.911     bisitz   7534:   padding: 0;
                   7535:   margin: 2px;
                   7536:   list-style:none;
                   7537:   position:relative;
                   7538:   background-color:white;
1.1082    raeburn  7539:   overflow: auto;
1.757     schulted 7540: }
                   7541: 
1.795     www      7542: ul#LC_toolbar li {
1.911     bisitz   7543:   border:1px solid white;
                   7544:   padding: 0;
                   7545:   margin: 0;
                   7546:   float: left;
                   7547:   display:inline;
                   7548:   vertical-align:middle;
1.1082    raeburn  7549:   white-space: nowrap;
1.911     bisitz   7550: }
1.757     schulted 7551: 
1.783     amueller 7552: 
1.795     www      7553: a.LC_toolbarItem {
1.911     bisitz   7554:   display:block;
                   7555:   padding: 0;
                   7556:   margin: 0;
                   7557:   height: 32px;
                   7558:   width: 32px;
                   7559:   color:white;
                   7560:   border: none;
                   7561:   background-repeat:no-repeat;
                   7562:   background-color:transparent;
1.757     schulted 7563: }
                   7564: 
1.915     droeschl 7565: ul.LC_funclist {
                   7566:     margin: 0;
                   7567:     padding: 0.5em 1em 0.5em 0;
                   7568: }
                   7569: 
1.933     droeschl 7570: ul.LC_funclist > li:first-child {
                   7571:     font-weight:bold; 
                   7572:     margin-left:0.8em;
                   7573: }
                   7574: 
1.915     droeschl 7575: ul.LC_funclist + ul.LC_funclist {
                   7576:     /* 
                   7577:        left border as a seperator if we have more than
                   7578:        one list 
                   7579:     */
                   7580:     border-left: 1px solid $sidebg;
                   7581:     /* 
                   7582:        this hides the left border behind the border of the 
                   7583:        outer box if element is wrapped to the next 'line' 
                   7584:     */
                   7585:     margin-left: -1px;
                   7586: }
                   7587: 
1.843     bisitz   7588: ul.LC_funclist li {
1.915     droeschl 7589:   display: inline;
1.782     bisitz   7590:   white-space: nowrap;
1.915     droeschl 7591:   margin: 0 0 0 25px;
                   7592:   line-height: 150%;
1.782     bisitz   7593: }
                   7594: 
1.974     wenzelju 7595: .LC_hidden {
                   7596:   display: none;
                   7597: }
                   7598: 
1.1030    www      7599: .LCmodal-overlay {
                   7600: 		position:fixed;
                   7601: 		top:0;
                   7602: 		right:0;
                   7603: 		bottom:0;
                   7604: 		left:0;
                   7605: 		height:100%;
                   7606: 		width:100%;
                   7607: 		margin:0;
                   7608: 		padding:0;
                   7609: 		background:#999;
                   7610: 		opacity:.75;
                   7611: 		filter: alpha(opacity=75);
                   7612: 		-moz-opacity: 0.75;
                   7613: 		z-index:101;
                   7614: }
                   7615: 
                   7616: * html .LCmodal-overlay {   
                   7617: 		position: absolute;
                   7618: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7619: }
                   7620: 
                   7621: .LCmodal-window {
                   7622: 		position:fixed;
                   7623: 		top:50%;
                   7624: 		left:50%;
                   7625: 		margin:0;
                   7626: 		padding:0;
                   7627: 		z-index:102;
                   7628: 	}
                   7629: 
                   7630: * html .LCmodal-window {
                   7631: 		position:absolute;
                   7632: }
                   7633: 
                   7634: .LCclose-window {
                   7635: 		position:absolute;
                   7636: 		width:32px;
                   7637: 		height:32px;
                   7638: 		right:8px;
                   7639: 		top:8px;
                   7640: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7641: 		text-indent:-99999px;
                   7642: 		overflow:hidden;
                   7643: 		cursor:pointer;
                   7644: }
                   7645: 
1.1100    raeburn  7646: /*
                   7647:   styles used by TTH when "Default set of options to pass to tth/m
                   7648:   when converting TeX" in course settings has been set
                   7649: 
                   7650:   option passed: -t
                   7651: 
                   7652: */
                   7653: 
                   7654: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7655: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7656: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7657: td div.norm {line-height:normal;}
                   7658: 
                   7659: /*
                   7660:   option passed -y3
                   7661: */
                   7662: 
                   7663: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7664: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7665: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7666: 
1.343     albertel 7667: END
                   7668: }
                   7669: 
1.306     albertel 7670: =pod
                   7671: 
                   7672: =item * &headtag()
                   7673: 
                   7674: Returns a uniform footer for LON-CAPA web pages.
                   7675: 
1.307     albertel 7676: Inputs: $title - optional title for the head
                   7677:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7678:         $args - optional arguments
1.319     albertel 7679:             force_register - if is true call registerurl so the remote is 
                   7680:                              informed
1.415     albertel 7681:             redirect       -> array ref of
                   7682:                                    1- seconds before redirect occurs
                   7683:                                    2- url to redirect to
                   7684:                                    3- whether the side effect should occur
1.315     albertel 7685:                            (side effect of setting 
                   7686:                                $env{'internal.head.redirect'} to the url 
                   7687:                                redirected too)
1.352     albertel 7688:             domain         -> force to color decorate a page for a specific
                   7689:                                domain
                   7690:             function       -> force usage of a specific rolish color scheme
                   7691:             bgcolor        -> override the default page bgcolor
1.460     albertel 7692:             no_auto_mt_title
                   7693:                            -> prevent &mt()ing the title arg
1.464     albertel 7694: 
1.306     albertel 7695: =cut
                   7696: 
                   7697: sub headtag {
1.313     albertel 7698:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7699:     
1.363     albertel 7700:     my $function = $args->{'function'} || &get_users_function();
                   7701:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7702:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1154    raeburn  7703:     my $httphost = $args->{'use_absolute'};
1.418     albertel 7704:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7705: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7706: 		   #time(),
1.418     albertel 7707: 		   $env{'environment.color.timestamp'},
1.363     albertel 7708: 		   $function,$domain,$bgcolor);
                   7709: 
1.369     www      7710:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7711: 
1.308     albertel 7712:     my $result =
                   7713: 	'<head>'.
1.1160    raeburn  7714: 	&font_settings($args);
1.319     albertel 7715: 
1.1188    raeburn  7716:     my $inhibitprint;
                   7717:     if ($args->{'print_suppress'}) {
                   7718:         $inhibitprint = &print_suppression();
                   7719:     }
1.1064    raeburn  7720: 
1.461     albertel 7721:     if (!$args->{'frameset'}) {
                   7722: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7723:     }
1.962     droeschl 7724:     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
                   7725:         $result .= Apache::lonxml::display_title();
1.319     albertel 7726:     }
1.436     albertel 7727:     if (!$args->{'no_nav_bar'} 
                   7728: 	&& !$args->{'only_body'}
                   7729: 	&& !$args->{'frameset'}) {
1.1154    raeburn  7730: 	$result .= &help_menu_js($httphost);
1.1032    www      7731:         $result.=&modal_window();
1.1038    www      7732:         $result.=&togglebox_script();
1.1034    www      7733:         $result.=&wishlist_window();
1.1041    www      7734:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7735:     } else {
                   7736:         if ($args->{'add_modal'}) {
                   7737:            $result.=&modal_window();
                   7738:         }
                   7739:         if ($args->{'add_wishlist'}) {
                   7740:            $result.=&wishlist_window();
                   7741:         }
1.1038    www      7742:         if ($args->{'add_togglebox'}) {
                   7743:            $result.=&togglebox_script();
                   7744:         }
1.1041    www      7745:         if ($args->{'add_progressbar'}) {
                   7746:            $result.=&LCprogressbarUpdate_script();
                   7747:         }
1.436     albertel 7748:     }
1.314     albertel 7749:     if (ref($args->{'redirect'})) {
1.414     albertel 7750: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7751: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7752: 	if (!$inhibit_continue) {
                   7753: 	    $env{'internal.head.redirect'} = $url;
                   7754: 	}
1.313     albertel 7755: 	$result.=<<ADDMETA
                   7756: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7757: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7758: ADDMETA
1.1210    raeburn  7759:     } else {
                   7760:         unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
                   7761:             my $requrl = $env{'request.uri'};
                   7762:             if ($requrl eq '') {
                   7763:                 $requrl = $ENV{'REQUEST_URI'};
                   7764:                 $requrl =~ s/\?.+$//;
                   7765:             }
                   7766:             unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
                   7767:                     (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
                   7768:                      ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
                   7769:                 my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                   7770:                 unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                   7771:                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
                   7772:                     if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                   7773:                         my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   7774:                         if ($domdefs{'offloadnow'}{$lonhost}) {
                   7775:                             my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
                   7776:                             if (($newserver) && ($newserver ne $lonhost)) {
                   7777:                                 my $numsec = 5;
                   7778:                                 my $timeout = $numsec * 1000;
                   7779:                                 my ($newurl,$locknum,%locks,$msg);
                   7780:                                 if ($env{'request.role.adv'}) {
                   7781:                                     ($locknum,%locks) = &Apache::lonnet::get_locks();
                   7782:                                 }
                   7783:                                 my $disable_submit = 0;
                   7784:                                 if ($requrl =~ /$LONCAPA::assess_re/) {
                   7785:                                     $disable_submit = 1;
                   7786:                                 }
                   7787:                                 if ($locknum) {
                   7788:                                     my @lockinfo = sort(values(%locks));
                   7789:                                     $msg = &mt('Once the following tasks are complete: ')."\\n".
                   7790:                                            join(", ",sort(values(%locks)))."\\n".
                   7791:                                            &mt('your session will be transferred to a different server, after you click "Roles".');
                   7792:                                 } else {
                   7793:                                     if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                   7794:                                         $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
                   7795:                                     }
                   7796:                                     $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                   7797:                                     $newurl = '/adm/switchserver?otherserver='.$newserver;
                   7798:                                     if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
                   7799:                                         $newurl .= '&role='.$env{'request.role'};
                   7800:                                     }
                   7801:                                     if ($env{'request.symb'}) {
                   7802:                                         $newurl .= '&symb='.$env{'request.symb'};
                   7803:                                     } else {
                   7804:                                         $newurl .= '&origurl='.$requrl;
                   7805:                                     }
                   7806:                                 }
1.1222    damieng  7807:                                 &js_escape(\$msg);
1.1210    raeburn  7808:                                 $result.=<<OFFLOAD
                   7809: <meta http-equiv="pragma" content="no-cache" />
                   7810: <script type="text/javascript">
1.1215    raeburn  7811: // <![CDATA[
1.1210    raeburn  7812: function LC_Offload_Now() {
                   7813:     var dest = "$newurl";
                   7814:     if (dest != '') {
                   7815:         window.location.href="$newurl";
                   7816:     }
                   7817: }
1.1214    raeburn  7818: \$(document).ready(function () {
                   7819:     window.alert('$msg');
                   7820:     if ($disable_submit) {
1.1210    raeburn  7821:         \$(".LC_hwk_submit").prop("disabled", true);
                   7822:         \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214    raeburn  7823:     }
                   7824:     setTimeout('LC_Offload_Now()', $timeout);
                   7825: });
1.1215    raeburn  7826: // ]]>
1.1210    raeburn  7827: </script>
                   7828: OFFLOAD
                   7829:                             }
                   7830:                         }
                   7831:                     }
                   7832:                 }
                   7833:             }
                   7834:         }
1.313     albertel 7835:     }
1.306     albertel 7836:     if (!defined($title)) {
                   7837: 	$title = 'The LearningOnline Network with CAPA';
                   7838:     }
1.460     albertel 7839:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7840:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168    raeburn  7841: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'"';
                   7842:     if (!$args->{'frameset'}) {
                   7843:         $result .= ' /';
                   7844:     }
                   7845:     $result .= '>' 
1.1064    raeburn  7846:         .$inhibitprint
1.414     albertel 7847: 	.$head_extra;
1.1137    raeburn  7848:     if ($env{'browser.mobile'}) {
                   7849:         $result .= '
                   7850: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   7851: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   7852:     }
1.962     droeschl 7853:     return $result.'</head>';
1.306     albertel 7854: }
                   7855: 
                   7856: =pod
                   7857: 
1.340     albertel 7858: =item * &font_settings()
                   7859: 
                   7860: Returns neccessary <meta> to set the proper encoding
                   7861: 
1.1160    raeburn  7862: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340     albertel 7863: 
                   7864: =cut
                   7865: 
                   7866: sub font_settings {
1.1160    raeburn  7867:     my ($args) = @_;
1.340     albertel 7868:     my $headerstring='';
1.1160    raeburn  7869:     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
                   7870:         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168    raeburn  7871:         $headerstring.=
                   7872:             '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
                   7873:         if (!$args->{'frameset'}) {
                   7874: 	    $headerstring.= ' /';
                   7875:         }
                   7876: 	$headerstring .= '>'."\n";
1.340     albertel 7877:     }
                   7878:     return $headerstring;
                   7879: }
                   7880: 
1.341     albertel 7881: =pod
                   7882: 
1.1064    raeburn  7883: =item * &print_suppression()
                   7884: 
                   7885: In course context returns css which causes the body to be blank when media="print",
                   7886: if printout generation is unavailable for the current resource.
                   7887: 
                   7888: This could be because:
                   7889: 
                   7890: (a) printstartdate is in the future
                   7891: 
                   7892: (b) printenddate is in the past
                   7893: 
                   7894: (c) there is an active exam block with "printout"
                   7895: functionality blocked
                   7896: 
                   7897: Users with pav, pfo or evb privileges are exempt.
                   7898: 
                   7899: Inputs: none
                   7900: 
                   7901: =cut
                   7902: 
                   7903: 
                   7904: sub print_suppression {
                   7905:     my $noprint;
                   7906:     if ($env{'request.course.id'}) {
                   7907:         my $scope = $env{'request.course.id'};
                   7908:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7909:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7910:             return;
                   7911:         }
                   7912:         if ($env{'request.course.sec'} ne '') {
                   7913:             $scope .= "/$env{'request.course.sec'}";
                   7914:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7915:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7916:                 return;
1.1064    raeburn  7917:             }
                   7918:         }
                   7919:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7920:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189    raeburn  7921:         my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064    raeburn  7922:         if ($blocked) {
                   7923:             my $checkrole = "cm./$cdom/$cnum";
                   7924:             if ($env{'request.course.sec'} ne '') {
                   7925:                 $checkrole .= "/$env{'request.course.sec'}";
                   7926:             }
                   7927:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7928:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7929:                 $noprint = 1;
                   7930:             }
                   7931:         }
                   7932:         unless ($noprint) {
                   7933:             my $symb = &Apache::lonnet::symbread();
                   7934:             if ($symb ne '') {
                   7935:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7936:                 if (ref($navmap)) {
                   7937:                     my $res = $navmap->getBySymb($symb);
                   7938:                     if (ref($res)) {
                   7939:                         if (!$res->resprintable()) {
                   7940:                             $noprint = 1;
                   7941:                         }
                   7942:                     }
                   7943:                 }
                   7944:             }
                   7945:         }
                   7946:         if ($noprint) {
                   7947:             return <<"ENDSTYLE";
                   7948: <style type="text/css" media="print">
                   7949:     body { display:none }
                   7950: </style>
                   7951: ENDSTYLE
                   7952:         }
                   7953:     }
                   7954:     return;
                   7955: }
                   7956: 
                   7957: =pod
                   7958: 
1.341     albertel 7959: =item * &xml_begin()
                   7960: 
                   7961: Returns the needed doctype and <html>
                   7962: 
                   7963: Inputs: none
                   7964: 
                   7965: =cut
                   7966: 
                   7967: sub xml_begin {
1.1168    raeburn  7968:     my ($is_frameset) = @_;
1.341     albertel 7969:     my $output='';
                   7970: 
                   7971:     if ($env{'browser.mathml'}) {
                   7972: 	$output='<?xml version="1.0"?>'
                   7973:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7974: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7975:             
                   7976: #	    .'<!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">] >'
                   7977: 	    .'<!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">'
                   7978:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7979: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168    raeburn  7980:     } elsif ($is_frameset) {
                   7981:         $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   7982:                 '<html>'."\n";
1.341     albertel 7983:     } else {
1.1168    raeburn  7984: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
                   7985:                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341     albertel 7986:     }
                   7987:     return $output;
                   7988: }
1.340     albertel 7989: 
                   7990: =pod
                   7991: 
1.306     albertel 7992: =item * &start_page()
                   7993: 
                   7994: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7995: 
1.648     raeburn  7996: Inputs:
                   7997: 
                   7998: =over 4
                   7999: 
                   8000: $title - optional title for the page
                   8001: 
                   8002: $head_extra - optional extra HTML to incude inside the <head>
                   8003: 
                   8004: $args - additional optional args supported are:
                   8005: 
                   8006: =over 8
                   8007: 
                   8008:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 8009:                                     arg on
1.814     bisitz   8010:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  8011:              add_entries    -> additional attributes to add to the  <body>
                   8012:              domain         -> force to color decorate a page for a 
1.317     albertel 8013:                                     specific domain
1.648     raeburn  8014:              function       -> force usage of a specific rolish color
1.317     albertel 8015:                                     scheme
1.648     raeburn  8016:              redirect       -> see &headtag()
                   8017:              bgcolor        -> override the default page bg color
                   8018:              js_ready       -> return a string ready for being used in 
1.317     albertel 8019:                                     a javascript writeln
1.648     raeburn  8020:              html_encode    -> return a string ready for being used in 
1.320     albertel 8021:                                     a html attribute
1.648     raeburn  8022:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 8023:                                     $forcereg arg
1.648     raeburn  8024:              frameset       -> if true will start with a <frameset>
1.330     albertel 8025:                                     rather than <body>
1.648     raeburn  8026:              skip_phases    -> hash ref of 
1.338     albertel 8027:                                     head -> skip the <html><head> generation
                   8028:                                     body -> skip all <body> generation
1.648     raeburn  8029:              no_auto_mt_title -> prevent &mt()ing the title arg
                   8030:              inherit_jsmath -> when creating popup window in a page,
                   8031:                                     should it have jsmath forced on by the
                   8032:                                     current page
1.867     kalberla 8033:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  8034:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1096    raeburn  8035:              group          -> includes the current group, if page is for a 
                   8036:                                specific group  
1.361     albertel 8037: 
1.648     raeburn  8038: =back
1.460     albertel 8039: 
1.648     raeburn  8040: =back
1.562     albertel 8041: 
1.306     albertel 8042: =cut
                   8043: 
                   8044: sub start_page {
1.309     albertel 8045:     my ($title,$head_extra,$args) = @_;
1.318     albertel 8046:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 8047: 
1.315     albertel 8048:     $env{'internal.start_page'}++;
1.1096    raeburn  8049:     my ($result,@advtools);
1.964     droeschl 8050: 
1.338     albertel 8051:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168    raeburn  8052:         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338     albertel 8053:     }
                   8054:     
                   8055:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   8056: 	if ($args->{'frameset'}) {
                   8057: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   8058: 						$args->{'add_entries'});
                   8059: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   8060:         } else {
                   8061:             $result .=
                   8062:                 &bodytag($title, 
                   8063:                          $args->{'function'},       $args->{'add_entries'},
                   8064:                          $args->{'only_body'},      $args->{'domain'},
                   8065:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096    raeburn  8066:                          $args->{'bgcolor'},        $args,
                   8067:                          \@advtools);
1.831     bisitz   8068:         }
1.330     albertel 8069:     }
1.338     albertel 8070: 
1.315     albertel 8071:     if ($args->{'js_ready'}) {
1.713     kaisler  8072: 		$result = &js_ready($result);
1.315     albertel 8073:     }
1.320     albertel 8074:     if ($args->{'html_encode'}) {
1.713     kaisler  8075: 		$result = &html_encode($result);
                   8076:     }
                   8077: 
1.813     bisitz   8078:     # Preparation for new and consistent functionlist at top of screen
                   8079:     # if ($args->{'functionlist'}) {
                   8080:     #            $result .= &build_functionlist();
                   8081:     #}
                   8082: 
1.964     droeschl 8083:     # Don't add anything more if only_body wanted or in const space
                   8084:     return $result if    $args->{'only_body'} 
                   8085:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   8086: 
                   8087:     #Breadcrumbs
1.758     kaisler  8088:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   8089: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   8090: 		#if any br links exists, add them to the breadcrumbs
                   8091: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   8092: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   8093: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   8094: 			}
                   8095: 		}
1.1096    raeburn  8096:                 # if @advtools array contains items add then to the breadcrumbs
                   8097:                 if (@advtools > 0) {
                   8098:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   8099:                 }
1.758     kaisler  8100: 
                   8101: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   8102: 		if(exists($args->{'bread_crumbs_component'})){
                   8103: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   8104: 		}else{
                   8105: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   8106: 		}
1.320     albertel 8107:     }
1.315     albertel 8108:     return $result;
1.306     albertel 8109: }
                   8110: 
                   8111: sub end_page {
1.315     albertel 8112:     my ($args) = @_;
                   8113:     $env{'internal.end_page'}++;
1.330     albertel 8114:     my $result;
1.335     albertel 8115:     if ($args->{'discussion'}) {
                   8116: 	my ($target,$parser);
                   8117: 	if (ref($args->{'discussion'})) {
                   8118: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   8119: 				$args->{'discussion'}{'parser'});
                   8120: 	}
                   8121: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   8122:     }
1.330     albertel 8123:     if ($args->{'frameset'}) {
                   8124: 	$result .= '</frameset>';
                   8125:     } else {
1.635     raeburn  8126: 	$result .= &endbodytag($args);
1.330     albertel 8127:     }
1.1080    raeburn  8128:     unless ($args->{'notbody'}) {
                   8129:         $result .= "\n</html>";
                   8130:     }
1.330     albertel 8131: 
1.315     albertel 8132:     if ($args->{'js_ready'}) {
1.317     albertel 8133: 	$result = &js_ready($result);
1.315     albertel 8134:     }
1.335     albertel 8135: 
1.320     albertel 8136:     if ($args->{'html_encode'}) {
                   8137: 	$result = &html_encode($result);
                   8138:     }
1.335     albertel 8139: 
1.315     albertel 8140:     return $result;
                   8141: }
                   8142: 
1.1034    www      8143: sub wishlist_window {
                   8144:     return(<<'ENDWISHLIST');
1.1046    raeburn  8145: <script type="text/javascript">
1.1034    www      8146: // <![CDATA[
                   8147: // <!-- BEGIN LON-CAPA Internal
                   8148: function set_wishlistlink(title, path) {
                   8149:     if (!title) {
                   8150:         title = document.title;
                   8151:         title = title.replace(/^LON-CAPA /,'');
                   8152:     }
1.1175    raeburn  8153:     title = encodeURIComponent(title);
1.1203    raeburn  8154:     title = title.replace("'","\\\'");
1.1034    www      8155:     if (!path) {
                   8156:         path = location.pathname;
                   8157:     }
1.1175    raeburn  8158:     path = encodeURIComponent(path);
1.1203    raeburn  8159:     path = path.replace("'","\\\'");
1.1034    www      8160:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   8161:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   8162: }
                   8163: // END LON-CAPA Internal -->
                   8164: // ]]>
                   8165: </script>
                   8166: ENDWISHLIST
                   8167: }
                   8168: 
1.1030    www      8169: sub modal_window {
                   8170:     return(<<'ENDMODAL');
1.1046    raeburn  8171: <script type="text/javascript">
1.1030    www      8172: // <![CDATA[
                   8173: // <!-- BEGIN LON-CAPA Internal
                   8174: var modalWindow = {
                   8175: 	parent:"body",
                   8176: 	windowId:null,
                   8177: 	content:null,
                   8178: 	width:null,
                   8179: 	height:null,
                   8180: 	close:function()
                   8181: 	{
                   8182: 	        $(".LCmodal-window").remove();
                   8183: 	        $(".LCmodal-overlay").remove();
                   8184: 	},
                   8185: 	open:function()
                   8186: 	{
                   8187: 		var modal = "";
                   8188: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   8189: 		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;\">";
                   8190: 		modal += this.content;
                   8191: 		modal += "</div>";	
                   8192: 
                   8193: 		$(this.parent).append(modal);
                   8194: 
                   8195: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   8196: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   8197: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   8198: 	}
                   8199: };
1.1140    raeburn  8200: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      8201: 	{
1.1203    raeburn  8202:                 source = source.replace("'","&#39;");
1.1030    www      8203: 		modalWindow.windowId = "myModal";
                   8204: 		modalWindow.width = width;
                   8205: 		modalWindow.height = height;
1.1196    raeburn  8206: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030    www      8207: 		modalWindow.open();
1.1208    raeburn  8208: 	};
1.1030    www      8209: // END LON-CAPA Internal -->
                   8210: // ]]>
                   8211: </script>
                   8212: ENDMODAL
                   8213: }
                   8214: 
                   8215: sub modal_link {
1.1140    raeburn  8216:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      8217:     unless ($width) { $width=480; }
                   8218:     unless ($height) { $height=400; }
1.1031    www      8219:     unless ($scrolling) { $scrolling='yes'; }
1.1140    raeburn  8220:     unless ($transparency) { $transparency='true'; }
                   8221: 
1.1074    raeburn  8222:     my $target_attr;
                   8223:     if (defined($target)) {
                   8224:         $target_attr = 'target="'.$target.'"';
                   8225:     }
                   8226:     return <<"ENDLINK";
1.1140    raeburn  8227: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074    raeburn  8228:            $linktext</a>
                   8229: ENDLINK
1.1030    www      8230: }
                   8231: 
1.1032    www      8232: sub modal_adhoc_script {
                   8233:     my ($funcname,$width,$height,$content)=@_;
                   8234:     return (<<ENDADHOC);
1.1046    raeburn  8235: <script type="text/javascript">
1.1032    www      8236: // <![CDATA[
                   8237:         var $funcname = function()
                   8238:         {
                   8239:                 modalWindow.windowId = "myModal";
                   8240:                 modalWindow.width = $width;
                   8241:                 modalWindow.height = $height;
                   8242:                 modalWindow.content = '$content';
                   8243:                 modalWindow.open();
                   8244:         };  
                   8245: // ]]>
                   8246: </script>
                   8247: ENDADHOC
                   8248: }
                   8249: 
1.1041    www      8250: sub modal_adhoc_inner {
                   8251:     my ($funcname,$width,$height,$content)=@_;
                   8252:     my $innerwidth=$width-20;
                   8253:     $content=&js_ready(
1.1140    raeburn  8254:                  &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
                   8255:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   8256:                  $content.
1.1041    www      8257:                  &end_scrollbox().
1.1140    raeburn  8258:                  &end_page()
1.1041    www      8259:              );
                   8260:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   8261: }
                   8262: 
                   8263: sub modal_adhoc_window {
                   8264:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   8265:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   8266:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   8267: }
                   8268: 
                   8269: sub modal_adhoc_launch {
                   8270:     my ($funcname,$width,$height,$content)=@_;
                   8271:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   8272: <script type="text/javascript">
                   8273: // <![CDATA[
                   8274: $funcname();
                   8275: // ]]>
                   8276: </script>
                   8277: ENDLAUNCH
                   8278: }
                   8279: 
                   8280: sub modal_adhoc_close {
                   8281:     return (<<ENDCLOSE);
                   8282: <script type="text/javascript">
                   8283: // <![CDATA[
                   8284: modalWindow.close();
                   8285: // ]]>
                   8286: </script>
                   8287: ENDCLOSE
                   8288: }
                   8289: 
1.1038    www      8290: sub togglebox_script {
                   8291:    return(<<ENDTOGGLE);
                   8292: <script type="text/javascript"> 
                   8293: // <![CDATA[
                   8294: function LCtoggleDisplay(id,hidetext,showtext) {
                   8295:    link = document.getElementById(id + "link").childNodes[0];
                   8296:    with (document.getElementById(id).style) {
                   8297:       if (display == "none" ) {
                   8298:           display = "inline";
                   8299:           link.nodeValue = hidetext;
                   8300:         } else {
                   8301:           display = "none";
                   8302:           link.nodeValue = showtext;
                   8303:        }
                   8304:    }
                   8305: }
                   8306: // ]]>
                   8307: </script>
                   8308: ENDTOGGLE
                   8309: }
                   8310: 
1.1039    www      8311: sub start_togglebox {
                   8312:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   8313:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   8314:     unless ($showtext) { $showtext=&mt('show'); }
                   8315:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   8316:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   8317:     return &start_data_table().
                   8318:            &start_data_table_header_row().
                   8319:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   8320:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   8321:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   8322:            &end_data_table_header_row().
                   8323:            '<tr id="'.$id.'" style="display:none""><td>';
                   8324: }
                   8325: 
                   8326: sub end_togglebox {
                   8327:     return '</td></tr>'.&end_data_table();
                   8328: }
                   8329: 
1.1041    www      8330: sub LCprogressbar_script {
1.1045    www      8331:    my ($id)=@_;
1.1041    www      8332:    return(<<ENDPROGRESS);
                   8333: <script type="text/javascript">
                   8334: // <![CDATA[
1.1045    www      8335: \$('#progressbar$id').progressbar({
1.1041    www      8336:   value: 0,
                   8337:   change: function(event, ui) {
                   8338:     var newVal = \$(this).progressbar('option', 'value');
                   8339:     \$('.pblabel', this).text(LCprogressTxt);
                   8340:   }
                   8341: });
                   8342: // ]]>
                   8343: </script>
                   8344: ENDPROGRESS
                   8345: }
                   8346: 
                   8347: sub LCprogressbarUpdate_script {
                   8348:    return(<<ENDPROGRESSUPDATE);
                   8349: <style type="text/css">
                   8350: .ui-progressbar { position:relative; }
                   8351: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   8352: </style>
                   8353: <script type="text/javascript">
                   8354: // <![CDATA[
1.1045    www      8355: var LCprogressTxt='---';
                   8356: 
                   8357: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      8358:    LCprogressTxt=progresstext;
1.1045    www      8359:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      8360: }
                   8361: // ]]>
                   8362: </script>
                   8363: ENDPROGRESSUPDATE
                   8364: }
                   8365: 
1.1042    www      8366: my $LClastpercent;
1.1045    www      8367: my $LCidcnt;
                   8368: my $LCcurrentid;
1.1042    www      8369: 
1.1041    www      8370: sub LCprogressbar {
1.1042    www      8371:     my ($r)=(@_);
                   8372:     $LClastpercent=0;
1.1045    www      8373:     $LCidcnt++;
                   8374:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      8375:     my $starting=&mt('Starting');
                   8376:     my $content=(<<ENDPROGBAR);
1.1045    www      8377:   <div id="progressbar$LCcurrentid">
1.1041    www      8378:     <span class="pblabel">$starting</span>
                   8379:   </div>
                   8380: ENDPROGBAR
1.1045    www      8381:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      8382: }
                   8383: 
                   8384: sub LCprogressbarUpdate {
1.1042    www      8385:     my ($r,$val,$text)=@_;
                   8386:     unless ($val) { 
                   8387:        if ($LClastpercent) {
                   8388:            $val=$LClastpercent;
                   8389:        } else {
                   8390:            $val=0;
                   8391:        }
                   8392:     }
1.1041    www      8393:     if ($val<0) { $val=0; }
                   8394:     if ($val>100) { $val=0; }
1.1042    www      8395:     $LClastpercent=$val;
1.1041    www      8396:     unless ($text) { $text=$val.'%'; }
                   8397:     $text=&js_ready($text);
1.1044    www      8398:     &r_print($r,<<ENDUPDATE);
1.1041    www      8399: <script type="text/javascript">
                   8400: // <![CDATA[
1.1045    www      8401: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      8402: // ]]>
                   8403: </script>
                   8404: ENDUPDATE
1.1035    www      8405: }
                   8406: 
1.1042    www      8407: sub LCprogressbarClose {
                   8408:     my ($r)=@_;
                   8409:     $LClastpercent=0;
1.1044    www      8410:     &r_print($r,<<ENDCLOSE);
1.1042    www      8411: <script type="text/javascript">
                   8412: // <![CDATA[
1.1045    www      8413: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      8414: // ]]>
                   8415: </script>
                   8416: ENDCLOSE
1.1044    www      8417: }
                   8418: 
                   8419: sub r_print {
                   8420:     my ($r,$to_print)=@_;
                   8421:     if ($r) {
                   8422:       $r->print($to_print);
                   8423:       $r->rflush();
                   8424:     } else {
                   8425:       print($to_print);
                   8426:     }
1.1042    www      8427: }
                   8428: 
1.320     albertel 8429: sub html_encode {
                   8430:     my ($result) = @_;
                   8431: 
1.322     albertel 8432:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 8433:     
                   8434:     return $result;
                   8435: }
1.1044    www      8436: 
1.317     albertel 8437: sub js_ready {
                   8438:     my ($result) = @_;
                   8439: 
1.323     albertel 8440:     $result =~ s/[\n\r]/ /xmsg;
                   8441:     $result =~ s/\\/\\\\/xmsg;
                   8442:     $result =~ s/'/\\'/xmsg;
1.372     albertel 8443:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 8444:     
                   8445:     return $result;
                   8446: }
                   8447: 
1.315     albertel 8448: sub validate_page {
                   8449:     if (  exists($env{'internal.start_page'})
1.316     albertel 8450: 	  &&     $env{'internal.start_page'} > 1) {
                   8451: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 8452: 				 $env{'internal.start_page'}.' '.
1.316     albertel 8453: 				 $ENV{'request.filename'});
1.315     albertel 8454:     }
                   8455:     if (  exists($env{'internal.end_page'})
1.316     albertel 8456: 	  &&     $env{'internal.end_page'} > 1) {
                   8457: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 8458: 				 $env{'internal.end_page'}.' '.
1.316     albertel 8459: 				 $env{'request.filename'});
1.315     albertel 8460:     }
                   8461:     if (     exists($env{'internal.start_page'})
                   8462: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 8463: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   8464: 				 $env{'request.filename'});
1.315     albertel 8465:     }
                   8466:     if (   ! exists($env{'internal.start_page'})
                   8467: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 8468: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   8469: 				 $env{'request.filename'});
1.315     albertel 8470:     }
1.306     albertel 8471: }
1.315     albertel 8472: 
1.996     www      8473: 
                   8474: sub start_scrollbox {
1.1140    raeburn  8475:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  8476:     unless ($outerwidth) { $outerwidth='520px'; }
                   8477:     unless ($width) { $width='500px'; }
                   8478:     unless ($height) { $height='200px'; }
1.1075    raeburn  8479:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  8480:     if ($id ne '') {
1.1140    raeburn  8481:         $table_id = ' id="table_'.$id.'"';
1.1137    raeburn  8482:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  8483:     }
1.1075    raeburn  8484:     if ($bgcolor ne '') {
                   8485:         $tdcol = "background-color: $bgcolor;";
                   8486:     }
1.1137    raeburn  8487:     my $nicescroll_js;
                   8488:     if ($env{'browser.mobile'}) {
1.1140    raeburn  8489:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   8490:     }
                   8491:     return <<"END";
                   8492: $nicescroll_js
                   8493: 
                   8494: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
                   8495: <div style="overflow:auto; width:$width; height:$height;"$div_id>
                   8496: END
                   8497: }
                   8498: 
                   8499: sub end_scrollbox {
                   8500:     return '</div></td></tr></table>';
                   8501: }
                   8502: 
                   8503: sub nicescroll_javascript {
                   8504:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   8505:     my %options;
                   8506:     if (ref($cursor) eq 'HASH') {
                   8507:         %options = %{$cursor};
                   8508:     }
                   8509:     unless ($options{'railalign'} =~ /^left|right$/) {
                   8510:         $options{'railalign'} = 'left';
                   8511:     }
                   8512:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8513:         my $function  = &get_users_function();
                   8514:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138    raeburn  8515:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140    raeburn  8516:             $options{'cursorcolor'} = '#00F';
1.1138    raeburn  8517:         }
1.1140    raeburn  8518:     }
                   8519:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   8520:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138    raeburn  8521:             $options{'cursoropacity'}='1.0';
                   8522:         }
1.1140    raeburn  8523:     } else {
                   8524:         $options{'cursoropacity'}='1.0';
                   8525:     }
                   8526:     if ($options{'cursorfixedheight'} eq 'none') {
                   8527:         delete($options{'cursorfixedheight'});
                   8528:     } else {
                   8529:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   8530:     }
                   8531:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   8532:         delete($options{'railoffset'});
                   8533:     }
                   8534:     my @niceoptions;
                   8535:     while (my($key,$value) = each(%options)) {
                   8536:         if ($value =~ /^\{.+\}$/) {
                   8537:             push(@niceoptions,$key.':'.$value);
1.1138    raeburn  8538:         } else {
1.1140    raeburn  8539:             push(@niceoptions,$key.':"'.$value.'"');
1.1138    raeburn  8540:         }
1.1140    raeburn  8541:     }
                   8542:     my $nicescroll_js = '
1.1137    raeburn  8543: $(document).ready(
1.1140    raeburn  8544:       function() {
                   8545:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   8546:       }
1.1137    raeburn  8547: );
                   8548: ';
1.1140    raeburn  8549:     if ($framecheck) {
                   8550:         $nicescroll_js .= '
                   8551: function expand_div(caller) {
                   8552:     if (top === self) {
                   8553:         document.getElementById("'.$id.'").style.width = "auto";
                   8554:         document.getElementById("'.$id.'").style.height = "auto";
                   8555:     } else {
                   8556:         try {
                   8557:             if (parent.frames) {
                   8558:                 if (parent.frames.length > 1) {
                   8559:                     var framesrc = parent.frames[1].location.href;
                   8560:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   8561:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   8562:                         document.getElementById("'.$id.'").style.width = "auto";
                   8563:                         document.getElementById("'.$id.'").style.height = "auto";
                   8564:                     }
                   8565:                 }
                   8566:             }
                   8567:         } catch (e) {
                   8568:             return;
                   8569:         }
1.1137    raeburn  8570:     }
1.1140    raeburn  8571:     return;
1.996     www      8572: }
1.1140    raeburn  8573: ';
                   8574:     }
                   8575:     if ($needjsready) {
                   8576:         $nicescroll_js = '
                   8577: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   8578:     } else {
                   8579:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   8580:     }
                   8581:     return $nicescroll_js;
1.996     www      8582: }
                   8583: 
1.318     albertel 8584: sub simple_error_page {
1.1150    bisitz   8585:     my ($r,$title,$msg,$args) = @_;
1.1151    raeburn  8586:     if (ref($args) eq 'HASH') {
                   8587:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
                   8588:     } else {
                   8589:         $msg = &mt($msg);
                   8590:     }
1.1150    bisitz   8591: 
1.318     albertel 8592:     my $page =
                   8593: 	&Apache::loncommon::start_page($title).
1.1150    bisitz   8594: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 8595: 	&Apache::loncommon::end_page();
                   8596:     if (ref($r)) {
                   8597: 	$r->print($page);
1.327     albertel 8598: 	return;
1.318     albertel 8599:     }
                   8600:     return $page;
                   8601: }
1.347     albertel 8602: 
                   8603: {
1.610     albertel 8604:     my @row_count;
1.961     onken    8605: 
                   8606:     sub start_data_table_count {
                   8607:         unshift(@row_count, 0);
                   8608:         return;
                   8609:     }
                   8610: 
                   8611:     sub end_data_table_count {
                   8612:         shift(@row_count);
                   8613:         return;
                   8614:     }
                   8615: 
1.347     albertel 8616:     sub start_data_table {
1.1018    raeburn  8617: 	my ($add_class,$id) = @_;
1.422     albertel 8618: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  8619:         my $table_id;
                   8620:         if (defined($id)) {
                   8621:             $table_id = ' id="'.$id.'"';
                   8622:         }
1.961     onken    8623: 	&start_data_table_count();
1.1018    raeburn  8624: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 8625:     }
                   8626: 
                   8627:     sub end_data_table {
1.961     onken    8628: 	&end_data_table_count();
1.389     albertel 8629: 	return '</table>'."\n";;
1.347     albertel 8630:     }
                   8631: 
                   8632:     sub start_data_table_row {
1.974     wenzelju 8633: 	my ($add_class, $id) = @_;
1.610     albertel 8634: 	$row_count[0]++;
                   8635: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   8636: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 8637:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8638:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 8639:     }
1.471     banghart 8640:     
                   8641:     sub continue_data_table_row {
1.974     wenzelju 8642: 	my ($add_class, $id) = @_;
1.610     albertel 8643: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 8644: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   8645:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8646:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 8647:     }
1.347     albertel 8648: 
                   8649:     sub end_data_table_row {
1.389     albertel 8650: 	return '</tr>'."\n";;
1.347     albertel 8651:     }
1.367     www      8652: 
1.421     albertel 8653:     sub start_data_table_empty_row {
1.707     bisitz   8654: #	$row_count[0]++;
1.421     albertel 8655: 	return  '<tr class="LC_empty_row" >'."\n";;
                   8656:     }
                   8657: 
                   8658:     sub end_data_table_empty_row {
                   8659: 	return '</tr>'."\n";;
                   8660:     }
                   8661: 
1.367     www      8662:     sub start_data_table_header_row {
1.389     albertel 8663: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      8664:     }
                   8665: 
                   8666:     sub end_data_table_header_row {
1.389     albertel 8667: 	return '</tr>'."\n";;
1.367     www      8668:     }
1.890     droeschl 8669: 
                   8670:     sub data_table_caption {
                   8671:         my $caption = shift;
                   8672:         return "<caption class=\"LC_caption\">$caption</caption>";
                   8673:     }
1.347     albertel 8674: }
                   8675: 
1.548     albertel 8676: =pod
                   8677: 
                   8678: =item * &inhibit_menu_check($arg)
                   8679: 
                   8680: Checks for a inhibitmenu state and generates output to preserve it
                   8681: 
                   8682: Inputs:         $arg - can be any of
                   8683:                      - undef - in which case the return value is a string 
                   8684:                                to add  into arguments list of a uri
                   8685:                      - 'input' - in which case the return value is a HTML
                   8686:                                  <form> <input> field of type hidden to
                   8687:                                  preserve the value
                   8688:                      - a url - in which case the return value is the url with
                   8689:                                the neccesary cgi args added to preserve the
                   8690:                                inhibitmenu state
                   8691:                      - a ref to a url - no return value, but the string is
                   8692:                                         updated to include the neccessary cgi
                   8693:                                         args to preserve the inhibitmenu state
                   8694: 
                   8695: =cut
                   8696: 
                   8697: sub inhibit_menu_check {
                   8698:     my ($arg) = @_;
                   8699:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   8700:     if ($arg eq 'input') {
                   8701: 	if ($env{'form.inhibitmenu'}) {
                   8702: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   8703: 	} else {
                   8704: 	    return
                   8705: 	}
                   8706:     }
                   8707:     if ($env{'form.inhibitmenu'}) {
                   8708: 	if (ref($arg)) {
                   8709: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8710: 	} elsif ($arg eq '') {
                   8711: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8712: 	} else {
                   8713: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8714: 	}
                   8715:     }
                   8716:     if (!ref($arg)) {
                   8717: 	return $arg;
                   8718:     }
                   8719: }
                   8720: 
1.251     albertel 8721: ###############################################
1.182     matthew  8722: 
                   8723: =pod
                   8724: 
1.549     albertel 8725: =back
                   8726: 
                   8727: =head1 User Information Routines
                   8728: 
                   8729: =over 4
                   8730: 
1.405     albertel 8731: =item * &get_users_function()
1.182     matthew  8732: 
                   8733: Used by &bodytag to determine the current users primary role.
                   8734: Returns either 'student','coordinator','admin', or 'author'.
                   8735: 
                   8736: =cut
                   8737: 
                   8738: ###############################################
                   8739: sub get_users_function {
1.815     tempelho 8740:     my $function = 'norole';
1.818     tempelho 8741:     if ($env{'request.role'}=~/^(st)/) {
                   8742:         $function='student';
                   8743:     }
1.907     raeburn  8744:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8745:         $function='coordinator';
                   8746:     }
1.258     albertel 8747:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8748:         $function='admin';
                   8749:     }
1.826     bisitz   8750:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8751:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8752:         $function='author';
                   8753:     }
                   8754:     return $function;
1.54      www      8755: }
1.99      www      8756: 
                   8757: ###############################################
                   8758: 
1.233     raeburn  8759: =pod
                   8760: 
1.821     raeburn  8761: =item * &show_course()
                   8762: 
                   8763: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8764: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8765: 
                   8766: Inputs:
                   8767: None
                   8768: 
                   8769: Outputs:
                   8770: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8771: 
                   8772: =cut
                   8773: 
                   8774: ###############################################
                   8775: sub show_course {
                   8776:     my $course = !$env{'user.adv'};
                   8777:     if (!$env{'user.adv'}) {
                   8778:         foreach my $env (keys(%env)) {
                   8779:             next if ($env !~ m/^user\.priv\./);
                   8780:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8781:                 $course = 0;
                   8782:                 last;
                   8783:             }
                   8784:         }
                   8785:     }
                   8786:     return $course;
                   8787: }
                   8788: 
                   8789: ###############################################
                   8790: 
                   8791: =pod
                   8792: 
1.542     raeburn  8793: =item * &check_user_status()
1.274     raeburn  8794: 
                   8795: Determines current status of supplied role for a
                   8796: specific user. Roles can be active, previous or future.
                   8797: 
                   8798: Inputs: 
                   8799: user's domain, user's username, course's domain,
1.375     raeburn  8800: course's number, optional section ID.
1.274     raeburn  8801: 
                   8802: Outputs:
                   8803: role status: active, previous or future. 
                   8804: 
                   8805: =cut
                   8806: 
                   8807: sub check_user_status {
1.412     raeburn  8808:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8809:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202    raeburn  8810:     my @uroles = keys(%userinfo);
1.274     raeburn  8811:     my $srchstr;
                   8812:     my $active_chk = 'none';
1.412     raeburn  8813:     my $now = time;
1.274     raeburn  8814:     if (@uroles > 0) {
1.908     raeburn  8815:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8816:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8817:         } else {
1.412     raeburn  8818:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8819:         }
                   8820:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8821:             my $role_end = 0;
                   8822:             my $role_start = 0;
                   8823:             $active_chk = 'active';
1.412     raeburn  8824:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8825:                 $role_end = $1;
                   8826:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8827:                     $role_start = $1;
1.274     raeburn  8828:                 }
                   8829:             }
                   8830:             if ($role_start > 0) {
1.412     raeburn  8831:                 if ($now < $role_start) {
1.274     raeburn  8832:                     $active_chk = 'future';
                   8833:                 }
                   8834:             }
                   8835:             if ($role_end > 0) {
1.412     raeburn  8836:                 if ($now > $role_end) {
1.274     raeburn  8837:                     $active_chk = 'previous';
                   8838:                 }
                   8839:             }
                   8840:         }
                   8841:     }
                   8842:     return $active_chk;
                   8843: }
                   8844: 
                   8845: ###############################################
                   8846: 
                   8847: =pod
                   8848: 
1.405     albertel 8849: =item * &get_sections()
1.233     raeburn  8850: 
                   8851: Determines all the sections for a course including
                   8852: sections with students and sections containing other roles.
1.419     raeburn  8853: Incoming parameters: 
                   8854: 
                   8855: 1. domain
                   8856: 2. course number 
                   8857: 3. reference to array containing roles for which sections should 
                   8858: be gathered (optional).
                   8859: 4. reference to array containing status types for which sections 
                   8860: should be gathered (optional).
                   8861: 
                   8862: If the third argument is undefined, sections are gathered for any role. 
                   8863: If the fourth argument is undefined, sections are gathered for any status.
                   8864: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  8865:  
1.374     raeburn  8866: Returns section hash (keys are section IDs, values are
                   8867: number of users in each section), subject to the
1.419     raeburn  8868: optional roles filter, optional status filter 
1.233     raeburn  8869: 
                   8870: =cut
                   8871: 
                   8872: ###############################################
                   8873: sub get_sections {
1.419     raeburn  8874:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 8875:     if (!defined($cdom) || !defined($cnum)) {
                   8876:         my $cid =  $env{'request.course.id'};
                   8877: 
                   8878: 	return if (!defined($cid));
                   8879: 
                   8880:         $cdom = $env{'course.'.$cid.'.domain'};
                   8881:         $cnum = $env{'course.'.$cid.'.num'};
                   8882:     }
                   8883: 
                   8884:     my %sectioncount;
1.419     raeburn  8885:     my $now = time;
1.240     albertel 8886: 
1.1118    raeburn  8887:     my $check_students = 1;
                   8888:     my $only_students = 0;
                   8889:     if (ref($possible_roles) eq 'ARRAY') {
                   8890:         if (grep(/^st$/,@{$possible_roles})) {
                   8891:             if (@{$possible_roles} == 1) {
                   8892:                 $only_students = 1;
                   8893:             }
                   8894:         } else {
                   8895:             $check_students = 0;
                   8896:         }
                   8897:     }
                   8898: 
                   8899:     if ($check_students) { 
1.276     albertel 8900: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 8901: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   8902: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  8903:         my $start_index = &Apache::loncoursedata::CL_START();
                   8904:         my $end_index = &Apache::loncoursedata::CL_END();
                   8905:         my $status;
1.366     albertel 8906: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  8907: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   8908: 				                     $data->[$status_index],
                   8909:                                                      $data->[$start_index],
                   8910:                                                      $data->[$end_index]);
                   8911:             if ($stu_status eq 'Active') {
                   8912:                 $status = 'active';
                   8913:             } elsif ($end < $now) {
                   8914:                 $status = 'previous';
                   8915:             } elsif ($start > $now) {
                   8916:                 $status = 'future';
                   8917:             } 
                   8918: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   8919:                 if ((!defined($possible_status)) || (($status ne '') && 
                   8920:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   8921: 		    $sectioncount{$section}++;
                   8922:                 }
1.240     albertel 8923: 	    }
                   8924: 	}
                   8925:     }
1.1118    raeburn  8926:     if ($only_students) {
                   8927:         return %sectioncount;
                   8928:     }
1.240     albertel 8929:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8930:     foreach my $user (sort(keys(%courseroles))) {
                   8931: 	if ($user !~ /^(\w{2})/) { next; }
                   8932: 	my ($role) = ($user =~ /^(\w{2})/);
                   8933: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  8934: 	my ($section,$status);
1.240     albertel 8935: 	if ($role eq 'cr' &&
                   8936: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   8937: 	    $section=$1;
                   8938: 	}
                   8939: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   8940: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  8941:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   8942:         if ($end == -1 && $start == -1) {
                   8943:             next; #deleted role
                   8944:         }
                   8945:         if (!defined($possible_status)) { 
                   8946:             $sectioncount{$section}++;
                   8947:         } else {
                   8948:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   8949:                 $status = 'active';
                   8950:             } elsif ($end < $now) {
                   8951:                 $status = 'future';
                   8952:             } elsif ($start > $now) {
                   8953:                 $status = 'previous';
                   8954:             }
                   8955:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   8956:                 $sectioncount{$section}++;
                   8957:             }
                   8958:         }
1.233     raeburn  8959:     }
1.366     albertel 8960:     return %sectioncount;
1.233     raeburn  8961: }
                   8962: 
1.274     raeburn  8963: ###############################################
1.294     raeburn  8964: 
                   8965: =pod
1.405     albertel 8966: 
                   8967: =item * &get_course_users()
                   8968: 
1.275     raeburn  8969: Retrieves usernames:domains for users in the specified course
                   8970: with specific role(s), and access status. 
                   8971: 
                   8972: Incoming parameters:
1.277     albertel 8973: 1. course domain
                   8974: 2. course number
                   8975: 3. access status: users must have - either active, 
1.275     raeburn  8976: previous, future, or all.
1.277     albertel 8977: 4. reference to array of permissible roles
1.288     raeburn  8978: 5. reference to array of section restrictions (optional)
                   8979: 6. reference to results object (hash of hashes).
                   8980: 7. reference to optional userdata hash
1.609     raeburn  8981: 8. reference to optional statushash
1.630     raeburn  8982: 9. flag if privileged users (except those set to unhide in
                   8983:    course settings) should be excluded    
1.609     raeburn  8984: Keys of top level results hash are roles.
1.275     raeburn  8985: Keys of inner hashes are username:domain, with 
                   8986: values set to access type.
1.288     raeburn  8987: Optional userdata hash returns an array with arguments in the 
                   8988: same order as loncoursedata::get_classlist() for student data.
                   8989: 
1.609     raeburn  8990: Optional statushash returns
                   8991: 
1.288     raeburn  8992: Entries for end, start, section and status are blank because
                   8993: of the possibility of multiple values for non-student roles.
                   8994: 
1.275     raeburn  8995: =cut
1.405     albertel 8996: 
1.275     raeburn  8997: ###############################################
1.405     albertel 8998: 
1.275     raeburn  8999: sub get_course_users {
1.630     raeburn  9000:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  9001:     my %idx = ();
1.419     raeburn  9002:     my %seclists;
1.288     raeburn  9003: 
                   9004:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   9005:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   9006:     $idx{end} = &Apache::loncoursedata::CL_END();
                   9007:     $idx{start} = &Apache::loncoursedata::CL_START();
                   9008:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   9009:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   9010:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   9011:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   9012: 
1.290     albertel 9013:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 9014:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  9015:         my $now = time;
1.277     albertel 9016:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  9017:             my $match = 0;
1.412     raeburn  9018:             my $secmatch = 0;
1.419     raeburn  9019:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  9020:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  9021:             if ($section eq '') {
                   9022:                 $section = 'none';
                   9023:             }
1.291     albertel 9024:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 9025:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  9026:                     $secmatch = 1;
                   9027:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 9028:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  9029:                         $secmatch = 1;
                   9030:                     }
                   9031:                 } else {  
1.419     raeburn  9032: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  9033: 		        $secmatch = 1;
                   9034:                     }
1.290     albertel 9035: 		}
1.412     raeburn  9036:                 if (!$secmatch) {
                   9037:                     next;
                   9038:                 }
1.419     raeburn  9039:             }
1.275     raeburn  9040:             if (defined($$types{'active'})) {
1.288     raeburn  9041:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  9042:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  9043:                     $match = 1;
1.275     raeburn  9044:                 }
                   9045:             }
                   9046:             if (defined($$types{'previous'})) {
1.609     raeburn  9047:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  9048:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  9049:                     $match = 1;
1.275     raeburn  9050:                 }
                   9051:             }
                   9052:             if (defined($$types{'future'})) {
1.609     raeburn  9053:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  9054:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  9055:                     $match = 1;
1.275     raeburn  9056:                 }
                   9057:             }
1.609     raeburn  9058:             if ($match) {
                   9059:                 push(@{$seclists{$student}},$section);
                   9060:                 if (ref($userdata) eq 'HASH') {
                   9061:                     $$userdata{$student} = $$classlist{$student};
                   9062:                 }
                   9063:                 if (ref($statushash) eq 'HASH') {
                   9064:                     $statushash->{$student}{'st'}{$section} = $status;
                   9065:                 }
1.288     raeburn  9066:             }
1.275     raeburn  9067:         }
                   9068:     }
1.412     raeburn  9069:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  9070:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9071:         my $now = time;
1.609     raeburn  9072:         my %displaystatus = ( previous => 'Expired',
                   9073:                               active   => 'Active',
                   9074:                               future   => 'Future',
                   9075:                             );
1.1121    raeburn  9076:         my (%nothide,@possdoms);
1.630     raeburn  9077:         if ($hidepriv) {
                   9078:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   9079:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   9080:                 if ($user !~ /:/) {
                   9081:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   9082:                 } else {
                   9083:                     $nothide{$user} = 1;
                   9084:                 }
                   9085:             }
1.1121    raeburn  9086:             my @possdoms = ($cdom);
                   9087:             if ($coursehash{'checkforpriv'}) {
                   9088:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   9089:             }
1.630     raeburn  9090:         }
1.439     raeburn  9091:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  9092:             my $match = 0;
1.412     raeburn  9093:             my $secmatch = 0;
1.439     raeburn  9094:             my $status;
1.412     raeburn  9095:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  9096:             $user =~ s/:$//;
1.439     raeburn  9097:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   9098:             if ($end == -1 || $start == -1) {
                   9099:                 next;
                   9100:             }
                   9101:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   9102:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  9103:                 my ($uname,$udom) = split(/:/,$user);
                   9104:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 9105:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  9106:                         $secmatch = 1;
                   9107:                     } elsif ($usec eq '') {
1.420     albertel 9108:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  9109:                             $secmatch = 1;
                   9110:                         }
                   9111:                     } else {
                   9112:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   9113:                             $secmatch = 1;
                   9114:                         }
                   9115:                     }
                   9116:                     if (!$secmatch) {
                   9117:                         next;
                   9118:                     }
1.288     raeburn  9119:                 }
1.419     raeburn  9120:                 if ($usec eq '') {
                   9121:                     $usec = 'none';
                   9122:                 }
1.275     raeburn  9123:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  9124:                     if ($hidepriv) {
1.1121    raeburn  9125:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  9126:                             (!$nothide{$uname.':'.$udom})) {
                   9127:                             next;
                   9128:                         }
                   9129:                     }
1.503     raeburn  9130:                     if ($end > 0 && $end < $now) {
1.439     raeburn  9131:                         $status = 'previous';
                   9132:                     } elsif ($start > $now) {
                   9133:                         $status = 'future';
                   9134:                     } else {
                   9135:                         $status = 'active';
                   9136:                     }
1.277     albertel 9137:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  9138:                         if ($status eq $type) {
1.420     albertel 9139:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  9140:                                 push(@{$$users{$role}{$user}},$type);
                   9141:                             }
1.288     raeburn  9142:                             $match = 1;
                   9143:                         }
                   9144:                     }
1.419     raeburn  9145:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   9146:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   9147: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   9148:                         }
1.420     albertel 9149:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  9150:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   9151:                         }
1.609     raeburn  9152:                         if (ref($statushash) eq 'HASH') {
                   9153:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   9154:                         }
1.275     raeburn  9155:                     }
                   9156:                 }
                   9157:             }
                   9158:         }
1.290     albertel 9159:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  9160:             if ((defined($cdom)) && (defined($cnum))) {
                   9161:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   9162:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   9163:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  9164:                     next if ($owner eq '');
                   9165:                     my ($ownername,$ownerdom);
                   9166:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   9167:                         $ownername = $1;
                   9168:                         $ownerdom = $2;
                   9169:                     } else {
                   9170:                         $ownername = $owner;
                   9171:                         $ownerdom = $cdom;
                   9172:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  9173:                     }
                   9174:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 9175:                     if (defined($userdata) && 
1.609     raeburn  9176: 			!exists($$userdata{$owner})) {
                   9177: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   9178:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   9179:                             push(@{$seclists{$owner}},'none');
                   9180:                         }
                   9181:                         if (ref($statushash) eq 'HASH') {
                   9182:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  9183:                         }
1.290     albertel 9184: 		    }
1.279     raeburn  9185:                 }
                   9186:             }
                   9187:         }
1.419     raeburn  9188:         foreach my $user (keys(%seclists)) {
                   9189:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   9190:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   9191:         }
1.275     raeburn  9192:     }
                   9193:     return;
                   9194: }
                   9195: 
1.288     raeburn  9196: sub get_user_info {
                   9197:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 9198:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   9199: 	&plainname($uname,$udom,'lastname');
1.291     albertel 9200:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  9201:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  9202:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   9203:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  9204:     return;
                   9205: }
1.275     raeburn  9206: 
1.472     raeburn  9207: ###############################################
                   9208: 
                   9209: =pod
                   9210: 
                   9211: =item * &get_user_quota()
                   9212: 
1.1134    raeburn  9213: Retrieves quota assigned for storage of user files.
                   9214: Default is to report quota for portfolio files.
1.472     raeburn  9215: 
                   9216: Incoming parameters:
                   9217: 1. user's username
                   9218: 2. user's domain
1.1134    raeburn  9219: 3. quota name - portfolio, author, or course
1.1136    raeburn  9220:    (if no quota name provided, defaults to portfolio).
1.1165    raeburn  9221: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1136    raeburn  9222:    course
1.472     raeburn  9223: 
                   9224: Returns:
1.1163    raeburn  9225: 1. Disk quota (in MB) assigned to student.
1.536     raeburn  9226: 2. (Optional) Type of setting: custom or default
                   9227:    (individually assigned or default for user's 
                   9228:    institutional status).
                   9229: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   9230:    or student - types as defined in localenroll::inst_usertypes 
                   9231:    for user's domain, which determines default quota for user.
                   9232: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  9233: 
                   9234: If a value has been stored in the user's environment, 
1.536     raeburn  9235: it will return that, otherwise it returns the maximal default
1.1134    raeburn  9236: defined for the user's institutional status(es) in the domain.
1.472     raeburn  9237: 
                   9238: =cut
                   9239: 
                   9240: ###############################################
                   9241: 
                   9242: 
                   9243: sub get_user_quota {
1.1136    raeburn  9244:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  9245:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  9246:     if (!defined($udom)) {
                   9247:         $udom = $env{'user.domain'};
                   9248:     }
                   9249:     if (!defined($uname)) {
                   9250:         $uname = $env{'user.name'};
                   9251:     }
                   9252:     if (($udom eq '' || $uname eq '') ||
                   9253:         ($udom eq 'public') && ($uname eq 'public')) {
                   9254:         $quota = 0;
1.536     raeburn  9255:         $quotatype = 'default';
                   9256:         $defquota = 0; 
1.472     raeburn  9257:     } else {
1.536     raeburn  9258:         my $inststatus;
1.1134    raeburn  9259:         if ($quotaname eq 'course') {
                   9260:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   9261:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   9262:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   9263:             } else {
                   9264:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   9265:                 $quota = $cenv{'internal.uploadquota'};
                   9266:             }
1.536     raeburn  9267:         } else {
1.1134    raeburn  9268:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   9269:                 if ($quotaname eq 'author') {
                   9270:                     $quota = $env{'environment.authorquota'};
                   9271:                 } else {
                   9272:                     $quota = $env{'environment.portfolioquota'};
                   9273:                 }
                   9274:                 $inststatus = $env{'environment.inststatus'};
                   9275:             } else {
                   9276:                 my %userenv = 
                   9277:                     &Apache::lonnet::get('environment',['portfolioquota',
                   9278:                                          'authorquota','inststatus'],$udom,$uname);
                   9279:                 my ($tmp) = keys(%userenv);
                   9280:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   9281:                     if ($quotaname eq 'author') {
                   9282:                         $quota = $userenv{'authorquota'};
                   9283:                     } else {
                   9284:                         $quota = $userenv{'portfolioquota'};
                   9285:                     }
                   9286:                     $inststatus = $userenv{'inststatus'};
                   9287:                 } else {
                   9288:                     undef(%userenv);
                   9289:                 }
                   9290:             }
                   9291:         }
                   9292:         if ($quota eq '' || wantarray) {
                   9293:             if ($quotaname eq 'course') {
                   9294:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165    raeburn  9295:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') || 
                   9296:                     ($crstype eq 'community') || ($crstype eq 'textbook')) { 
1.1136    raeburn  9297:                     $defquota = $domdefs{$crstype.'quota'};
                   9298:                 }
                   9299:                 if ($defquota eq '') {
                   9300:                     $defquota = 500;
                   9301:                 }
1.1134    raeburn  9302:             } else {
                   9303:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   9304:             }
                   9305:             if ($quota eq '') {
                   9306:                 $quota = $defquota;
                   9307:                 $quotatype = 'default';
                   9308:             } else {
                   9309:                 $quotatype = 'custom';
                   9310:             }
1.472     raeburn  9311:         }
                   9312:     }
1.536     raeburn  9313:     if (wantarray) {
                   9314:         return ($quota,$quotatype,$settingstatus,$defquota);
                   9315:     } else {
                   9316:         return $quota;
                   9317:     }
1.472     raeburn  9318: }
                   9319: 
                   9320: ###############################################
                   9321: 
                   9322: =pod
                   9323: 
                   9324: =item * &default_quota()
                   9325: 
1.536     raeburn  9326: Retrieves default quota assigned for storage of user portfolio files,
                   9327: given an (optional) user's institutional status.
1.472     raeburn  9328: 
                   9329: Incoming parameters:
1.1142    raeburn  9330: 
1.472     raeburn  9331: 1. domain
1.536     raeburn  9332: 2. (Optional) institutional status(es).  This is a : separated list of 
                   9333:    status types (e.g., faculty, staff, student etc.)
                   9334:    which apply to the user for whom the default is being retrieved.
                   9335:    If the institutional status string in undefined, the domain
1.1134    raeburn  9336:    default quota will be returned.
                   9337: 3.  quota name - portfolio, author, or course
                   9338:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  9339: 
                   9340: Returns:
1.1142    raeburn  9341: 
1.1163    raeburn  9342: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536     raeburn  9343: 2. (Optional) institutional type which determined the value of the
                   9344:    default quota.
1.472     raeburn  9345: 
                   9346: If a value has been stored in the domain's configuration db,
                   9347: it will return that, otherwise it returns 20 (for backwards 
                   9348: compatibility with domains which have not set up a configuration
1.1163    raeburn  9349: db file; the original statically defined portfolio quota was 20 MB). 
1.472     raeburn  9350: 
1.536     raeburn  9351: If the user's status includes multiple types (e.g., staff and student),
                   9352: the largest default quota which applies to the user determines the
                   9353: default quota returned.
                   9354: 
1.472     raeburn  9355: =cut
                   9356: 
                   9357: ###############################################
                   9358: 
                   9359: 
                   9360: sub default_quota {
1.1134    raeburn  9361:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  9362:     my ($defquota,$settingstatus);
                   9363:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  9364:                                             ['quotas'],$udom);
1.1134    raeburn  9365:     my $key = 'defaultquota';
                   9366:     if ($quotaname eq 'author') {
                   9367:         $key = 'authorquota';
                   9368:     }
1.622     raeburn  9369:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  9370:         if ($inststatus ne '') {
1.765     raeburn  9371:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  9372:             foreach my $item (@statuses) {
1.1134    raeburn  9373:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   9374:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  9375:                         if ($defquota eq '') {
1.1134    raeburn  9376:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  9377:                             $settingstatus = $item;
1.1134    raeburn  9378:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   9379:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  9380:                             $settingstatus = $item;
                   9381:                         }
                   9382:                     }
1.1134    raeburn  9383:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  9384:                     if ($quotahash{'quotas'}{$item} ne '') {
                   9385:                         if ($defquota eq '') {
                   9386:                             $defquota = $quotahash{'quotas'}{$item};
                   9387:                             $settingstatus = $item;
                   9388:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   9389:                             $defquota = $quotahash{'quotas'}{$item};
                   9390:                             $settingstatus = $item;
                   9391:                         }
1.536     raeburn  9392:                     }
                   9393:                 }
                   9394:             }
                   9395:         }
                   9396:         if ($defquota eq '') {
1.1134    raeburn  9397:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   9398:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   9399:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  9400:                 $defquota = $quotahash{'quotas'}{'default'};
                   9401:             }
1.536     raeburn  9402:             $settingstatus = 'default';
1.1139    raeburn  9403:             if ($defquota eq '') {
                   9404:                 if ($quotaname eq 'author') {
                   9405:                     $defquota = 500;
                   9406:                 }
                   9407:             }
1.536     raeburn  9408:         }
                   9409:     } else {
                   9410:         $settingstatus = 'default';
1.1134    raeburn  9411:         if ($quotaname eq 'author') {
                   9412:             $defquota = 500;
                   9413:         } else {
                   9414:             $defquota = 20;
                   9415:         }
1.536     raeburn  9416:     }
                   9417:     if (wantarray) {
                   9418:         return ($defquota,$settingstatus);
1.472     raeburn  9419:     } else {
1.536     raeburn  9420:         return $defquota;
1.472     raeburn  9421:     }
                   9422: }
                   9423: 
1.1135    raeburn  9424: ###############################################
                   9425: 
                   9426: =pod
                   9427: 
1.1136    raeburn  9428: =item * &excess_filesize_warning()
1.1135    raeburn  9429: 
                   9430: Returns warning message if upload of file to authoring space, or copying
1.1136    raeburn  9431: of existing file within authoring space will cause quota for the authoring
1.1146    raeburn  9432: space to be exceeded.
1.1136    raeburn  9433: 
                   9434: Same, if upload of a file directly to a course/community via Course Editor
1.1137    raeburn  9435: will cause quota for uploaded content for the course to be exceeded.
1.1135    raeburn  9436: 
1.1165    raeburn  9437: Inputs: 7 
1.1136    raeburn  9438: 1. username or coursenum
1.1135    raeburn  9439: 2. domain
1.1136    raeburn  9440: 3. context ('author' or 'course')
1.1135    raeburn  9441: 4. filename of file for which action is being requested
                   9442: 5. filesize (kB) of file
                   9443: 6. action being taken: copy or upload.
1.1165    raeburn  9444: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1135    raeburn  9445: 
                   9446: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142    raeburn  9447:          otherwise return null.
                   9448: 
                   9449: =back
1.1135    raeburn  9450: 
                   9451: =cut
                   9452: 
1.1136    raeburn  9453: sub excess_filesize_warning {
1.1165    raeburn  9454:     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136    raeburn  9455:     my $current_disk_usage = 0;
1.1165    raeburn  9456:     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136    raeburn  9457:     if ($context eq 'author') {
                   9458:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   9459:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   9460:     } else {
                   9461:         foreach my $subdir ('docs','supplemental') {
                   9462:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   9463:         }
                   9464:     }
1.1135    raeburn  9465:     $disk_quota = int($disk_quota * 1000);
                   9466:     if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179    bisitz   9467:         return '<p class="LC_warning">'.
1.1135    raeburn  9468:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179    bisitz   9469:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                   9470:                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135    raeburn  9471:                             $disk_quota,$current_disk_usage).
                   9472:                '</p>';
                   9473:     }
                   9474:     return;
                   9475: }
                   9476: 
                   9477: ###############################################
                   9478: 
                   9479: 
1.1136    raeburn  9480: 
                   9481: 
1.384     raeburn  9482: sub get_secgrprole_info {
                   9483:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   9484:     my %sections_count = &get_sections($cdom,$cnum);
                   9485:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   9486:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   9487:     my @groups = sort(keys(%curr_groups));
                   9488:     my $allroles = [];
                   9489:     my $rolehash;
                   9490:     my $accesshash = {
                   9491:                      active => 'Currently has access',
                   9492:                      future => 'Will have future access',
                   9493:                      previous => 'Previously had access',
                   9494:                   };
                   9495:     if ($needroles) {
                   9496:         $rolehash = {'all' => 'all'};
1.385     albertel 9497:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9498: 	if (&Apache::lonnet::error(%user_roles)) {
                   9499: 	    undef(%user_roles);
                   9500: 	}
                   9501:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  9502:             my ($role)=split(/\:/,$item,2);
                   9503:             if ($role eq 'cr') { next; }
                   9504:             if ($role =~ /^cr/) {
                   9505:                 $$rolehash{$role} = (split('/',$role))[3];
                   9506:             } else {
                   9507:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   9508:             }
                   9509:         }
                   9510:         foreach my $key (sort(keys(%{$rolehash}))) {
                   9511:             push(@{$allroles},$key);
                   9512:         }
                   9513:         push (@{$allroles},'st');
                   9514:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   9515:     }
                   9516:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   9517: }
                   9518: 
1.555     raeburn  9519: sub user_picker {
1.994     raeburn  9520:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  9521:     my $currdom = $dom;
                   9522:     my %curr_selected = (
                   9523:                         srchin => 'dom',
1.580     raeburn  9524:                         srchby => 'lastname',
1.555     raeburn  9525:                       );
                   9526:     my $srchterm;
1.625     raeburn  9527:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  9528:         if ($srch->{'srchby'} ne '') {
                   9529:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   9530:         }
                   9531:         if ($srch->{'srchin'} ne '') {
                   9532:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   9533:         }
                   9534:         if ($srch->{'srchtype'} ne '') {
                   9535:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   9536:         }
                   9537:         if ($srch->{'srchdomain'} ne '') {
                   9538:             $currdom = $srch->{'srchdomain'};
                   9539:         }
                   9540:         $srchterm = $srch->{'srchterm'};
                   9541:     }
1.1222    damieng  9542:     my %html_lt=&Apache::lonlocal::texthash(
1.573     raeburn  9543:                     'usr'       => 'Search criteria',
1.563     raeburn  9544:                     'doma'      => 'Domain/institution to search',
1.558     albertel 9545:                     'uname'     => 'username',
                   9546:                     'lastname'  => 'last name',
1.555     raeburn  9547:                     'lastfirst' => 'last name, first name',
1.558     albertel 9548:                     'crs'       => 'in this course',
1.576     raeburn  9549:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 9550:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  9551:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 9552:                     'exact'     => 'is',
                   9553:                     'contains'  => 'contains',
1.569     raeburn  9554:                     'begins'    => 'begins with',
1.1222    damieng  9555:                                        );
                   9556:     my %js_lt=&Apache::lonlocal::texthash(
1.571     raeburn  9557:                     'youm'      => "You must include some text to search for.",
                   9558:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   9559:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   9560:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   9561:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   9562:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   9563:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   9564:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  9565:                                        );
1.1222    damieng  9566:     &html_escape(\%html_lt);
                   9567:     &js_escape(\%js_lt);
1.563     raeburn  9568:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   9569:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  9570: 
                   9571:     my @srchins = ('crs','dom','alc','instd');
                   9572: 
                   9573:     foreach my $option (@srchins) {
                   9574:         # FIXME 'alc' option unavailable until 
                   9575:         #       loncreateuser::print_user_query_page()
                   9576:         #       has been completed.
                   9577:         next if ($option eq 'alc');
1.880     raeburn  9578:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  9579:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  9580:         if ($curr_selected{'srchin'} eq $option) {
                   9581:             $srchinsel .= ' 
1.1222    damieng  9582:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563     raeburn  9583:         } else {
                   9584:             $srchinsel .= '
1.1222    damieng  9585:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563     raeburn  9586:         }
1.555     raeburn  9587:     }
1.563     raeburn  9588:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  9589: 
                   9590:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  9591:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  9592:         if ($curr_selected{'srchby'} eq $option) {
                   9593:             $srchbysel .= '
1.1222    damieng  9594:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  9595:         } else {
                   9596:             $srchbysel .= '
1.1222    damieng  9597:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  9598:          }
                   9599:     }
                   9600:     $srchbysel .= "\n  </select>\n";
                   9601: 
                   9602:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  9603:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  9604:         if ($curr_selected{'srchtype'} eq $option) {
                   9605:             $srchtypesel .= '
1.1222    damieng  9606:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  9607:         } else {
                   9608:             $srchtypesel .= '
1.1222    damieng  9609:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  9610:         }
                   9611:     }
                   9612:     $srchtypesel .= "\n  </select>\n";
                   9613: 
1.558     albertel 9614:     my ($newuserscript,$new_user_create);
1.994     raeburn  9615:     my $context_dom = $env{'request.role.domain'};
                   9616:     if ($context eq 'requestcrs') {
                   9617:         if ($env{'form.coursedom'} ne '') { 
                   9618:             $context_dom = $env{'form.coursedom'};
                   9619:         }
                   9620:     }
1.556     raeburn  9621:     if ($forcenewuser) {
1.576     raeburn  9622:         if (ref($srch) eq 'HASH') {
1.994     raeburn  9623:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  9624:                 if ($cancreate) {
                   9625:                     $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>';
                   9626:                 } else {
1.799     bisitz   9627:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  9628:                     my %usertypetext = (
                   9629:                         official   => 'institutional',
                   9630:                         unofficial => 'non-institutional',
                   9631:                     );
1.799     bisitz   9632:                     $new_user_create = '<p class="LC_warning">'
                   9633:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   9634:                                       .' '
                   9635:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   9636:                                           ,'<a href="'.$helplink.'">','</a>')
                   9637:                                       .'</p><br />';
1.627     raeburn  9638:                 }
1.576     raeburn  9639:             }
                   9640:         }
                   9641: 
1.556     raeburn  9642:         $newuserscript = <<"ENDSCRIPT";
                   9643: 
1.570     raeburn  9644: function setSearch(createnew,callingForm) {
1.556     raeburn  9645:     if (createnew == 1) {
1.570     raeburn  9646:         for (var i=0; i<callingForm.srchby.length; i++) {
                   9647:             if (callingForm.srchby.options[i].value == 'uname') {
                   9648:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  9649:             }
                   9650:         }
1.570     raeburn  9651:         for (var i=0; i<callingForm.srchin.length; i++) {
                   9652:             if ( callingForm.srchin.options[i].value == 'dom') {
                   9653: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  9654:             }
                   9655:         }
1.570     raeburn  9656:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   9657:             if (callingForm.srchtype.options[i].value == 'exact') {
                   9658:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  9659:             }
                   9660:         }
1.570     raeburn  9661:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  9662:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  9663:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  9664:             }
                   9665:         }
                   9666:     }
                   9667: }
                   9668: ENDSCRIPT
1.558     albertel 9669: 
1.556     raeburn  9670:     }
                   9671: 
1.555     raeburn  9672:     my $output = <<"END_BLOCK";
1.556     raeburn  9673: <script type="text/javascript">
1.824     bisitz   9674: // <![CDATA[
1.570     raeburn  9675: function validateEntry(callingForm) {
1.558     albertel 9676: 
1.556     raeburn  9677:     var checkok = 1;
1.558     albertel 9678:     var srchin;
1.570     raeburn  9679:     for (var i=0; i<callingForm.srchin.length; i++) {
                   9680: 	if ( callingForm.srchin[i].checked ) {
                   9681: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 9682: 	}
                   9683:     }
                   9684: 
1.570     raeburn  9685:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   9686:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   9687:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   9688:     var srchterm =  callingForm.srchterm.value;
                   9689:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  9690:     var msg = "";
                   9691: 
                   9692:     if (srchterm == "") {
                   9693:         checkok = 0;
1.1222    damieng  9694:         msg += "$js_lt{'youm'}\\n";
1.556     raeburn  9695:     }
                   9696: 
1.569     raeburn  9697:     if (srchtype== 'begins') {
                   9698:         if (srchterm.length < 2) {
                   9699:             checkok = 0;
1.1222    damieng  9700:             msg += "$js_lt{'thte'}\\n";
1.569     raeburn  9701:         }
                   9702:     }
                   9703: 
1.556     raeburn  9704:     if (srchtype== 'contains') {
                   9705:         if (srchterm.length < 3) {
                   9706:             checkok = 0;
1.1222    damieng  9707:             msg += "$js_lt{'thet'}\\n";
1.556     raeburn  9708:         }
                   9709:     }
                   9710:     if (srchin == 'instd') {
                   9711:         if (srchdomain == '') {
                   9712:             checkok = 0;
1.1222    damieng  9713:             msg += "$js_lt{'yomc'}\\n";
1.556     raeburn  9714:         }
                   9715:     }
                   9716:     if (srchin == 'dom') {
                   9717:         if (srchdomain == '') {
                   9718:             checkok = 0;
1.1222    damieng  9719:             msg += "$js_lt{'ymcd'}\\n";
1.556     raeburn  9720:         }
                   9721:     }
                   9722:     if (srchby == 'lastfirst') {
                   9723:         if (srchterm.indexOf(",") == -1) {
                   9724:             checkok = 0;
1.1222    damieng  9725:             msg += "$js_lt{'whus'}\\n";
1.556     raeburn  9726:         }
                   9727:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   9728:             checkok = 0;
1.1222    damieng  9729:             msg += "$js_lt{'whse'}\\n";
1.556     raeburn  9730:         }
                   9731:     }
                   9732:     if (checkok == 0) {
1.1222    damieng  9733:         alert("$js_lt{'thfo'}\\n"+msg);
1.556     raeburn  9734:         return;
                   9735:     }
                   9736:     if (checkok == 1) {
1.570     raeburn  9737:         callingForm.submit();
1.556     raeburn  9738:     }
                   9739: }
                   9740: 
                   9741: $newuserscript
                   9742: 
1.824     bisitz   9743: // ]]>
1.556     raeburn  9744: </script>
1.558     albertel 9745: 
                   9746: $new_user_create
                   9747: 
1.555     raeburn  9748: END_BLOCK
1.558     albertel 9749: 
1.876     raeburn  9750:     $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222    damieng  9751:                &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876     raeburn  9752:                $domform.
                   9753:                &Apache::lonhtmlcommon::row_closure().
1.1222    damieng  9754:                &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876     raeburn  9755:                $srchbysel.
                   9756:                $srchtypesel. 
                   9757:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   9758:                $srchinsel.
                   9759:                &Apache::lonhtmlcommon::row_closure(1). 
                   9760:                &Apache::lonhtmlcommon::end_pick_box().
                   9761:                '<br />';
1.555     raeburn  9762:     return $output;
                   9763: }
                   9764: 
1.612     raeburn  9765: sub user_rule_check {
1.615     raeburn  9766:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  9767:     my $response;
                   9768:     if (ref($usershash) eq 'HASH') {
                   9769:         foreach my $user (keys(%{$usershash})) {
                   9770:             my ($uname,$udom) = split(/:/,$user);
                   9771:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  9772:             my ($id,$newuser);
1.612     raeburn  9773:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  9774:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  9775:                 $id = $usershash->{$user}->{'id'};
                   9776:             }
                   9777:             my $inst_response;
                   9778:             if (ref($checks) eq 'HASH') {
                   9779:                 if (defined($checks->{'username'})) {
1.615     raeburn  9780:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  9781:                         &Apache::lonnet::get_instuser($udom,$uname);
                   9782:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  9783:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  9784:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   9785:                 }
1.615     raeburn  9786:             } else {
                   9787:                 ($inst_response,%{$inst_results->{$user}}) =
                   9788:                     &Apache::lonnet::get_instuser($udom,$uname);
                   9789:                 return;
1.612     raeburn  9790:             }
1.615     raeburn  9791:             if (!$got_rules->{$udom}) {
1.612     raeburn  9792:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   9793:                                                   ['usercreation'],$udom);
                   9794:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  9795:                     foreach my $item ('username','id') {
1.612     raeburn  9796:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   9797:                             $$curr_rules{$udom}{$item} = 
                   9798:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  9799:                         }
                   9800:                     }
                   9801:                 }
1.615     raeburn  9802:                 $got_rules->{$udom} = 1;  
1.585     raeburn  9803:             }
1.612     raeburn  9804:             foreach my $item (keys(%{$checks})) {
                   9805:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   9806:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   9807:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   9808:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   9809:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   9810:                                 if ($rule_check{$rule}) {
                   9811:                                     $$rulematch{$user}{$item} = $rule;
                   9812:                                     if ($inst_response eq 'ok') {
1.615     raeburn  9813:                                         if (ref($inst_results) eq 'HASH') {
                   9814:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   9815:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   9816:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   9817:                                                 }
1.612     raeburn  9818:                                             }
                   9819:                                         }
1.615     raeburn  9820:                                     }
                   9821:                                     last;
1.585     raeburn  9822:                                 }
                   9823:                             }
                   9824:                         }
                   9825:                     }
                   9826:                 }
                   9827:             }
                   9828:         }
                   9829:     }
1.612     raeburn  9830:     return;
                   9831: }
                   9832: 
                   9833: sub user_rule_formats {
                   9834:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   9835:     my %text = ( 
                   9836:                  'username' => 'Usernames',
                   9837:                  'id'       => 'IDs',
                   9838:                );
                   9839:     my $output;
                   9840:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   9841:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   9842:         if (@{$ruleorder} > 0) {
1.1102    raeburn  9843:             $output = '<br />'.
                   9844:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   9845:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   9846:                       ' <ul>';
1.612     raeburn  9847:             foreach my $rule (@{$ruleorder}) {
                   9848:                 if (ref($curr_rules) eq 'ARRAY') {
                   9849:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   9850:                         if (ref($rules->{$rule}) eq 'HASH') {
                   9851:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   9852:                                         $rules->{$rule}{'desc'}.'</li>';
                   9853:                         }
                   9854:                     }
                   9855:                 }
                   9856:             }
                   9857:             $output .= '</ul>';
                   9858:         }
                   9859:     }
                   9860:     return $output;
                   9861: }
                   9862: 
                   9863: sub instrule_disallow_msg {
1.615     raeburn  9864:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  9865:     my $response;
                   9866:     my %text = (
                   9867:                   item   => 'username',
                   9868:                   items  => 'usernames',
                   9869:                   match  => 'matches',
                   9870:                   do     => 'does',
                   9871:                   action => 'a username',
                   9872:                   one    => 'one',
                   9873:                );
                   9874:     if ($count > 1) {
                   9875:         $text{'item'} = 'usernames';
                   9876:         $text{'match'} ='match';
                   9877:         $text{'do'} = 'do';
                   9878:         $text{'action'} = 'usernames',
                   9879:         $text{'one'} = 'ones';
                   9880:     }
                   9881:     if ($checkitem eq 'id') {
                   9882:         $text{'items'} = 'IDs';
                   9883:         $text{'item'} = 'ID';
                   9884:         $text{'action'} = 'an ID';
1.615     raeburn  9885:         if ($count > 1) {
                   9886:             $text{'item'} = 'IDs';
                   9887:             $text{'action'} = 'IDs';
                   9888:         }
1.612     raeburn  9889:     }
1.674     bisitz   9890:     $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  9891:     if ($mode eq 'upload') {
                   9892:         if ($checkitem eq 'username') {
                   9893:             $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'}.");
                   9894:         } elsif ($checkitem eq 'id') {
1.674     bisitz   9895:             $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  9896:         }
1.669     raeburn  9897:     } elsif ($mode eq 'selfcreate') {
                   9898:         if ($checkitem eq 'id') {
                   9899:             $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.");
                   9900:         }
1.615     raeburn  9901:     } else {
                   9902:         if ($checkitem eq 'username') {
                   9903:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   9904:         } elsif ($checkitem eq 'id') {
                   9905:             $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.");
                   9906:         }
1.612     raeburn  9907:     }
                   9908:     return $response;
1.585     raeburn  9909: }
                   9910: 
1.624     raeburn  9911: sub personal_data_fieldtitles {
                   9912:     my %fieldtitles = &Apache::lonlocal::texthash (
                   9913:                         id => 'Student/Employee ID',
                   9914:                         permanentemail => 'E-mail address',
                   9915:                         lastname => 'Last Name',
                   9916:                         firstname => 'First Name',
                   9917:                         middlename => 'Middle Name',
                   9918:                         generation => 'Generation',
                   9919:                         gen => 'Generation',
1.765     raeburn  9920:                         inststatus => 'Affiliation',
1.624     raeburn  9921:                    );
                   9922:     return %fieldtitles;
                   9923: }
                   9924: 
1.642     raeburn  9925: sub sorted_inst_types {
                   9926:     my ($dom) = @_;
1.1185    raeburn  9927:     my ($usertypes,$order);
                   9928:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   9929:     if (ref($domdefaults{'inststatus'}) eq 'HASH') {
                   9930:         $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
                   9931:         $order = $domdefaults{'inststatus'}{'inststatusorder'};
                   9932:     } else {
                   9933:         ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   9934:     }
1.642     raeburn  9935:     my $othertitle = &mt('All users');
                   9936:     if ($env{'request.course.id'}) {
1.668     raeburn  9937:         $othertitle  = &mt('Any users');
1.642     raeburn  9938:     }
                   9939:     my @types;
                   9940:     if (ref($order) eq 'ARRAY') {
                   9941:         @types = @{$order};
                   9942:     }
                   9943:     if (@types == 0) {
                   9944:         if (ref($usertypes) eq 'HASH') {
                   9945:             @types = sort(keys(%{$usertypes}));
                   9946:         }
                   9947:     }
                   9948:     if (keys(%{$usertypes}) > 0) {
                   9949:         $othertitle = &mt('Other users');
                   9950:     }
                   9951:     return ($othertitle,$usertypes,\@types);
                   9952: }
                   9953: 
1.645     raeburn  9954: sub get_institutional_codes {
                   9955:     my ($settings,$allcourses,$LC_code) = @_;
                   9956: # Get complete list of course sections to update
                   9957:     my @currsections = ();
                   9958:     my @currxlists = ();
                   9959:     my $coursecode = $$settings{'internal.coursecode'};
                   9960: 
                   9961:     if ($$settings{'internal.sectionnums'} ne '') {
                   9962:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   9963:     }
                   9964: 
                   9965:     if ($$settings{'internal.crosslistings'} ne '') {
                   9966:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   9967:     }
                   9968: 
                   9969:     if (@currxlists > 0) {
                   9970:         foreach (@currxlists) {
                   9971:             if (m/^([^:]+):(\w*)$/) {
                   9972:                 unless (grep/^$1$/,@{$allcourses}) {
                   9973:                     push @{$allcourses},$1;
                   9974:                     $$LC_code{$1} = $2;
                   9975:                 }
                   9976:             }
                   9977:         }
                   9978:     }
                   9979:  
                   9980:     if (@currsections > 0) {
                   9981:         foreach (@currsections) {
                   9982:             if (m/^(\w+):(\w*)$/) {
                   9983:                 my $sec = $coursecode.$1;
                   9984:                 my $lc_sec = $2;
                   9985:                 unless (grep/^$sec$/,@{$allcourses}) {
                   9986:                     push @{$allcourses},$sec;
                   9987:                     $$LC_code{$sec} = $lc_sec;
                   9988:                 }
                   9989:             }
                   9990:         }
                   9991:     }
                   9992:     return;
                   9993: }
                   9994: 
1.971     raeburn  9995: sub get_standard_codeitems {
                   9996:     return ('Year','Semester','Department','Number','Section');
                   9997: }
                   9998: 
1.112     bowersj2 9999: =pod
                   10000: 
1.780     raeburn  10001: =head1 Slot Helpers
                   10002: 
                   10003: =over 4
                   10004: 
                   10005: =item * sorted_slots()
                   10006: 
1.1040    raeburn  10007: Sorts an array of slot names in order of an optional sort key,
                   10008: default sort is by slot start time (earliest first). 
1.780     raeburn  10009: 
                   10010: Inputs:
                   10011: 
                   10012: =over 4
                   10013: 
                   10014: slotsarr  - Reference to array of unsorted slot names.
                   10015: 
                   10016: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   10017: 
1.1040    raeburn  10018: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   10019: 
1.549     albertel 10020: =back
                   10021: 
1.780     raeburn  10022: Returns:
                   10023: 
                   10024: =over 4
                   10025: 
1.1040    raeburn  10026: sorted   - An array of slot names sorted by a specified sort key 
                   10027:            (default sort key is start time of the slot).
1.780     raeburn  10028: 
                   10029: =back
                   10030: 
                   10031: =cut
                   10032: 
                   10033: 
                   10034: sub sorted_slots {
1.1040    raeburn  10035:     my ($slotsarr,$slots,$sortkey) = @_;
                   10036:     if ($sortkey eq '') {
                   10037:         $sortkey = 'starttime';
                   10038:     }
1.780     raeburn  10039:     my @sorted;
                   10040:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   10041:         @sorted =
                   10042:             sort {
                   10043:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  10044:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  10045:                      }
                   10046:                      if (ref($slots->{$a})) { return -1;}
                   10047:                      if (ref($slots->{$b})) { return 1;}
                   10048:                      return 0;
                   10049:                  } @{$slotsarr};
                   10050:     }
                   10051:     return @sorted;
                   10052: }
                   10053: 
1.1040    raeburn  10054: =pod
                   10055: 
                   10056: =item * get_future_slots()
                   10057: 
                   10058: Inputs:
                   10059: 
                   10060: =over 4
                   10061: 
                   10062: cnum - course number
                   10063: 
                   10064: cdom - course domain
                   10065: 
                   10066: now - current UNIX time
                   10067: 
                   10068: symb - optional symb
                   10069: 
                   10070: =back
                   10071: 
                   10072: Returns:
                   10073: 
                   10074: =over 4
                   10075: 
                   10076: sorted_reservable - ref to array of student_schedulable slots currently 
                   10077:                     reservable, ordered by end date of reservation period.
                   10078: 
                   10079: reservable_now - ref to hash of student_schedulable slots currently
                   10080:                  reservable.
                   10081: 
                   10082:     Keys in inner hash are:
                   10083:     (a) symb: either blank or symb to which slot use is restricted.
                   10084:     (b) endreserve: end date of reservation period. 
                   10085: 
                   10086: sorted_future - ref to array of student_schedulable slots reservable in
                   10087:                 the future, ordered by start date of reservation period.
                   10088: 
                   10089: future_reservable - ref to hash of student_schedulable slots reservable
                   10090:                     in the future.
                   10091: 
                   10092:     Keys in inner hash are:
                   10093:     (a) symb: either blank or symb to which slot use is restricted.
                   10094:     (b) startreserve:  start date of reservation period.
                   10095: 
                   10096: =back
                   10097: 
                   10098: =cut
                   10099: 
                   10100: sub get_future_slots {
                   10101:     my ($cnum,$cdom,$now,$symb) = @_;
                   10102:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   10103:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   10104:     foreach my $slot (keys(%slots)) {
                   10105:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   10106:         if ($symb) {
                   10107:             next if (($slots{$slot}->{'symb'} ne '') && 
                   10108:                      ($slots{$slot}->{'symb'} ne $symb));
                   10109:         }
                   10110:         if (($slots{$slot}->{'starttime'} > $now) &&
                   10111:             ($slots{$slot}->{'endtime'} > $now)) {
                   10112:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   10113:                 my $userallowed = 0;
                   10114:                 if ($slots{$slot}->{'allowedsections'}) {
                   10115:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   10116:                     if (!defined($env{'request.role.sec'})
                   10117:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   10118:                         $userallowed=1;
                   10119:                     } else {
                   10120:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   10121:                             $userallowed=1;
                   10122:                         }
                   10123:                     }
                   10124:                     unless ($userallowed) {
                   10125:                         if (defined($env{'request.course.groups'})) {
                   10126:                             my @groups = split(/:/,$env{'request.course.groups'});
                   10127:                             foreach my $group (@groups) {
                   10128:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   10129:                                     $userallowed=1;
                   10130:                                     last;
                   10131:                                 }
                   10132:                             }
                   10133:                         }
                   10134:                     }
                   10135:                 }
                   10136:                 if ($slots{$slot}->{'allowedusers'}) {
                   10137:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   10138:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   10139:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   10140:                         $userallowed = 1;
                   10141:                     }
                   10142:                 }
                   10143:                 next unless($userallowed);
                   10144:             }
                   10145:             my $startreserve = $slots{$slot}->{'startreserve'};
                   10146:             my $endreserve = $slots{$slot}->{'endreserve'};
                   10147:             my $symb = $slots{$slot}->{'symb'};
                   10148:             if (($startreserve < $now) &&
                   10149:                 (!$endreserve || $endreserve > $now)) {
                   10150:                 my $lastres = $endreserve;
                   10151:                 if (!$lastres) {
                   10152:                     $lastres = $slots{$slot}->{'starttime'};
                   10153:                 }
                   10154:                 $reservable_now{$slot} = {
                   10155:                                            symb       => $symb,
                   10156:                                            endreserve => $lastres
                   10157:                                          };
                   10158:             } elsif (($startreserve > $now) &&
                   10159:                      (!$endreserve || $endreserve > $startreserve)) {
                   10160:                 $future_reservable{$slot} = {
                   10161:                                               symb         => $symb,
                   10162:                                               startreserve => $startreserve
                   10163:                                             };
                   10164:             }
                   10165:         }
                   10166:     }
                   10167:     my @unsorted_reservable = keys(%reservable_now);
                   10168:     if (@unsorted_reservable > 0) {
                   10169:         @sorted_reservable = 
                   10170:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   10171:     }
                   10172:     my @unsorted_future = keys(%future_reservable);
                   10173:     if (@unsorted_future > 0) {
                   10174:         @sorted_future =
                   10175:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   10176:     }
                   10177:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   10178: }
1.780     raeburn  10179: 
                   10180: =pod
                   10181: 
1.1057    foxr     10182: =back
                   10183: 
1.549     albertel 10184: =head1 HTTP Helpers
                   10185: 
                   10186: =over 4
                   10187: 
1.648     raeburn  10188: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 10189: 
1.258     albertel 10190: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 10191: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 10192: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 10193: 
                   10194: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   10195: $possible_names is an ref to an array of form element names.  As an example:
                   10196: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 10197: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 10198: 
                   10199: =cut
1.1       albertel 10200: 
1.6       albertel 10201: sub get_unprocessed_cgi {
1.25      albertel 10202:   my ($query,$possible_names)= @_;
1.26      matthew  10203:   # $Apache::lonxml::debug=1;
1.356     albertel 10204:   foreach my $pair (split(/&/,$query)) {
                   10205:     my ($name, $value) = split(/=/,$pair);
1.369     www      10206:     $name = &unescape($name);
1.25      albertel 10207:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   10208:       $value =~ tr/+/ /;
                   10209:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 10210:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 10211:     }
1.16      harris41 10212:   }
1.6       albertel 10213: }
                   10214: 
1.112     bowersj2 10215: =pod
                   10216: 
1.648     raeburn  10217: =item * &cacheheader() 
1.112     bowersj2 10218: 
                   10219: returns cache-controlling header code
                   10220: 
                   10221: =cut
                   10222: 
1.7       albertel 10223: sub cacheheader {
1.258     albertel 10224:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 10225:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   10226:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 10227:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   10228:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 10229:     return $output;
1.7       albertel 10230: }
                   10231: 
1.112     bowersj2 10232: =pod
                   10233: 
1.648     raeburn  10234: =item * &no_cache($r) 
1.112     bowersj2 10235: 
                   10236: specifies header code to not have cache
                   10237: 
                   10238: =cut
                   10239: 
1.9       albertel 10240: sub no_cache {
1.216     albertel 10241:     my ($r) = @_;
                   10242:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 10243: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 10244:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   10245:     $r->no_cache(1);
                   10246:     $r->header_out("Expires" => $date);
                   10247:     $r->header_out("Pragma" => "no-cache");
1.123     www      10248: }
                   10249: 
                   10250: sub content_type {
1.181     albertel 10251:     my ($r,$type,$charset) = @_;
1.299     foxr     10252:     if ($r) {
                   10253: 	#  Note that printout.pl calls this with undef for $r.
                   10254: 	&no_cache($r);
                   10255:     }
1.258     albertel 10256:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 10257:     unless ($charset) {
                   10258: 	$charset=&Apache::lonlocal::current_encoding;
                   10259:     }
                   10260:     if ($charset) { $type.='; charset='.$charset; }
                   10261:     if ($r) {
                   10262: 	$r->content_type($type);
                   10263:     } else {
                   10264: 	print("Content-type: $type\n\n");
                   10265:     }
1.9       albertel 10266: }
1.25      albertel 10267: 
1.112     bowersj2 10268: =pod
                   10269: 
1.648     raeburn  10270: =item * &add_to_env($name,$value) 
1.112     bowersj2 10271: 
1.258     albertel 10272: adds $name to the %env hash with value
1.112     bowersj2 10273: $value, if $name already exists, the entry is converted to an array
                   10274: reference and $value is added to the array.
                   10275: 
                   10276: =cut
                   10277: 
1.25      albertel 10278: sub add_to_env {
                   10279:   my ($name,$value)=@_;
1.258     albertel 10280:   if (defined($env{$name})) {
                   10281:     if (ref($env{$name})) {
1.25      albertel 10282:       #already have multiple values
1.258     albertel 10283:       push(@{ $env{$name} },$value);
1.25      albertel 10284:     } else {
                   10285:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 10286:       my $first=$env{$name};
                   10287:       undef($env{$name});
                   10288:       push(@{ $env{$name} },$first,$value);
1.25      albertel 10289:     }
                   10290:   } else {
1.258     albertel 10291:     $env{$name}=$value;
1.25      albertel 10292:   }
1.31      albertel 10293: }
1.149     albertel 10294: 
                   10295: =pod
                   10296: 
1.648     raeburn  10297: =item * &get_env_multiple($name) 
1.149     albertel 10298: 
1.258     albertel 10299: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 10300: values may be defined and end up as an array ref.
                   10301: 
                   10302: returns an array of values
                   10303: 
                   10304: =cut
                   10305: 
                   10306: sub get_env_multiple {
                   10307:     my ($name) = @_;
                   10308:     my @values;
1.258     albertel 10309:     if (defined($env{$name})) {
1.149     albertel 10310:         # exists is it an array
1.258     albertel 10311:         if (ref($env{$name})) {
                   10312:             @values=@{ $env{$name} };
1.149     albertel 10313:         } else {
1.258     albertel 10314:             $values[0]=$env{$name};
1.149     albertel 10315:         }
                   10316:     }
                   10317:     return(@values);
                   10318: }
                   10319: 
1.660     raeburn  10320: sub ask_for_embedded_content {
                   10321:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  10322:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085    raeburn  10323:         %currsubfile,%unused,$rem);
1.1071    raeburn  10324:     my $counter = 0;
                   10325:     my $numnew = 0;
1.987     raeburn  10326:     my $numremref = 0;
                   10327:     my $numinvalid = 0;
                   10328:     my $numpathchg = 0;
                   10329:     my $numexisting = 0;
1.1071    raeburn  10330:     my $numunused = 0;
                   10331:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156    raeburn  10332:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  10333:     my $heading = &mt('Upload embedded files');
                   10334:     my $buttontext = &mt('Upload');
                   10335: 
1.1085    raeburn  10336:     if ($env{'request.course.id'}) {
1.1123    raeburn  10337:         if ($actionurl eq '/adm/dependencies') {
                   10338:             $navmap = Apache::lonnavmaps::navmap->new();
                   10339:         }
                   10340:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   10341:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085    raeburn  10342:     }
1.1123    raeburn  10343:     if (($actionurl eq '/adm/portfolio') || 
                   10344:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  10345:         my $current_path='/';
                   10346:         if ($env{'form.currentpath'}) {
                   10347:             $current_path = $env{'form.currentpath'};
                   10348:         }
                   10349:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123    raeburn  10350:             $udom = $cdom;
                   10351:             $uname = $cnum;
1.984     raeburn  10352:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   10353:         } else {
                   10354:             $udom = $env{'user.domain'};
                   10355:             $uname = $env{'user.name'};
                   10356:             $url = '/userfiles/portfolio';
                   10357:         }
1.987     raeburn  10358:         $toplevel = $url.'/';
1.984     raeburn  10359:         $url .= $current_path;
                   10360:         $getpropath = 1;
1.987     raeburn  10361:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   10362:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      10363:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  10364:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  10365:         $toplevel = $url;
1.984     raeburn  10366:         if ($rest ne '') {
1.987     raeburn  10367:             $url .= $rest;
                   10368:         }
                   10369:     } elsif ($actionurl eq '/adm/coursedocs') {
                   10370:         if (ref($args) eq 'HASH') {
1.1071    raeburn  10371:             $url = $args->{'docs_url'};
                   10372:             $toplevel = $url;
1.1084    raeburn  10373:             if ($args->{'context'} eq 'paste') {
                   10374:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   10375:                 ($path) = 
                   10376:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   10377:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   10378:                 $fileloc =~ s{^/}{};
                   10379:             }
1.1071    raeburn  10380:         }
1.1084    raeburn  10381:     } elsif ($actionurl eq '/adm/dependencies')  {
1.1071    raeburn  10382:         if ($env{'request.course.id'} ne '') {
                   10383:             if (ref($args) eq 'HASH') {
                   10384:                 $url = $args->{'docs_url'};
                   10385:                 $title = $args->{'docs_title'};
1.1126    raeburn  10386:                 $toplevel = $url; 
                   10387:                 unless ($toplevel =~ m{^/}) {
                   10388:                     $toplevel = "/$url";
                   10389:                 }
1.1085    raeburn  10390:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126    raeburn  10391:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   10392:                     $path = $1;
                   10393:                 } else {
                   10394:                     ($path) =
                   10395:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   10396:                 }
1.1195    raeburn  10397:                 if ($toplevel=~/^\/*(uploaded|editupload)/) {
                   10398:                     $fileloc = $toplevel;
                   10399:                     $fileloc=~ s/^\s*(\S+)\s*$/$1/;
                   10400:                     my ($udom,$uname,$fname) =
                   10401:                         ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
                   10402:                     $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
                   10403:                 } else {
                   10404:                     $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   10405:                 }
1.1071    raeburn  10406:                 $fileloc =~ s{^/}{};
                   10407:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   10408:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   10409:             }
1.987     raeburn  10410:         }
1.1123    raeburn  10411:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   10412:         $udom = $cdom;
                   10413:         $uname = $cnum;
                   10414:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   10415:         $toplevel = $url;
                   10416:         $path = $url;
                   10417:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   10418:         $fileloc =~ s{^/}{};
1.987     raeburn  10419:     }
1.1126    raeburn  10420:     foreach my $file (keys(%{$allfiles})) {
                   10421:         my $embed_file;
                   10422:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   10423:             $embed_file = $1;
                   10424:         } else {
                   10425:             $embed_file = $file;
                   10426:         }
1.1158    raeburn  10427:         my ($absolutepath,$cleaned_file);
                   10428:         if ($embed_file =~ m{^\w+://}) {
                   10429:             $cleaned_file = $embed_file;
1.1147    raeburn  10430:             $newfiles{$cleaned_file} = 1;
                   10431:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  10432:         } else {
1.1158    raeburn  10433:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  10434:             if ($embed_file =~ m{^/}) {
                   10435:                 $absolutepath = $embed_file;
                   10436:             }
1.1147    raeburn  10437:             if ($cleaned_file =~ m{/}) {
                   10438:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  10439:                 $path = &check_for_traversal($path,$url,$toplevel);
                   10440:                 my $item = $fname;
                   10441:                 if ($path ne '') {
                   10442:                     $item = $path.'/'.$fname;
                   10443:                     $subdependencies{$path}{$fname} = 1;
                   10444:                 } else {
                   10445:                     $dependencies{$item} = 1;
                   10446:                 }
                   10447:                 if ($absolutepath) {
                   10448:                     $mapping{$item} = $absolutepath;
                   10449:                 } else {
                   10450:                     $mapping{$item} = $embed_file;
                   10451:                 }
                   10452:             } else {
                   10453:                 $dependencies{$embed_file} = 1;
                   10454:                 if ($absolutepath) {
1.1147    raeburn  10455:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  10456:                 } else {
1.1147    raeburn  10457:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  10458:                 }
                   10459:             }
1.984     raeburn  10460:         }
                   10461:     }
1.1071    raeburn  10462:     my $dirptr = 16384;
1.984     raeburn  10463:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  10464:         $currsubfile{$path} = {};
1.1123    raeburn  10465:         if (($actionurl eq '/adm/portfolio') || 
                   10466:             ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  10467:             my ($sublistref,$listerror) =
                   10468:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   10469:             if (ref($sublistref) eq 'ARRAY') {
                   10470:                 foreach my $line (@{$sublistref}) {
                   10471:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  10472:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  10473:                 }
1.984     raeburn  10474:             }
1.987     raeburn  10475:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10476:             if (opendir(my $dir,$url.'/'.$path)) {
                   10477:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  10478:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   10479:             }
1.1084    raeburn  10480:         } elsif (($actionurl eq '/adm/dependencies') ||
                   10481:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  10482:                   ($args->{'context'} eq 'paste')) ||
                   10483:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10484:             if ($env{'request.course.id'} ne '') {
1.1123    raeburn  10485:                 my $dir;
                   10486:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   10487:                     $dir = $fileloc;
                   10488:                 } else {
                   10489:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10490:                 }
1.1071    raeburn  10491:                 if ($dir ne '') {
                   10492:                     my ($sublistref,$listerror) =
                   10493:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   10494:                     if (ref($sublistref) eq 'ARRAY') {
                   10495:                         foreach my $line (@{$sublistref}) {
                   10496:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   10497:                                 undef,$mtime)=split(/\&/,$line,12);
                   10498:                             unless (($testdir&$dirptr) ||
                   10499:                                     ($file_name =~ /^\.\.?$/)) {
                   10500:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   10501:                             }
                   10502:                         }
                   10503:                     }
                   10504:                 }
1.984     raeburn  10505:             }
                   10506:         }
                   10507:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  10508:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  10509:                 my $item = $path.'/'.$file;
                   10510:                 unless ($mapping{$item} eq $item) {
                   10511:                     $pathchanges{$item} = 1;
                   10512:                 }
                   10513:                 $existing{$item} = 1;
                   10514:                 $numexisting ++;
                   10515:             } else {
                   10516:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  10517:             }
                   10518:         }
1.1071    raeburn  10519:         if ($actionurl eq '/adm/dependencies') {
                   10520:             foreach my $path (keys(%currsubfile)) {
                   10521:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   10522:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   10523:                          unless ($subdependencies{$path}{$file}) {
1.1085    raeburn  10524:                              next if (($rem ne '') &&
                   10525:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   10526:                                        (ref($navmap) &&
                   10527:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   10528:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10529:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  10530:                              $unused{$path.'/'.$file} = 1; 
                   10531:                          }
                   10532:                     }
                   10533:                 }
                   10534:             }
                   10535:         }
1.984     raeburn  10536:     }
1.987     raeburn  10537:     my %currfile;
1.1123    raeburn  10538:     if (($actionurl eq '/adm/portfolio') ||
                   10539:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  10540:         my ($dirlistref,$listerror) =
                   10541:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   10542:         if (ref($dirlistref) eq 'ARRAY') {
                   10543:             foreach my $line (@{$dirlistref}) {
                   10544:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   10545:                 $currfile{$file_name} = 1;
                   10546:             }
1.984     raeburn  10547:         }
1.987     raeburn  10548:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10549:         if (opendir(my $dir,$url)) {
1.987     raeburn  10550:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  10551:             map {$currfile{$_} = 1;} @dir_list;
                   10552:         }
1.1084    raeburn  10553:     } elsif (($actionurl eq '/adm/dependencies') ||
                   10554:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  10555:               ($args->{'context'} eq 'paste')) ||
                   10556:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10557:         if ($env{'request.course.id'} ne '') {
                   10558:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10559:             if ($dir ne '') {
                   10560:                 my ($dirlistref,$listerror) =
                   10561:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   10562:                 if (ref($dirlistref) eq 'ARRAY') {
                   10563:                     foreach my $line (@{$dirlistref}) {
                   10564:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   10565:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   10566:                         unless (($testdir&$dirptr) ||
                   10567:                                 ($file_name =~ /^\.\.?$/)) {
                   10568:                             $currfile{$file_name} = [$size,$mtime];
                   10569:                         }
                   10570:                     }
                   10571:                 }
                   10572:             }
                   10573:         }
1.984     raeburn  10574:     }
                   10575:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  10576:         if (exists($currfile{$file})) {
1.987     raeburn  10577:             unless ($mapping{$file} eq $file) {
                   10578:                 $pathchanges{$file} = 1;
                   10579:             }
                   10580:             $existing{$file} = 1;
                   10581:             $numexisting ++;
                   10582:         } else {
1.984     raeburn  10583:             $newfiles{$file} = 1;
                   10584:         }
                   10585:     }
1.1071    raeburn  10586:     foreach my $file (keys(%currfile)) {
                   10587:         unless (($file eq $filename) ||
                   10588:                 ($file eq $filename.'.bak') ||
                   10589:                 ($dependencies{$file})) {
1.1085    raeburn  10590:             if ($actionurl eq '/adm/dependencies') {
1.1126    raeburn  10591:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   10592:                     next if (($rem ne '') &&
                   10593:                              (($env{"httpref.$rem".$file} ne '') ||
                   10594:                               (ref($navmap) &&
                   10595:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   10596:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10597:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   10598:                 }
1.1085    raeburn  10599:             }
1.1071    raeburn  10600:             $unused{$file} = 1;
                   10601:         }
                   10602:     }
1.1084    raeburn  10603:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   10604:         ($args->{'context'} eq 'paste')) {
                   10605:         $counter = scalar(keys(%existing));
                   10606:         $numpathchg = scalar(keys(%pathchanges));
1.1123    raeburn  10607:         return ($output,$counter,$numpathchg,\%existing);
                   10608:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && 
                   10609:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   10610:         $counter = scalar(keys(%existing));
                   10611:         $numpathchg = scalar(keys(%pathchanges));
                   10612:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084    raeburn  10613:     }
1.984     raeburn  10614:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  10615:         if ($actionurl eq '/adm/dependencies') {
                   10616:             next if ($embed_file =~ m{^\w+://});
                   10617:         }
1.660     raeburn  10618:         $upload_output .= &start_data_table_row().
1.1123    raeburn  10619:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  10620:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  10621:         unless ($mapping{$embed_file} eq $embed_file) {
1.1123    raeburn  10622:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   10623:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  10624:         }
1.1123    raeburn  10625:         $upload_output .= '</td>';
1.1071    raeburn  10626:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1123    raeburn  10627:             $upload_output.='<td align="right">'.
                   10628:                             '<span class="LC_info LC_fontsize_medium">'.
                   10629:                             &mt("URL points to web address").'</span>';
1.987     raeburn  10630:             $numremref++;
1.660     raeburn  10631:         } elsif ($args->{'error_on_invalid_names'}
                   10632:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123    raeburn  10633:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   10634:                             &mt('Invalid characters').'</span>';
1.987     raeburn  10635:             $numinvalid++;
1.660     raeburn  10636:         } else {
1.1123    raeburn  10637:             $upload_output .= '<td>'.
                   10638:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  10639:                                                      $embed_file,\%mapping,
1.1071    raeburn  10640:                                                      $allfiles,$codebase,'upload');
                   10641:             $counter ++;
                   10642:             $numnew ++;
1.987     raeburn  10643:         }
                   10644:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   10645:     }
                   10646:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  10647:         if ($actionurl eq '/adm/dependencies') {
                   10648:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   10649:             $modify_output .= &start_data_table_row().
                   10650:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   10651:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   10652:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   10653:                               '<td>'.$size.'</td>'.
                   10654:                               '<td>'.$mtime.'</td>'.
                   10655:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   10656:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   10657:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   10658:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   10659:                               &embedded_file_element('upload_embedded',$counter,
                   10660:                                                      $embed_file,\%mapping,
                   10661:                                                      $allfiles,$codebase,'modify').
                   10662:                               '</div></td>'.
                   10663:                               &end_data_table_row()."\n";
                   10664:             $counter ++;
                   10665:         } else {
                   10666:             $upload_output .= &start_data_table_row().
1.1123    raeburn  10667:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   10668:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   10669:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  10670:                               &Apache::loncommon::end_data_table_row()."\n";
                   10671:         }
                   10672:     }
                   10673:     my $delidx = $counter;
                   10674:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   10675:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   10676:         $delete_output .= &start_data_table_row().
                   10677:                           '<td><img src="'.&icon($oldfile).'" />'.
                   10678:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   10679:                           '<td>'.$size.'</td>'.
                   10680:                           '<td>'.$mtime.'</td>'.
                   10681:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   10682:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   10683:                           &embedded_file_element('upload_embedded',$delidx,
                   10684:                                                  $oldfile,\%mapping,$allfiles,
                   10685:                                                  $codebase,'delete').'</td>'.
                   10686:                           &end_data_table_row()."\n"; 
                   10687:         $numunused ++;
                   10688:         $delidx ++;
1.987     raeburn  10689:     }
                   10690:     if ($upload_output) {
                   10691:         $upload_output = &start_data_table().
                   10692:                          $upload_output.
                   10693:                          &end_data_table()."\n";
                   10694:     }
1.1071    raeburn  10695:     if ($modify_output) {
                   10696:         $modify_output = &start_data_table().
                   10697:                          &start_data_table_header_row().
                   10698:                          '<th>'.&mt('File').'</th>'.
                   10699:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10700:                          '<th>'.&mt('Modified').'</th>'.
                   10701:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   10702:                          &end_data_table_header_row().
                   10703:                          $modify_output.
                   10704:                          &end_data_table()."\n";
                   10705:     }
                   10706:     if ($delete_output) {
                   10707:         $delete_output = &start_data_table().
                   10708:                          &start_data_table_header_row().
                   10709:                          '<th>'.&mt('File').'</th>'.
                   10710:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10711:                          '<th>'.&mt('Modified').'</th>'.
                   10712:                          '<th>'.&mt('Delete?').'</th>'.
                   10713:                          &end_data_table_header_row().
                   10714:                          $delete_output.
                   10715:                          &end_data_table()."\n";
                   10716:     }
1.987     raeburn  10717:     my $applies = 0;
                   10718:     if ($numremref) {
                   10719:         $applies ++;
                   10720:     }
                   10721:     if ($numinvalid) {
                   10722:         $applies ++;
                   10723:     }
                   10724:     if ($numexisting) {
                   10725:         $applies ++;
                   10726:     }
1.1071    raeburn  10727:     if ($counter || $numunused) {
1.987     raeburn  10728:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   10729:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  10730:                   $state.'<h3>'.$heading.'</h3>'; 
                   10731:         if ($actionurl eq '/adm/dependencies') {
                   10732:             if ($numnew) {
                   10733:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   10734:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   10735:                            $upload_output.'<br />'."\n";
                   10736:             }
                   10737:             if ($numexisting) {
                   10738:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   10739:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   10740:                            $modify_output.'<br />'."\n";
                   10741:                            $buttontext = &mt('Save changes');
                   10742:             }
                   10743:             if ($numunused) {
                   10744:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   10745:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   10746:                            $delete_output.'<br />'."\n";
                   10747:                            $buttontext = &mt('Save changes');
                   10748:             }
                   10749:         } else {
                   10750:             $output .= $upload_output.'<br />'."\n";
                   10751:         }
                   10752:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   10753:                    $counter.'" />'."\n";
                   10754:         if ($actionurl eq '/adm/dependencies') { 
                   10755:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   10756:                        $numnew.'" />'."\n";
                   10757:         } elsif ($actionurl eq '') {
1.987     raeburn  10758:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   10759:         }
                   10760:     } elsif ($applies) {
                   10761:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   10762:         if ($applies > 1) {
                   10763:             $output .=  
1.1123    raeburn  10764:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  10765:             if ($numremref) {
                   10766:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   10767:             }
                   10768:             if ($numinvalid) {
                   10769:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   10770:             }
                   10771:             if ($numexisting) {
                   10772:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   10773:             }
                   10774:             $output .= '</ul><br />';
                   10775:         } elsif ($numremref) {
                   10776:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   10777:         } elsif ($numinvalid) {
                   10778:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   10779:         } elsif ($numexisting) {
                   10780:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   10781:         }
                   10782:         $output .= $upload_output.'<br />';
                   10783:     }
                   10784:     my ($pathchange_output,$chgcount);
1.1071    raeburn  10785:     $chgcount = $counter;
1.987     raeburn  10786:     if (keys(%pathchanges) > 0) {
                   10787:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  10788:             if ($counter) {
1.987     raeburn  10789:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   10790:                                                   $embed_file,\%mapping,
1.1071    raeburn  10791:                                                   $allfiles,$codebase,'change');
1.987     raeburn  10792:             } else {
                   10793:                 $pathchange_output .= 
                   10794:                     &start_data_table_row().
                   10795:                     '<td><input type ="checkbox" name="namechange" value="'.
                   10796:                     $chgcount.'" checked="checked" /></td>'.
                   10797:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   10798:                     '<td>'.$embed_file.
                   10799:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  10800:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  10801:                     '</td>'.&end_data_table_row();
1.660     raeburn  10802:             }
1.987     raeburn  10803:             $numpathchg ++;
                   10804:             $chgcount ++;
1.660     raeburn  10805:         }
                   10806:     }
1.1127    raeburn  10807:     if (($counter) || ($numunused)) {
1.987     raeburn  10808:         if ($numpathchg) {
                   10809:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   10810:                        $numpathchg.'" />'."\n";
                   10811:         }
                   10812:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   10813:             ($actionurl eq '/adm/imsimport')) {
                   10814:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   10815:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   10816:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  10817:         } elsif ($actionurl eq '/adm/dependencies') {
                   10818:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  10819:         }
1.1123    raeburn  10820:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  10821:     } elsif ($numpathchg) {
                   10822:         my %pathchange = ();
                   10823:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   10824:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10825:             $output .= '<p>'.&mt('or').'</p>'; 
1.1123    raeburn  10826:         }
1.987     raeburn  10827:     }
1.1071    raeburn  10828:     return ($output,$counter,$numpathchg);
1.987     raeburn  10829: }
                   10830: 
1.1147    raeburn  10831: =pod
                   10832: 
                   10833: =item * clean_path($name)
                   10834: 
                   10835: Performs clean-up of directories, subdirectories and filename in an
                   10836: embedded object, referenced in an HTML file which is being uploaded
                   10837: to a course or portfolio, where 
                   10838: "Upload embedded images/multimedia files if HTML file" checkbox was
                   10839: checked.
                   10840: 
                   10841: Clean-up is similar to replacements in lonnet::clean_filename()
                   10842: except each / between sub-directory and next level is preserved.
                   10843: 
                   10844: =cut
                   10845: 
                   10846: sub clean_path {
                   10847:     my ($embed_file) = @_;
                   10848:     $embed_file =~s{^/+}{};
                   10849:     my @contents;
                   10850:     if ($embed_file =~ m{/}) {
                   10851:         @contents = split(/\//,$embed_file);
                   10852:     } else {
                   10853:         @contents = ($embed_file);
                   10854:     }
                   10855:     my $lastidx = scalar(@contents)-1;
                   10856:     for (my $i=0; $i<=$lastidx; $i++) { 
                   10857:         $contents[$i]=~s{\\}{/}g;
                   10858:         $contents[$i]=~s/\s+/\_/g;
                   10859:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   10860:         if ($i == $lastidx) {
                   10861:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   10862:         }
                   10863:     }
                   10864:     if ($lastidx > 0) {
                   10865:         return join('/',@contents);
                   10866:     } else {
                   10867:         return $contents[0];
                   10868:     }
                   10869: }
                   10870: 
1.987     raeburn  10871: sub embedded_file_element {
1.1071    raeburn  10872:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  10873:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   10874:                    (ref($codebase) eq 'HASH'));
                   10875:     my $output;
1.1071    raeburn  10876:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  10877:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   10878:     }
                   10879:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   10880:                &escape($embed_file).'" />';
                   10881:     unless (($context eq 'upload_embedded') && 
                   10882:             ($mapping->{$embed_file} eq $embed_file)) {
                   10883:         $output .='
                   10884:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   10885:     }
                   10886:     my $attrib;
                   10887:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   10888:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   10889:     }
                   10890:     $output .=
                   10891:         "\n\t\t".
                   10892:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   10893:         $attrib.'" />';
                   10894:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   10895:         $output .=
                   10896:             "\n\t\t".
                   10897:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   10898:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  10899:     }
1.987     raeburn  10900:     return $output;
1.660     raeburn  10901: }
                   10902: 
1.1071    raeburn  10903: sub get_dependency_details {
                   10904:     my ($currfile,$currsubfile,$embed_file) = @_;
                   10905:     my ($size,$mtime,$showsize,$showmtime);
                   10906:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   10907:         if ($embed_file =~ m{/}) {
                   10908:             my ($path,$fname) = split(/\//,$embed_file);
                   10909:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   10910:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   10911:             }
                   10912:         } else {
                   10913:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   10914:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   10915:             }
                   10916:         }
                   10917:         $showsize = $size/1024.0;
                   10918:         $showsize = sprintf("%.1f",$showsize);
                   10919:         if ($mtime > 0) {
                   10920:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   10921:         }
                   10922:     }
                   10923:     return ($showsize,$showmtime);
                   10924: }
                   10925: 
                   10926: sub ask_embedded_js {
                   10927:     return <<"END";
                   10928: <script type="text/javascript"">
                   10929: // <![CDATA[
                   10930: function toggleBrowse(counter) {
                   10931:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   10932:     var fileid = document.getElementById('embedded_item_'+counter);
                   10933:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   10934:     if (chkboxid.checked == true) {
                   10935:         uploaddivid.style.display='block';
                   10936:     } else {
                   10937:         uploaddivid.style.display='none';
                   10938:         fileid.value = '';
                   10939:     }
                   10940: }
                   10941: // ]]>
                   10942: </script>
                   10943: 
                   10944: END
                   10945: }
                   10946: 
1.661     raeburn  10947: sub upload_embedded {
                   10948:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  10949:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   10950:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  10951:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   10952:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   10953:         my $orig_uploaded_filename =
                   10954:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  10955:         foreach my $type ('orig','ref','attrib','codebase') {
                   10956:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   10957:                 $env{'form.embedded_'.$type.'_'.$i} =
                   10958:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   10959:             }
                   10960:         }
1.661     raeburn  10961:         my ($path,$fname) =
                   10962:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   10963:         # no path, whole string is fname
                   10964:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   10965:         $fname = &Apache::lonnet::clean_filename($fname);
                   10966:         # See if there is anything left
                   10967:         next if ($fname eq '');
                   10968: 
                   10969:         # Check if file already exists as a file or directory.
                   10970:         my ($state,$msg);
                   10971:         if ($context eq 'portfolio') {
                   10972:             my $port_path = $dirpath;
                   10973:             if ($group ne '') {
                   10974:                 $port_path = "groups/$group/$port_path";
                   10975:             }
1.987     raeburn  10976:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   10977:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  10978:                                               $dir_root,$port_path,$disk_quota,
                   10979:                                               $current_disk_usage,$uname,$udom);
                   10980:             if ($state eq 'will_exceed_quota'
1.984     raeburn  10981:                 || $state eq 'file_locked') {
1.661     raeburn  10982:                 $output .= $msg;
                   10983:                 next;
                   10984:             }
                   10985:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   10986:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   10987:             if ($state eq 'exists') {
                   10988:                 $output .= $msg;
                   10989:                 next;
                   10990:             }
                   10991:         }
                   10992:         # Check if extension is valid
                   10993:         if (($fname =~ /\.(\w+)$/) &&
                   10994:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155    bisitz   10995:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   10996:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  10997:             next;
                   10998:         } elsif (($fname =~ /\.(\w+)$/) &&
                   10999:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  11000:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  11001:             next;
                   11002:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120    bisitz   11003:             $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  11004:             next;
                   11005:         }
                   11006:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123    raeburn  11007:         my $subdir = $path;
                   11008:         $subdir =~ s{/+$}{};
1.661     raeburn  11009:         if ($context eq 'portfolio') {
1.984     raeburn  11010:             my $result;
                   11011:             if ($state eq 'existingfile') {
                   11012:                 $result=
                   11013:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123    raeburn  11014:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  11015:             } else {
1.984     raeburn  11016:                 $result=
                   11017:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  11018:                                                     $dirpath.
1.1123    raeburn  11019:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  11020:                 if ($result !~ m|^/uploaded/|) {
                   11021:                     $output .= '<span class="LC_error">'
                   11022:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   11023:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   11024:                                .'</span><br />';
                   11025:                     next;
                   11026:                 } else {
1.987     raeburn  11027:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11028:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  11029:                 }
1.661     raeburn  11030:             }
1.1123    raeburn  11031:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126    raeburn  11032:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   11033:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  11034:             my $result =
1.1126    raeburn  11035:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  11036:             if ($result !~ m|^/uploaded/|) {
                   11037:                 $output .= '<span class="LC_error">'
                   11038:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   11039:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   11040:                            .'</span><br />';
                   11041:                     next;
                   11042:             } else {
                   11043:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11044:                            $path.$fname.'</span>').'<br />';
1.1125    raeburn  11045:                 if ($context eq 'syllabus') {
                   11046:                     &Apache::lonnet::make_public_indefinitely($result);
                   11047:                 }
1.987     raeburn  11048:             }
1.661     raeburn  11049:         } else {
                   11050: # Save the file
                   11051:             my $target = $env{'form.embedded_item_'.$i};
                   11052:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   11053:             my $dest = $fullpath.$fname;
                   11054:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  11055:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  11056:             my $count;
                   11057:             my $filepath = $dir_root;
1.1027    raeburn  11058:             foreach my $subdir (@parts) {
                   11059:                 $filepath .= "/$subdir";
                   11060:                 if (!-e $filepath) {
1.661     raeburn  11061:                     mkdir($filepath,0770);
                   11062:                 }
                   11063:             }
                   11064:             my $fh;
                   11065:             if (!open($fh,'>'.$dest)) {
                   11066:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   11067:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  11068:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   11069:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  11070:                            '</span><br />';
                   11071:             } else {
                   11072:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   11073:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   11074:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  11075:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   11076:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  11077:                               '</span><br />';
                   11078:                 } else {
1.987     raeburn  11079:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11080:                                $url.'</span>').'<br />';
                   11081:                     unless ($context eq 'testbank') {
                   11082:                         $footer .= &mt('View embedded file: [_1]',
                   11083:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   11084:                     }
                   11085:                 }
                   11086:                 close($fh);
                   11087:             }
                   11088:         }
                   11089:         if ($env{'form.embedded_ref_'.$i}) {
                   11090:             $pathchange{$i} = 1;
                   11091:         }
                   11092:     }
                   11093:     if ($output) {
                   11094:         $output = '<p>'.$output.'</p>';
                   11095:     }
                   11096:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   11097:     $returnflag = 'ok';
1.1071    raeburn  11098:     my $numpathchgs = scalar(keys(%pathchange));
                   11099:     if ($numpathchgs > 0) {
1.987     raeburn  11100:         if ($context eq 'portfolio') {
                   11101:             $output .= '<p>'.&mt('or').'</p>';
                   11102:         } elsif ($context eq 'testbank') {
1.1071    raeburn  11103:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   11104:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  11105:             $returnflag = 'modify_orightml';
                   11106:         }
                   11107:     }
1.1071    raeburn  11108:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  11109: }
                   11110: 
                   11111: sub modify_html_form {
                   11112:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   11113:     my $end = 0;
                   11114:     my $modifyform;
                   11115:     if ($context eq 'upload_embedded') {
                   11116:         return unless (ref($pathchange) eq 'HASH');
                   11117:         if ($env{'form.number_embedded_items'}) {
                   11118:             $end += $env{'form.number_embedded_items'};
                   11119:         }
                   11120:         if ($env{'form.number_pathchange_items'}) {
                   11121:             $end += $env{'form.number_pathchange_items'};
                   11122:         }
                   11123:         if ($end) {
                   11124:             for (my $i=0; $i<$end; $i++) {
                   11125:                 if ($i < $env{'form.number_embedded_items'}) {
                   11126:                     next unless($pathchange->{$i});
                   11127:                 }
                   11128:                 $modifyform .=
                   11129:                     &start_data_table_row().
                   11130:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   11131:                     'checked="checked" /></td>'.
                   11132:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   11133:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   11134:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   11135:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   11136:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   11137:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   11138:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   11139:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   11140:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   11141:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   11142:                     &end_data_table_row();
1.1071    raeburn  11143:             }
1.987     raeburn  11144:         }
                   11145:     } else {
                   11146:         $modifyform = $pathchgtable;
                   11147:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   11148:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   11149:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   11150:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   11151:         }
                   11152:     }
                   11153:     if ($modifyform) {
1.1071    raeburn  11154:         if ($actionurl eq '/adm/dependencies') {
                   11155:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   11156:         }
1.987     raeburn  11157:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   11158:                '<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".
                   11159:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   11160:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   11161:                '</ol></p>'."\n".'<p>'.
                   11162:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   11163:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   11164:                &start_data_table()."\n".
                   11165:                &start_data_table_header_row().
                   11166:                '<th>'.&mt('Change?').'</th>'.
                   11167:                '<th>'.&mt('Current reference').'</th>'.
                   11168:                '<th>'.&mt('Required reference').'</th>'.
                   11169:                &end_data_table_header_row()."\n".
                   11170:                $modifyform.
                   11171:                &end_data_table().'<br />'."\n".$hiddenstate.
                   11172:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   11173:                '</form>'."\n";
                   11174:     }
                   11175:     return;
                   11176: }
                   11177: 
                   11178: sub modify_html_refs {
1.1123    raeburn  11179:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  11180:     my $container;
                   11181:     if ($context eq 'portfolio') {
                   11182:         $container = $env{'form.container'};
                   11183:     } elsif ($context eq 'coursedoc') {
                   11184:         $container = $env{'form.primaryurl'};
1.1071    raeburn  11185:     } elsif ($context eq 'manage_dependencies') {
                   11186:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   11187:         $container = "/$container";
1.1123    raeburn  11188:     } elsif ($context eq 'syllabus') {
                   11189:         $container = $url;
1.987     raeburn  11190:     } else {
1.1027    raeburn  11191:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  11192:     }
                   11193:     my (%allfiles,%codebase,$output,$content);
                   11194:     my @changes = &get_env_multiple('form.namechange');
1.1126    raeburn  11195:     unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071    raeburn  11196:         if (wantarray) {
                   11197:             return ('',0,0); 
                   11198:         } else {
                   11199:             return;
                   11200:         }
                   11201:     }
                   11202:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  11203:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  11204:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   11205:             if (wantarray) {
                   11206:                 return ('',0,0);
                   11207:             } else {
                   11208:                 return;
                   11209:             }
                   11210:         } 
1.987     raeburn  11211:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  11212:         if ($content eq '-1') {
                   11213:             if (wantarray) {
                   11214:                 return ('',0,0);
                   11215:             } else {
                   11216:                 return;
                   11217:             }
                   11218:         }
1.987     raeburn  11219:     } else {
1.1071    raeburn  11220:         unless ($container =~ /^\Q$dir_root\E/) {
                   11221:             if (wantarray) {
                   11222:                 return ('',0,0);
                   11223:             } else {
                   11224:                 return;
                   11225:             }
                   11226:         } 
1.987     raeburn  11227:         if (open(my $fh,"<$container")) {
                   11228:             $content = join('', <$fh>);
                   11229:             close($fh);
                   11230:         } else {
1.1071    raeburn  11231:             if (wantarray) {
                   11232:                 return ('',0,0);
                   11233:             } else {
                   11234:                 return;
                   11235:             }
1.987     raeburn  11236:         }
                   11237:     }
                   11238:     my ($count,$codebasecount) = (0,0);
                   11239:     my $mm = new File::MMagic;
                   11240:     my $mime_type = $mm->checktype_contents($content);
                   11241:     if ($mime_type eq 'text/html') {
                   11242:         my $parse_result = 
                   11243:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   11244:                                                     \%codebase,\$content);
                   11245:         if ($parse_result eq 'ok') {
                   11246:             foreach my $i (@changes) {
                   11247:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   11248:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   11249:                 if ($allfiles{$ref}) {
                   11250:                     my $newname =  $orig;
                   11251:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  11252:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  11253:                     if ($attrib_regexp =~ /:/) {
                   11254:                         $attrib_regexp =~ s/\:/|/g;
                   11255:                     }
                   11256:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   11257:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   11258:                         $count += $numchg;
1.1123    raeburn  11259:                         $allfiles{$newname} = $allfiles{$ref};
1.1148    raeburn  11260:                         delete($allfiles{$ref});
1.987     raeburn  11261:                     }
                   11262:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  11263:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  11264:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   11265:                         $codebasecount ++;
                   11266:                     }
                   11267:                 }
                   11268:             }
1.1123    raeburn  11269:             my $skiprewrites;
1.987     raeburn  11270:             if ($count || $codebasecount) {
                   11271:                 my $saveresult;
1.1071    raeburn  11272:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  11273:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  11274:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   11275:                     if ($url eq $container) {
                   11276:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   11277:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   11278:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  11279:                                             $fname.'</span>').'</p>';
1.987     raeburn  11280:                     } else {
                   11281:                          $output = '<p class="LC_error">'.
                   11282:                                    &mt('Error: update failed for: [_1].',
                   11283:                                    '<span class="LC_filename">'.
                   11284:                                    $container.'</span>').'</p>';
                   11285:                     }
1.1123    raeburn  11286:                     if ($context eq 'syllabus') {
                   11287:                         unless ($saveresult eq 'ok') {
                   11288:                             $skiprewrites = 1;
                   11289:                         }
                   11290:                     }
1.987     raeburn  11291:                 } else {
                   11292:                     if (open(my $fh,">$container")) {
                   11293:                         print $fh $content;
                   11294:                         close($fh);
                   11295:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   11296:                                   $count,'<span class="LC_filename">'.
                   11297:                                   $container.'</span>').'</p>';
1.661     raeburn  11298:                     } else {
1.987     raeburn  11299:                          $output = '<p class="LC_error">'.
                   11300:                                    &mt('Error: could not update [_1].',
                   11301:                                    '<span class="LC_filename">'.
                   11302:                                    $container.'</span>').'</p>';
1.661     raeburn  11303:                     }
                   11304:                 }
                   11305:             }
1.1123    raeburn  11306:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   11307:                 my ($actionurl,$state);
                   11308:                 $actionurl = "/public/$udom/$uname/syllabus";
                   11309:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   11310:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   11311:                                               \%codebase,
                   11312:                                               {'context' => 'rewrites',
                   11313:                                                'ignore_remote_references' => 1,});
                   11314:                 if (ref($mapping) eq 'HASH') {
                   11315:                     my $rewrites = 0;
                   11316:                     foreach my $key (keys(%{$mapping})) {
                   11317:                         next if ($key =~ m{^https?://});
                   11318:                         my $ref = $mapping->{$key};
                   11319:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   11320:                         my $attrib;
                   11321:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   11322:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   11323:                         }
                   11324:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   11325:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   11326:                             $rewrites += $numchg;
                   11327:                         }
                   11328:                     }
                   11329:                     if ($rewrites) {
                   11330:                         my $saveresult; 
                   11331:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   11332:                         if ($url eq $container) {
                   11333:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   11334:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   11335:                                             $count,'<span class="LC_filename">'.
                   11336:                                             $fname.'</span>').'</p>';
                   11337:                         } else {
                   11338:                             $output .= '<p class="LC_error">'.
                   11339:                                        &mt('Error: could not update links in [_1].',
                   11340:                                        '<span class="LC_filename">'.
                   11341:                                        $container.'</span>').'</p>';
                   11342: 
                   11343:                         }
                   11344:                     }
                   11345:                 }
                   11346:             }
1.987     raeburn  11347:         } else {
                   11348:             &logthis('Failed to parse '.$container.
                   11349:                      ' to modify references: '.$parse_result);
1.661     raeburn  11350:         }
                   11351:     }
1.1071    raeburn  11352:     if (wantarray) {
                   11353:         return ($output,$count,$codebasecount);
                   11354:     } else {
                   11355:         return $output;
                   11356:     }
1.661     raeburn  11357: }
                   11358: 
                   11359: sub check_for_existing {
                   11360:     my ($path,$fname,$element) = @_;
                   11361:     my ($state,$msg);
                   11362:     if (-d $path.'/'.$fname) {
                   11363:         $state = 'exists';
                   11364:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   11365:     } elsif (-e $path.'/'.$fname) {
                   11366:         $state = 'exists';
                   11367:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   11368:     }
                   11369:     if ($state eq 'exists') {
                   11370:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   11371:     }
                   11372:     return ($state,$msg);
                   11373: }
                   11374: 
                   11375: sub check_for_upload {
                   11376:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   11377:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  11378:     my $filesize = length($env{'form.'.$element});
                   11379:     if (!$filesize) {
                   11380:         my $msg = '<span class="LC_error">'.
                   11381:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   11382:                       '<span class="LC_filename">'.$fname.'</span>',
                   11383:                       $filesize).'<br />'.
1.1007    raeburn  11384:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  11385:                   '</span>';
                   11386:         return ('zero_bytes',$msg);
                   11387:     }
                   11388:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  11389:     my $getpropath = 1;
1.1021    raeburn  11390:     my ($dirlistref,$listerror) =
                   11391:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  11392:     my $found_file = 0;
                   11393:     my $locked_file = 0;
1.991     raeburn  11394:     my @lockers;
                   11395:     my $navmap;
                   11396:     if ($env{'request.course.id'}) {
                   11397:         $navmap = Apache::lonnavmaps::navmap->new();
                   11398:     }
1.1021    raeburn  11399:     if (ref($dirlistref) eq 'ARRAY') {
                   11400:         foreach my $line (@{$dirlistref}) {
                   11401:             my ($file_name,$rest)=split(/\&/,$line,2);
                   11402:             if ($file_name eq $fname){
                   11403:                 $file_name = $path.$file_name;
                   11404:                 if ($group ne '') {
                   11405:                     $file_name = $group.$file_name;
                   11406:                 }
                   11407:                 $found_file = 1;
                   11408:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   11409:                     foreach my $lock (@lockers) {
                   11410:                         if (ref($lock) eq 'ARRAY') {
                   11411:                             my ($symb,$crsid) = @{$lock};
                   11412:                             if ($crsid eq $env{'request.course.id'}) {
                   11413:                                 if (ref($navmap)) {
                   11414:                                     my $res = $navmap->getBySymb($symb);
                   11415:                                     foreach my $part (@{$res->parts()}) { 
                   11416:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   11417:                                         unless (($slot_status == $res->RESERVED) ||
                   11418:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   11419:                                             $locked_file = 1;
                   11420:                                         }
1.991     raeburn  11421:                                     }
1.1021    raeburn  11422:                                 } else {
                   11423:                                     $locked_file = 1;
1.991     raeburn  11424:                                 }
                   11425:                             } else {
                   11426:                                 $locked_file = 1;
                   11427:                             }
                   11428:                         }
1.1021    raeburn  11429:                    }
                   11430:                 } else {
                   11431:                     my @info = split(/\&/,$rest);
                   11432:                     my $currsize = $info[6]/1000;
                   11433:                     if ($currsize < $filesize) {
                   11434:                         my $extra = $filesize - $currsize;
                   11435:                         if (($current_disk_usage + $extra) > $disk_quota) {
1.1179    bisitz   11436:                             my $msg = '<p class="LC_warning">'.
1.1021    raeburn  11437:                                       &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   11438:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                   11439:                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   11440:                                                    $disk_quota,$current_disk_usage).'</p>';
1.1021    raeburn  11441:                             return ('will_exceed_quota',$msg);
                   11442:                         }
1.984     raeburn  11443:                     }
                   11444:                 }
1.661     raeburn  11445:             }
                   11446:         }
                   11447:     }
                   11448:     if (($current_disk_usage + $filesize) > $disk_quota){
1.1179    bisitz   11449:         my $msg = '<p class="LC_warning">'.
                   11450:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184    raeburn  11451:                   '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661     raeburn  11452:         return ('will_exceed_quota',$msg);
                   11453:     } elsif ($found_file) {
                   11454:         if ($locked_file) {
1.1179    bisitz   11455:             my $msg = '<p class="LC_warning">';
1.661     raeburn  11456:             $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   11457:             $msg .= '</p>';
1.661     raeburn  11458:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   11459:             return ('file_locked',$msg);
                   11460:         } else {
1.1179    bisitz   11461:             my $msg = '<p class="LC_error">';
1.984     raeburn  11462:             $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   11463:             $msg .= '</p>';
1.984     raeburn  11464:             return ('existingfile',$msg);
1.661     raeburn  11465:         }
                   11466:     }
                   11467: }
                   11468: 
1.987     raeburn  11469: sub check_for_traversal {
                   11470:     my ($path,$url,$toplevel) = @_;
                   11471:     my @parts=split(/\//,$path);
                   11472:     my $cleanpath;
                   11473:     my $fullpath = $url;
                   11474:     for (my $i=0;$i<@parts;$i++) {
                   11475:         next if ($parts[$i] eq '.');
                   11476:         if ($parts[$i] eq '..') {
                   11477:             $fullpath =~ s{([^/]+/)$}{};
                   11478:         } else {
                   11479:             $fullpath .= $parts[$i].'/';
                   11480:         }
                   11481:     }
                   11482:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   11483:         $cleanpath = $1;
                   11484:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   11485:         my $curr_toprel = $1;
                   11486:         my @parts = split(/\//,$curr_toprel);
                   11487:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   11488:         my @urlparts = split(/\//,$url_toprel);
                   11489:         my $doubledots;
                   11490:         my $startdiff = -1;
                   11491:         for (my $i=0; $i<@urlparts; $i++) {
                   11492:             if ($startdiff == -1) {
                   11493:                 unless ($urlparts[$i] eq $parts[$i]) {
                   11494:                     $startdiff = $i;
                   11495:                     $doubledots .= '../';
                   11496:                 }
                   11497:             } else {
                   11498:                 $doubledots .= '../';
                   11499:             }
                   11500:         }
                   11501:         if ($startdiff > -1) {
                   11502:             $cleanpath = $doubledots;
                   11503:             for (my $i=$startdiff; $i<@parts; $i++) {
                   11504:                 $cleanpath .= $parts[$i].'/';
                   11505:             }
                   11506:         }
                   11507:     }
                   11508:     $cleanpath =~ s{(/)$}{};
                   11509:     return $cleanpath;
                   11510: }
1.31      albertel 11511: 
1.1053    raeburn  11512: sub is_archive_file {
                   11513:     my ($mimetype) = @_;
                   11514:     if (($mimetype eq 'application/octet-stream') ||
                   11515:         ($mimetype eq 'application/x-stuffit') ||
                   11516:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   11517:         return 1;
                   11518:     }
                   11519:     return;
                   11520: }
                   11521: 
                   11522: sub decompress_form {
1.1065    raeburn  11523:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  11524:     my %lt = &Apache::lonlocal::texthash (
                   11525:         this => 'This file is an archive file.',
1.1067    raeburn  11526:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  11527:         itsc => 'Its contents are as follows:',
1.1053    raeburn  11528:         youm => 'You may wish to extract its contents.',
                   11529:         extr => 'Extract contents',
1.1067    raeburn  11530:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   11531:         proa => 'Process automatically?',
1.1053    raeburn  11532:         yes  => 'Yes',
                   11533:         no   => 'No',
1.1067    raeburn  11534:         fold => 'Title for folder containing movie',
                   11535:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  11536:     );
1.1065    raeburn  11537:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  11538:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  11539:     my $info = &list_archive_contents($fileloc,\@paths);
                   11540:     if (@paths) {
                   11541:         foreach my $path (@paths) {
                   11542:             $path =~ s{^/}{};
1.1067    raeburn  11543:             if ($path =~ m{^([^/]+)/$}) {
                   11544:                 $topdir = $1;
                   11545:             }
1.1065    raeburn  11546:             if ($path =~ m{^([^/]+)/}) {
                   11547:                 $toplevel{$1} = $path;
                   11548:             } else {
                   11549:                 $toplevel{$path} = $path;
                   11550:             }
                   11551:         }
                   11552:     }
1.1067    raeburn  11553:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164    raeburn  11554:         my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067    raeburn  11555:                         "$topdir/media/",
                   11556:                         "$topdir/media/$topdir.mp4",
                   11557:                         "$topdir/media/FirstFrame.png",
                   11558:                         "$topdir/media/player.swf",
                   11559:                         "$topdir/media/swfobject.js",
                   11560:                         "$topdir/media/expressInstall.swf");
1.1197    raeburn  11561:         my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164    raeburn  11562:                          "$topdir/$topdir.mp4",
                   11563:                          "$topdir/$topdir\_config.xml",
                   11564:                          "$topdir/$topdir\_controller.swf",
                   11565:                          "$topdir/$topdir\_embed.css",
                   11566:                          "$topdir/$topdir\_First_Frame.png",
                   11567:                          "$topdir/$topdir\_player.html",
                   11568:                          "$topdir/$topdir\_Thumbnails.png",
                   11569:                          "$topdir/playerProductInstall.swf",
                   11570:                          "$topdir/scripts/",
                   11571:                          "$topdir/scripts/config_xml.js",
                   11572:                          "$topdir/scripts/handlebars.js",
                   11573:                          "$topdir/scripts/jquery-1.7.1.min.js",
                   11574:                          "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                   11575:                          "$topdir/scripts/modernizr.js",
                   11576:                          "$topdir/scripts/player-min.js",
                   11577:                          "$topdir/scripts/swfobject.js",
                   11578:                          "$topdir/skins/",
                   11579:                          "$topdir/skins/configuration_express.xml",
                   11580:                          "$topdir/skins/express_show/",
                   11581:                          "$topdir/skins/express_show/player-min.css",
                   11582:                          "$topdir/skins/express_show/spritesheet.png");
1.1197    raeburn  11583:         my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
                   11584:                          "$topdir/$topdir.mp4",
                   11585:                          "$topdir/$topdir\_config.xml",
                   11586:                          "$topdir/$topdir\_controller.swf",
                   11587:                          "$topdir/$topdir\_embed.css",
                   11588:                          "$topdir/$topdir\_First_Frame.png",
                   11589:                          "$topdir/$topdir\_player.html",
                   11590:                          "$topdir/$topdir\_Thumbnails.png",
                   11591:                          "$topdir/playerProductInstall.swf",
                   11592:                          "$topdir/scripts/",
                   11593:                          "$topdir/scripts/config_xml.js",
                   11594:                          "$topdir/scripts/techsmith-smart-player.min.js",
                   11595:                          "$topdir/skins/",
                   11596:                          "$topdir/skins/configuration_express.xml",
                   11597:                          "$topdir/skins/express_show/",
                   11598:                          "$topdir/skins/express_show/spritesheet.min.css",
                   11599:                          "$topdir/skins/express_show/spritesheet.png",
                   11600:                          "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164    raeburn  11601:         my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067    raeburn  11602:         if (@diffs == 0) {
1.1164    raeburn  11603:             $is_camtasia = 6;
                   11604:         } else {
1.1197    raeburn  11605:             @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164    raeburn  11606:             if (@diffs == 0) {
                   11607:                 $is_camtasia = 8;
1.1197    raeburn  11608:             } else {
                   11609:                 @diffs = &compare_arrays(\@paths,\@camtasia8_4);
                   11610:                 if (@diffs == 0) {
                   11611:                     $is_camtasia = 8;
                   11612:                 }
1.1164    raeburn  11613:             }
1.1067    raeburn  11614:         }
                   11615:     }
                   11616:     my $output;
                   11617:     if ($is_camtasia) {
                   11618:         $output = <<"ENDCAM";
                   11619: <script type="text/javascript" language="Javascript">
                   11620: // <![CDATA[
                   11621: 
                   11622: function camtasiaToggle() {
                   11623:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   11624:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164    raeburn  11625:             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067    raeburn  11626:                 document.getElementById('camtasia_titles').style.display='block';
                   11627:             } else {
                   11628:                 document.getElementById('camtasia_titles').style.display='none';
                   11629:             }
                   11630:         }
                   11631:     }
                   11632:     return;
                   11633: }
                   11634: 
                   11635: // ]]>
                   11636: </script>
                   11637: <p>$lt{'camt'}</p>
                   11638: ENDCAM
1.1065    raeburn  11639:     } else {
1.1067    raeburn  11640:         $output = '<p>'.$lt{'this'};
                   11641:         if ($info eq '') {
                   11642:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   11643:         } else {
                   11644:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   11645:                        '<div><pre>'.$info.'</pre></div>';
                   11646:         }
1.1065    raeburn  11647:     }
1.1067    raeburn  11648:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  11649:     my $duplicates;
                   11650:     my $num = 0;
                   11651:     if (ref($dirlist) eq 'ARRAY') {
                   11652:         foreach my $item (@{$dirlist}) {
                   11653:             if (ref($item) eq 'ARRAY') {
                   11654:                 if (exists($toplevel{$item->[0]})) {
                   11655:                     $duplicates .= 
                   11656:                         &start_data_table_row().
                   11657:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11658:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   11659:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11660:                         'value="1" />'.&mt('Yes').'</label>'.
                   11661:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   11662:                         '<td>'.$item->[0].'</td>';
                   11663:                     if ($item->[2]) {
                   11664:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   11665:                     } else {
                   11666:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   11667:                     }
                   11668:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   11669:                                    '<td>'.
                   11670:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   11671:                                    '</td>'.
                   11672:                                    &end_data_table_row();
                   11673:                     $num ++;
                   11674:                 }
                   11675:             }
                   11676:         }
                   11677:     }
                   11678:     my $itemcount;
                   11679:     if (@paths > 0) {
                   11680:         $itemcount = scalar(@paths);
                   11681:     } else {
                   11682:         $itemcount = 1;
                   11683:     }
1.1067    raeburn  11684:     if ($is_camtasia) {
                   11685:         $output .= $lt{'auto'}.'<br />'.
                   11686:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164    raeburn  11687:                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067    raeburn  11688:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   11689:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   11690:                    $lt{'no'}.'</label></span><br />'.
                   11691:                    '<div id="camtasia_titles" style="display:block">'.
                   11692:                    &Apache::lonhtmlcommon::start_pick_box().
                   11693:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   11694:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   11695:                    &Apache::lonhtmlcommon::row_closure().
                   11696:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   11697:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   11698:                    &Apache::lonhtmlcommon::row_closure(1).
                   11699:                    &Apache::lonhtmlcommon::end_pick_box().
                   11700:                    '</div>';
                   11701:     }
1.1065    raeburn  11702:     $output .= 
                   11703:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  11704:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   11705:         "\n";
1.1065    raeburn  11706:     if ($duplicates ne '') {
                   11707:         $output .= '<p><span class="LC_warning">'.
                   11708:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   11709:                    &start_data_table().
                   11710:                    &start_data_table_header_row().
                   11711:                    '<th>'.&mt('Overwrite?').'</th>'.
                   11712:                    '<th>'.&mt('Name').'</th>'.
                   11713:                    '<th>'.&mt('Type').'</th>'.
                   11714:                    '<th>'.&mt('Size').'</th>'.
                   11715:                    '<th>'.&mt('Last modified').'</th>'.
                   11716:                    &end_data_table_header_row().
                   11717:                    $duplicates.
                   11718:                    &end_data_table().
                   11719:                    '</p>';
                   11720:     }
1.1067    raeburn  11721:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  11722:     if (ref($hiddenelements) eq 'HASH') {
                   11723:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   11724:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   11725:         }
                   11726:     }
                   11727:     $output .= <<"END";
1.1067    raeburn  11728: <br />
1.1053    raeburn  11729: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   11730: </form>
                   11731: $noextract
                   11732: END
                   11733:     return $output;
                   11734: }
                   11735: 
1.1065    raeburn  11736: sub decompression_utility {
                   11737:     my ($program) = @_;
                   11738:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   11739:     my $location;
                   11740:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   11741:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   11742:                          '/usr/sbin/') {
                   11743:             if (-x $dir.$program) {
                   11744:                 $location = $dir.$program;
                   11745:                 last;
                   11746:             }
                   11747:         }
                   11748:     }
                   11749:     return $location;
                   11750: }
                   11751: 
                   11752: sub list_archive_contents {
                   11753:     my ($file,$pathsref) = @_;
                   11754:     my (@cmd,$output);
                   11755:     my $needsregexp;
                   11756:     if ($file =~ /\.zip$/) {
                   11757:         @cmd = (&decompression_utility('unzip'),"-l");
                   11758:         $needsregexp = 1;
                   11759:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   11760:              ($file =~ /\.tgz$/)) {
                   11761:         @cmd = (&decompression_utility('tar'),"-ztf");
                   11762:     } elsif ($file =~ /\.tar\.bz2$/) {
                   11763:         @cmd = (&decompression_utility('tar'),"-jtf");
                   11764:     } elsif ($file =~ m|\.tar$|) {
                   11765:         @cmd = (&decompression_utility('tar'),"-tf");
                   11766:     }
                   11767:     if (@cmd) {
                   11768:         undef($!);
                   11769:         undef($@);
                   11770:         if (open(my $fh,"-|", @cmd, $file)) {
                   11771:             while (my $line = <$fh>) {
                   11772:                 $output .= $line;
                   11773:                 chomp($line);
                   11774:                 my $item;
                   11775:                 if ($needsregexp) {
                   11776:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   11777:                 } else {
                   11778:                     $item = $line;
                   11779:                 }
                   11780:                 if ($item ne '') {
                   11781:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   11782:                         push(@{$pathsref},$item);
                   11783:                     } 
                   11784:                 }
                   11785:             }
                   11786:             close($fh);
                   11787:         }
                   11788:     }
                   11789:     return $output;
                   11790: }
                   11791: 
1.1053    raeburn  11792: sub decompress_uploaded_file {
                   11793:     my ($file,$dir) = @_;
                   11794:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   11795:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   11796:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   11797:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   11798:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   11799:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   11800:     my $decompressed = $env{'cgi.decompressed'};
                   11801:     &Apache::lonnet::delenv('cgi.file');
                   11802:     &Apache::lonnet::delenv('cgi.dir');
                   11803:     &Apache::lonnet::delenv('cgi.decompressed');
                   11804:     return ($decompressed,$result);
                   11805: }
                   11806: 
1.1055    raeburn  11807: sub process_decompression {
                   11808:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   11809:     my ($dir,$error,$warning,$output);
1.1180    raeburn  11810:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120    bisitz   11811:         $error = &mt('Filename not a supported archive file type.').
                   11812:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  11813:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   11814:     } else {
                   11815:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11816:         if ($docuhome eq 'no_host') {
                   11817:             $error = &mt('Could not determine home server for course.');
                   11818:         } else {
                   11819:             my @ids=&Apache::lonnet::current_machine_ids();
                   11820:             my $currdir = "$dir_root/$destination";
                   11821:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11822:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   11823:                        "$dir_root/$destination";
                   11824:             } else {
                   11825:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   11826:                        "$dir_root/$docudom/$docuname/$destination";
                   11827:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   11828:                     $error = &mt('Archive file not found.');
                   11829:                 }
                   11830:             }
1.1065    raeburn  11831:             my (@to_overwrite,@to_skip);
                   11832:             if ($env{'form.archive_overwrite_total'} > 0) {
                   11833:                 my $total = $env{'form.archive_overwrite_total'};
                   11834:                 for (my $i=0; $i<$total; $i++) {
                   11835:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   11836:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   11837:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   11838:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   11839:                     }
                   11840:                 }
                   11841:             }
                   11842:             my $numskip = scalar(@to_skip);
                   11843:             if (($numskip > 0) && 
                   11844:                 ($numskip == $env{'form.archive_itemcount'})) {
                   11845:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   11846:             } elsif ($dir eq '') {
1.1055    raeburn  11847:                 $error = &mt('Directory containing archive file unavailable.');
                   11848:             } elsif (!$error) {
1.1065    raeburn  11849:                 my ($decompressed,$display);
                   11850:                 if ($numskip > 0) {
                   11851:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   11852:                     mkdir("$dir/$tempdir",0755);
                   11853:                     system("mv $dir/$file $dir/$tempdir/$file");
                   11854:                     ($decompressed,$display) = 
                   11855:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   11856:                     foreach my $item (@to_skip) {
                   11857:                         if (($item ne '') && ($item !~ /\.\./)) {
                   11858:                             if (-f "$dir/$tempdir/$item") { 
                   11859:                                 unlink("$dir/$tempdir/$item");
                   11860:                             } elsif (-d "$dir/$tempdir/$item") {
                   11861:                                 system("rm -rf $dir/$tempdir/$item");
                   11862:                             }
                   11863:                         }
                   11864:                     }
                   11865:                     system("mv $dir/$tempdir/* $dir");
                   11866:                     rmdir("$dir/$tempdir");   
                   11867:                 } else {
                   11868:                     ($decompressed,$display) = 
                   11869:                         &decompress_uploaded_file($file,$dir);
                   11870:                 }
1.1055    raeburn  11871:                 if ($decompressed eq 'ok') {
1.1065    raeburn  11872:                     $output = '<p class="LC_info">'.
                   11873:                               &mt('Files extracted successfully from archive.').
                   11874:                               '</p>'."\n";
1.1055    raeburn  11875:                     my ($warning,$result,@contents);
                   11876:                     my ($newdirlistref,$newlisterror) =
                   11877:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   11878:                                                  $docuname,1);
                   11879:                     my (%is_dir,%changes,@newitems);
                   11880:                     my $dirptr = 16384;
1.1065    raeburn  11881:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  11882:                         foreach my $dir_line (@{$newdirlistref}) {
                   11883:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  11884:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   11885:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  11886:                                 push(@newitems,$item);
                   11887:                                 if ($dirptr&$testdir) {
                   11888:                                     $is_dir{$item} = 1;
                   11889:                                 }
                   11890:                                 $changes{$item} = 1;
                   11891:                             }
                   11892:                         }
                   11893:                     }
                   11894:                     if (keys(%changes) > 0) {
                   11895:                         foreach my $item (sort(@newitems)) {
                   11896:                             if ($changes{$item}) {
                   11897:                                 push(@contents,$item);
                   11898:                             }
                   11899:                         }
                   11900:                     }
                   11901:                     if (@contents > 0) {
1.1067    raeburn  11902:                         my $wantform;
                   11903:                         unless ($env{'form.autoextract_camtasia'}) {
                   11904:                             $wantform = 1;
                   11905:                         }
1.1056    raeburn  11906:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  11907:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   11908:                                                                 $currdir,\%is_dir,
                   11909:                                                                 \%children,\%parent,
1.1056    raeburn  11910:                                                                 \@contents,\%dirorder,
                   11911:                                                                 \%titles,$wantform);
1.1055    raeburn  11912:                         if ($datatable ne '') {
                   11913:                             $output .= &archive_options_form('decompressed',$datatable,
                   11914:                                                              $count,$hiddenelem);
1.1065    raeburn  11915:                             my $startcount = 6;
1.1055    raeburn  11916:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  11917:                                                            \%titles,\%children);
1.1055    raeburn  11918:                         }
1.1067    raeburn  11919:                         if ($env{'form.autoextract_camtasia'}) {
1.1164    raeburn  11920:                             my $version = $env{'form.autoextract_camtasia'};
1.1067    raeburn  11921:                             my %displayed;
                   11922:                             my $total = 1;
                   11923:                             $env{'form.archive_directory'} = [];
                   11924:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   11925:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   11926:                                 $path =~ s{/$}{};
                   11927:                                 my $item;
                   11928:                                 if ($path ne '') {
                   11929:                                     $item = "$path/$titles{$i}";
                   11930:                                 } else {
                   11931:                                     $item = $titles{$i};
                   11932:                                 }
                   11933:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   11934:                                 if ($item eq $contents[0]) {
                   11935:                                     push(@{$env{'form.archive_directory'}},$i);
                   11936:                                     $env{'form.archive_'.$i} = 'display';
                   11937:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   11938:                                     $displayed{'folder'} = $i;
1.1164    raeburn  11939:                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                   11940:                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { 
1.1067    raeburn  11941:                                     $env{'form.archive_'.$i} = 'display';
                   11942:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   11943:                                     $displayed{'web'} = $i;
                   11944:                                 } else {
1.1164    raeburn  11945:                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                   11946:                                         ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                   11947:                                              ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067    raeburn  11948:                                         push(@{$env{'form.archive_directory'}},$i);
                   11949:                                     }
                   11950:                                     $env{'form.archive_'.$i} = 'dependency';
                   11951:                                 }
                   11952:                                 $total ++;
                   11953:                             }
                   11954:                             for (my $i=1; $i<$total; $i++) {
                   11955:                                 next if ($i == $displayed{'web'});
                   11956:                                 next if ($i == $displayed{'folder'});
                   11957:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   11958:                             }
                   11959:                             $env{'form.phase'} = 'decompress_cleanup';
                   11960:                             $env{'form.archivedelete'} = 1;
                   11961:                             $env{'form.archive_count'} = $total-1;
                   11962:                             $output .=
                   11963:                                 &process_extracted_files('coursedocs',$docudom,
                   11964:                                                          $docuname,$destination,
                   11965:                                                          $dir_root,$hiddenelem);
                   11966:                         }
1.1055    raeburn  11967:                     } else {
                   11968:                         $warning = &mt('No new items extracted from archive file.');
                   11969:                     }
                   11970:                 } else {
                   11971:                     $output = $display;
                   11972:                     $error = &mt('An error occurred during extraction from the archive file.');
                   11973:                 }
                   11974:             }
                   11975:         }
                   11976:     }
                   11977:     if ($error) {
                   11978:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11979:                    $error.'</p>'."\n";
                   11980:     }
                   11981:     if ($warning) {
                   11982:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11983:     }
                   11984:     return $output;
                   11985: }
                   11986: 
                   11987: sub get_extracted {
1.1056    raeburn  11988:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   11989:         $titles,$wantform) = @_;
1.1055    raeburn  11990:     my $count = 0;
                   11991:     my $depth = 0;
                   11992:     my $datatable;
1.1056    raeburn  11993:     my @hierarchy;
1.1055    raeburn  11994:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  11995:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   11996:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  11997:     foreach my $item (@{$contents}) {
                   11998:         $count ++;
1.1056    raeburn  11999:         @{$dirorder->{$count}} = @hierarchy;
                   12000:         $titles->{$count} = $item;
1.1055    raeburn  12001:         &archive_hierarchy($depth,$count,$parent,$children);
                   12002:         if ($wantform) {
                   12003:             $datatable .= &archive_row($is_dir->{$item},$item,
                   12004:                                        $currdir,$depth,$count);
                   12005:         }
                   12006:         if ($is_dir->{$item}) {
                   12007:             $depth ++;
1.1056    raeburn  12008:             push(@hierarchy,$count);
                   12009:             $parent->{$depth} = $count;
1.1055    raeburn  12010:             $datatable .=
                   12011:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  12012:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   12013:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  12014:             $depth --;
1.1056    raeburn  12015:             pop(@hierarchy);
1.1055    raeburn  12016:         }
                   12017:     }
                   12018:     return ($count,$datatable);
                   12019: }
                   12020: 
                   12021: sub recurse_extracted_archive {
1.1056    raeburn  12022:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   12023:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  12024:     my $result='';
1.1056    raeburn  12025:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   12026:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   12027:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  12028:         return $result;
                   12029:     }
                   12030:     my $dirptr = 16384;
                   12031:     my ($newdirlistref,$newlisterror) =
                   12032:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   12033:     if (ref($newdirlistref) eq 'ARRAY') {
                   12034:         foreach my $dir_line (@{$newdirlistref}) {
                   12035:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   12036:             unless ($item =~ /^\.+$/) {
                   12037:                 $$count ++;
1.1056    raeburn  12038:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   12039:                 $titles->{$$count} = $item;
1.1055    raeburn  12040:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  12041: 
1.1055    raeburn  12042:                 my $is_dir;
                   12043:                 if ($dirptr&$testdir) {
                   12044:                     $is_dir = 1;
                   12045:                 }
                   12046:                 if ($wantform) {
                   12047:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   12048:                 }
                   12049:                 if ($is_dir) {
                   12050:                     $$depth ++;
1.1056    raeburn  12051:                     push(@{$hierarchy},$$count);
                   12052:                     $parent->{$$depth} = $$count;
1.1055    raeburn  12053:                     $result .=
                   12054:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   12055:                                                    $docuname,$depth,$count,
1.1056    raeburn  12056:                                                    $hierarchy,$dirorder,$children,
                   12057:                                                    $parent,$titles,$wantform);
1.1055    raeburn  12058:                     $$depth --;
1.1056    raeburn  12059:                     pop(@{$hierarchy});
1.1055    raeburn  12060:                 }
                   12061:             }
                   12062:         }
                   12063:     }
                   12064:     return $result;
                   12065: }
                   12066: 
                   12067: sub archive_hierarchy {
                   12068:     my ($depth,$count,$parent,$children) =@_;
                   12069:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   12070:         if (exists($parent->{$depth})) {
                   12071:              $children->{$parent->{$depth}} .= $count.':';
                   12072:         }
                   12073:     }
                   12074:     return;
                   12075: }
                   12076: 
                   12077: sub archive_row {
                   12078:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   12079:     my ($name) = ($item =~ m{([^/]+)$});
                   12080:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  12081:                                        'display'    => 'Add as file',
1.1055    raeburn  12082:                                        'dependency' => 'Include as dependency',
                   12083:                                        'discard'    => 'Discard',
                   12084:                                       );
                   12085:     if ($is_dir) {
1.1059    raeburn  12086:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  12087:     }
1.1056    raeburn  12088:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   12089:     my $offset = 0;
1.1055    raeburn  12090:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  12091:         $offset ++;
1.1065    raeburn  12092:         if ($action ne 'display') {
                   12093:             $offset ++;
                   12094:         }  
1.1055    raeburn  12095:         $output .= '<td><span class="LC_nobreak">'.
                   12096:                    '<label><input type="radio" name="archive_'.$count.
                   12097:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   12098:         my $text = $choices{$action};
                   12099:         if ($is_dir) {
                   12100:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   12101:             if ($action eq 'display') {
1.1059    raeburn  12102:                 $text = &mt('Add as folder');
1.1055    raeburn  12103:             }
1.1056    raeburn  12104:         } else {
                   12105:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   12106: 
                   12107:         }
                   12108:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   12109:         if ($action eq 'dependency') {
                   12110:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   12111:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   12112:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   12113:                        '<option value=""></option>'."\n".
                   12114:                        '</select>'."\n".
                   12115:                        '</div>';
1.1059    raeburn  12116:         } elsif ($action eq 'display') {
                   12117:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   12118:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   12119:                        '</div>';
1.1055    raeburn  12120:         }
1.1056    raeburn  12121:         $output .= '</td>';
1.1055    raeburn  12122:     }
                   12123:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   12124:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   12125:     for (my $i=0; $i<$depth; $i++) {
                   12126:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   12127:     }
                   12128:     if ($is_dir) {
                   12129:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   12130:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   12131:     } else {
                   12132:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   12133:     }
                   12134:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   12135:                &end_data_table_row();
                   12136:     return $output;
                   12137: }
                   12138: 
                   12139: sub archive_options_form {
1.1065    raeburn  12140:     my ($form,$display,$count,$hiddenelem) = @_;
                   12141:     my %lt = &Apache::lonlocal::texthash(
                   12142:                perm => 'Permanently remove archive file?',
                   12143:                hows => 'How should each extracted item be incorporated in the course?',
                   12144:                cont => 'Content actions for all',
                   12145:                addf => 'Add as folder/file',
                   12146:                incd => 'Include as dependency for a displayed file',
                   12147:                disc => 'Discard',
                   12148:                no   => 'No',
                   12149:                yes  => 'Yes',
                   12150:                save => 'Save',
                   12151:     );
                   12152:     my $output = <<"END";
                   12153: <form name="$form" method="post" action="">
                   12154: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   12155: <label>
                   12156:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   12157: </label>
                   12158: &nbsp;
                   12159: <label>
                   12160:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   12161: </span>
                   12162: </p>
                   12163: <input type="hidden" name="phase" value="decompress_cleanup" />
                   12164: <br />$lt{'hows'}
                   12165: <div class="LC_columnSection">
                   12166:   <fieldset>
                   12167:     <legend>$lt{'cont'}</legend>
                   12168:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   12169:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   12170:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   12171:   </fieldset>
                   12172: </div>
                   12173: END
                   12174:     return $output.
1.1055    raeburn  12175:            &start_data_table()."\n".
1.1065    raeburn  12176:            $display."\n".
1.1055    raeburn  12177:            &end_data_table()."\n".
                   12178:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   12179:            $hiddenelem.
1.1065    raeburn  12180:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  12181:            '</form>';
                   12182: }
                   12183: 
                   12184: sub archive_javascript {
1.1056    raeburn  12185:     my ($startcount,$numitems,$titles,$children) = @_;
                   12186:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  12187:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  12188:     my $scripttag = <<START;
                   12189: <script type="text/javascript">
                   12190: // <![CDATA[
                   12191: 
                   12192: function checkAll(form,prefix) {
                   12193:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   12194:     for (var i=0; i < form.elements.length; i++) {
                   12195:         var id = form.elements[i].id;
                   12196:         if ((id != '') && (id != undefined)) {
                   12197:             if (idstr.test(id)) {
                   12198:                 if (form.elements[i].type == 'radio') {
                   12199:                     form.elements[i].checked = true;
1.1056    raeburn  12200:                     var nostart = i-$startcount;
1.1059    raeburn  12201:                     var offset = nostart%7;
                   12202:                     var count = (nostart-offset)/7;    
1.1056    raeburn  12203:                     dependencyCheck(form,count,offset);
1.1055    raeburn  12204:                 }
                   12205:             }
                   12206:         }
                   12207:     }
                   12208: }
                   12209: 
                   12210: function propagateCheck(form,count) {
                   12211:     if (count > 0) {
1.1059    raeburn  12212:         var startelement = $startcount + ((count-1) * 7);
                   12213:         for (var j=1; j<6; j++) {
                   12214:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  12215:                 var item = startelement + j; 
                   12216:                 if (form.elements[item].type == 'radio') {
                   12217:                     if (form.elements[item].checked) {
                   12218:                         containerCheck(form,count,j);
                   12219:                         break;
                   12220:                     }
1.1055    raeburn  12221:                 }
                   12222:             }
                   12223:         }
                   12224:     }
                   12225: }
                   12226: 
                   12227: numitems = $numitems
1.1056    raeburn  12228: var titles = new Array(numitems);
                   12229: var parents = new Array(numitems);
1.1055    raeburn  12230: for (var i=0; i<numitems; i++) {
1.1056    raeburn  12231:     parents[i] = new Array;
1.1055    raeburn  12232: }
1.1059    raeburn  12233: var maintitle = '$maintitle';
1.1055    raeburn  12234: 
                   12235: START
                   12236: 
1.1056    raeburn  12237:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   12238:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  12239:         for (my $i=0; $i<@contents; $i ++) {
                   12240:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   12241:         }
                   12242:     }
                   12243: 
1.1056    raeburn  12244:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   12245:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   12246:     }
                   12247: 
1.1055    raeburn  12248:     $scripttag .= <<END;
                   12249: 
                   12250: function containerCheck(form,count,offset) {
                   12251:     if (count > 0) {
1.1056    raeburn  12252:         dependencyCheck(form,count,offset);
1.1059    raeburn  12253:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  12254:         form.elements[item].checked = true;
                   12255:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12256:             if (parents[count].length > 0) {
                   12257:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  12258:                     containerCheck(form,parents[count][j],offset);
                   12259:                 }
                   12260:             }
                   12261:         }
                   12262:     }
                   12263: }
                   12264: 
                   12265: function dependencyCheck(form,count,offset) {
                   12266:     if (count > 0) {
1.1059    raeburn  12267:         var chosen = (offset+$startcount)+7*(count-1);
                   12268:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  12269:         var currtype = form.elements[depitem].type;
                   12270:         if (form.elements[chosen].value == 'dependency') {
                   12271:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   12272:             form.elements[depitem].options.length = 0;
                   12273:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085    raeburn  12274:             for (var i=1; i<=numitems; i++) {
                   12275:                 if (i == count) {
                   12276:                     continue;
                   12277:                 }
1.1059    raeburn  12278:                 var startelement = $startcount + (i-1) * 7;
                   12279:                 for (var j=1; j<6; j++) {
                   12280:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  12281:                         var item = startelement + j;
                   12282:                         if (form.elements[item].type == 'radio') {
                   12283:                             if (form.elements[item].checked) {
                   12284:                                 if (form.elements[item].value == 'display') {
                   12285:                                     var n = form.elements[depitem].options.length;
                   12286:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   12287:                                 }
                   12288:                             }
                   12289:                         }
                   12290:                     }
                   12291:                 }
                   12292:             }
                   12293:         } else {
                   12294:             document.getElementById('arc_depon_'+count).style.display='none';
                   12295:             form.elements[depitem].options.length = 0;
                   12296:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   12297:         }
1.1059    raeburn  12298:         titleCheck(form,count,offset);
1.1056    raeburn  12299:     }
                   12300: }
                   12301: 
                   12302: function propagateSelect(form,count,offset) {
                   12303:     if (count > 0) {
1.1065    raeburn  12304:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  12305:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   12306:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12307:             if (parents[count].length > 0) {
                   12308:                 for (var j=0; j<parents[count].length; j++) {
                   12309:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  12310:                 }
                   12311:             }
                   12312:         }
                   12313:     }
                   12314: }
1.1056    raeburn  12315: 
                   12316: function containerSelect(form,count,offset,picked) {
                   12317:     if (count > 0) {
1.1065    raeburn  12318:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  12319:         if (form.elements[item].type == 'radio') {
                   12320:             if (form.elements[item].value == 'dependency') {
                   12321:                 if (form.elements[item+1].type == 'select-one') {
                   12322:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   12323:                         if (form.elements[item+1].options[i].value == picked) {
                   12324:                             form.elements[item+1].selectedIndex = i;
                   12325:                             break;
                   12326:                         }
                   12327:                     }
                   12328:                 }
                   12329:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   12330:                     if (parents[count].length > 0) {
                   12331:                         for (var j=0; j<parents[count].length; j++) {
                   12332:                             containerSelect(form,parents[count][j],offset,picked);
                   12333:                         }
                   12334:                     }
                   12335:                 }
                   12336:             }
                   12337:         }
                   12338:     }
                   12339: }
                   12340: 
1.1059    raeburn  12341: function titleCheck(form,count,offset) {
                   12342:     if (count > 0) {
                   12343:         var chosen = (offset+$startcount)+7*(count-1);
                   12344:         var depitem = $startcount + ((count-1) * 7) + 2;
                   12345:         var currtype = form.elements[depitem].type;
                   12346:         if (form.elements[chosen].value == 'display') {
                   12347:             document.getElementById('arc_title_'+count).style.display='block';
                   12348:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   12349:                 document.getElementById('archive_title_'+count).value=maintitle;
                   12350:             }
                   12351:         } else {
                   12352:             document.getElementById('arc_title_'+count).style.display='none';
                   12353:             if (currtype == 'text') { 
                   12354:                 document.getElementById('archive_title_'+count).value='';
                   12355:             }
                   12356:         }
                   12357:     }
                   12358:     return;
                   12359: }
                   12360: 
1.1055    raeburn  12361: // ]]>
                   12362: </script>
                   12363: END
                   12364:     return $scripttag;
                   12365: }
                   12366: 
                   12367: sub process_extracted_files {
1.1067    raeburn  12368:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  12369:     my $numitems = $env{'form.archive_count'};
                   12370:     return unless ($numitems);
                   12371:     my @ids=&Apache::lonnet::current_machine_ids();
                   12372:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  12373:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  12374:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   12375:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   12376:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   12377:         $pathtocheck = "$dir_root/$destination";
                   12378:         $dir = $dir_root;
                   12379:         $ishome = 1;
                   12380:     } else {
                   12381:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   12382:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   12383:         $dir = "$dir_root/$docudom/$docuname";    
                   12384:     }
                   12385:     my $currdir = "$dir_root/$destination";
                   12386:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   12387:     if ($env{'form.folderpath'}) {
                   12388:         my @items = split('&',$env{'form.folderpath'});
                   12389:         $folders{'0'} = $items[-2];
1.1099    raeburn  12390:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   12391:             $containers{'0'}='page';
                   12392:         } else {  
                   12393:             $containers{'0'}='sequence';
                   12394:         }
1.1055    raeburn  12395:     }
                   12396:     my @archdirs = &get_env_multiple('form.archive_directory');
                   12397:     if ($numitems) {
                   12398:         for (my $i=1; $i<=$numitems; $i++) {
                   12399:             my $path = $env{'form.archive_content_'.$i};
                   12400:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   12401:                 my $item = $1;
                   12402:                 $toplevelitems{$item} = $i;
                   12403:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   12404:                     $is_dir{$item} = 1;
                   12405:                 }
                   12406:             }
                   12407:         }
                   12408:     }
1.1067    raeburn  12409:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  12410:     if (keys(%toplevelitems) > 0) {
                   12411:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  12412:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   12413:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  12414:     }
1.1066    raeburn  12415:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  12416:     if ($numitems) {
                   12417:         for (my $i=1; $i<=$numitems; $i++) {
1.1086    raeburn  12418:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  12419:             my $path = $env{'form.archive_content_'.$i};
                   12420:             if ($path =~ /^\Q$pathtocheck\E/) {
                   12421:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   12422:                     if ($prefix ne '' && $path ne '') {
                   12423:                         if (-e $prefix.$path) {
1.1066    raeburn  12424:                             if ((@archdirs > 0) && 
                   12425:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   12426:                                 $todeletedir{$prefix.$path} = 1;
                   12427:                             } else {
                   12428:                                 $todelete{$prefix.$path} = 1;
                   12429:                             }
1.1055    raeburn  12430:                         }
                   12431:                     }
                   12432:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  12433:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  12434:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  12435:                     $docstitle = $env{'form.archive_title_'.$i};
                   12436:                     if ($docstitle eq '') {
                   12437:                         $docstitle = $title;
                   12438:                     }
1.1055    raeburn  12439:                     $outer = 0;
1.1056    raeburn  12440:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   12441:                         if (@{$dirorder{$i}} > 0) {
                   12442:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  12443:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   12444:                                     $outer = $item;
                   12445:                                     last;
                   12446:                                 }
                   12447:                             }
                   12448:                         }
                   12449:                     }
                   12450:                     my ($errtext,$fatal) = 
                   12451:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   12452:                                                '/'.$folders{$outer}.'.'.
                   12453:                                                $containers{$outer});
                   12454:                     next if ($fatal);
                   12455:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   12456:                         if ($context eq 'coursedocs') {
1.1056    raeburn  12457:                             $mapinner{$i} = time;
1.1055    raeburn  12458:                             $folders{$i} = 'default_'.$mapinner{$i};
                   12459:                             $containers{$i} = 'sequence';
                   12460:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   12461:                                       $folders{$i}.'.'.$containers{$i};
                   12462:                             my $newidx = &LONCAPA::map::getresidx();
                   12463:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  12464:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  12465:                             push(@LONCAPA::map::order,$newidx);
                   12466:                             my ($outtext,$errtext) =
                   12467:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   12468:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  12469:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  12470:                             $newseqid{$i} = $newidx;
1.1067    raeburn  12471:                             unless ($errtext) {
                   12472:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   12473:                             }
1.1055    raeburn  12474:                         }
                   12475:                     } else {
                   12476:                         if ($context eq 'coursedocs') {
                   12477:                             my $newidx=&LONCAPA::map::getresidx();
                   12478:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   12479:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   12480:                                       $title;
                   12481:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   12482:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   12483:                             }
                   12484:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   12485:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   12486:                             }
                   12487:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   12488:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  12489:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  12490:                                 unless ($ishome) {
                   12491:                                     my $fetch = "$newdest{$i}/$title";
                   12492:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   12493:                                     $prompttofetch{$fetch} = 1;
                   12494:                                 }
1.1055    raeburn  12495:                             }
                   12496:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  12497:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  12498:                             push(@LONCAPA::map::order, $newidx);
                   12499:                             my ($outtext,$errtext)=
                   12500:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   12501:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  12502:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  12503:                             unless ($errtext) {
                   12504:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   12505:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   12506:                                 }
                   12507:                             }
1.1055    raeburn  12508:                         }
                   12509:                     }
1.1086    raeburn  12510:                 }
                   12511:             } else {
                   12512:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   12513:             }
                   12514:         }
                   12515:         for (my $i=1; $i<=$numitems; $i++) {
                   12516:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   12517:             my $path = $env{'form.archive_content_'.$i};
                   12518:             if ($path =~ /^\Q$pathtocheck\E/) {
                   12519:                 my ($title) = ($path =~ m{/([^/]+)$});
                   12520:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   12521:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   12522:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   12523:                         my ($itemidx,$fullpath,$relpath);
                   12524:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   12525:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  12526:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086    raeburn  12527:                                 if ($dirorder{$i}->[$j] eq $container) {
                   12528:                                     $itemidx = $j;
1.1056    raeburn  12529:                                 }
                   12530:                             }
1.1086    raeburn  12531:                         }
                   12532:                         if ($itemidx eq '') {
                   12533:                             $itemidx =  0;
                   12534:                         } 
                   12535:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   12536:                             if ($mapinner{$referrer{$i}}) {
                   12537:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   12538:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12539:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12540:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12541:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12542:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12543:                                             if (!-e $fullpath) {
                   12544:                                                 mkdir($fullpath,0755);
1.1056    raeburn  12545:                                             }
                   12546:                                         }
1.1086    raeburn  12547:                                     } else {
                   12548:                                         last;
1.1056    raeburn  12549:                                     }
1.1086    raeburn  12550:                                 }
                   12551:                             }
                   12552:                         } elsif ($newdest{$referrer{$i}}) {
                   12553:                             $fullpath = $newdest{$referrer{$i}};
                   12554:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12555:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   12556:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   12557:                                     last;
                   12558:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12559:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12560:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12561:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12562:                                         if (!-e $fullpath) {
                   12563:                                             mkdir($fullpath,0755);
1.1056    raeburn  12564:                                         }
                   12565:                                     }
1.1086    raeburn  12566:                                 } else {
                   12567:                                     last;
1.1056    raeburn  12568:                                 }
1.1055    raeburn  12569:                             }
                   12570:                         }
1.1086    raeburn  12571:                         if ($fullpath ne '') {
                   12572:                             if (-e "$prefix$path") {
                   12573:                                 system("mv $prefix$path $fullpath/$title");
                   12574:                             }
                   12575:                             if (-e "$fullpath/$title") {
                   12576:                                 my $showpath;
                   12577:                                 if ($relpath ne '') {
                   12578:                                     $showpath = "$relpath/$title";
                   12579:                                 } else {
                   12580:                                     $showpath = "/$title";
                   12581:                                 } 
                   12582:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   12583:                             } 
                   12584:                             unless ($ishome) {
                   12585:                                 my $fetch = "$fullpath/$title";
                   12586:                                 $fetch =~ s/^\Q$prefix$dir\E//; 
                   12587:                                 $prompttofetch{$fetch} = 1;
                   12588:                             }
                   12589:                         }
1.1055    raeburn  12590:                     }
1.1086    raeburn  12591:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   12592:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   12593:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  12594:                 }
                   12595:             } else {
                   12596:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   12597:             }
                   12598:         }
                   12599:         if (keys(%todelete)) {
                   12600:             foreach my $key (keys(%todelete)) {
                   12601:                 unlink($key);
1.1066    raeburn  12602:             }
                   12603:         }
                   12604:         if (keys(%todeletedir)) {
                   12605:             foreach my $key (keys(%todeletedir)) {
                   12606:                 rmdir($key);
                   12607:             }
                   12608:         }
                   12609:         foreach my $dir (sort(keys(%is_dir))) {
                   12610:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   12611:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  12612:             }
                   12613:         }
1.1067    raeburn  12614:         if ($result ne '') {
                   12615:             $output .= '<ul>'."\n".
                   12616:                        $result."\n".
                   12617:                        '</ul>';
                   12618:         }
                   12619:         unless ($ishome) {
                   12620:             my $replicationfail;
                   12621:             foreach my $item (keys(%prompttofetch)) {
                   12622:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   12623:                 unless ($fetchresult eq 'ok') {
                   12624:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   12625:                 }
                   12626:             }
                   12627:             if ($replicationfail) {
                   12628:                 $output .= '<p class="LC_error">'.
                   12629:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   12630:                            $replicationfail.
                   12631:                            '</ul></p>';
                   12632:             }
                   12633:         }
1.1055    raeburn  12634:     } else {
                   12635:         $warning = &mt('No items found in archive.');
                   12636:     }
                   12637:     if ($error) {
                   12638:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12639:                    $error.'</p>'."\n";
                   12640:     }
                   12641:     if ($warning) {
                   12642:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12643:     }
                   12644:     return $output;
                   12645: }
                   12646: 
1.1066    raeburn  12647: sub cleanup_empty_dirs {
                   12648:     my ($path) = @_;
                   12649:     if (($path ne '') && (-d $path)) {
                   12650:         if (opendir(my $dirh,$path)) {
                   12651:             my @dircontents = grep(!/^\./,readdir($dirh));
                   12652:             my $numitems = 0;
                   12653:             foreach my $item (@dircontents) {
                   12654:                 if (-d "$path/$item") {
1.1111    raeburn  12655:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  12656:                     if (-e "$path/$item") {
                   12657:                         $numitems ++;
                   12658:                     }
                   12659:                 } else {
                   12660:                     $numitems ++;
                   12661:                 }
                   12662:             }
                   12663:             if ($numitems == 0) {
                   12664:                 rmdir($path);
                   12665:             }
                   12666:             closedir($dirh);
                   12667:         }
                   12668:     }
                   12669:     return;
                   12670: }
                   12671: 
1.41      ng       12672: =pod
1.45      matthew  12673: 
1.1162    raeburn  12674: =item * &get_folder_hierarchy()
1.1068    raeburn  12675: 
                   12676: Provides hierarchy of names of folders/sub-folders containing the current
                   12677: item,
                   12678: 
                   12679: Inputs: 3
                   12680:      - $navmap - navmaps object
                   12681: 
                   12682:      - $map - url for map (either the trigger itself, or map containing
                   12683:                            the resource, which is the trigger).
                   12684: 
                   12685:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   12686: 
                   12687: Outputs: 1 @pathitems - array of folder/subfolder names.
                   12688: 
                   12689: =cut
                   12690: 
                   12691: sub get_folder_hierarchy {
                   12692:     my ($navmap,$map,$showitem) = @_;
                   12693:     my @pathitems;
                   12694:     if (ref($navmap)) {
                   12695:         my $mapres = $navmap->getResourceByUrl($map);
                   12696:         if (ref($mapres)) {
                   12697:             my $pcslist = $mapres->map_hierarchy();
                   12698:             if ($pcslist ne '') {
                   12699:                 my @pcs = split(/,/,$pcslist);
                   12700:                 foreach my $pc (@pcs) {
                   12701:                     if ($pc == 1) {
1.1129    raeburn  12702:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  12703:                     } else {
                   12704:                         my $res = $navmap->getByMapPc($pc);
                   12705:                         if (ref($res)) {
                   12706:                             my $title = $res->compTitle();
                   12707:                             $title =~ s/\W+/_/g;
                   12708:                             if ($title ne '') {
                   12709:                                 push(@pathitems,$title);
                   12710:                             }
                   12711:                         }
                   12712:                     }
                   12713:                 }
                   12714:             }
1.1071    raeburn  12715:             if ($showitem) {
                   12716:                 if ($mapres->{ID} eq '0.0') {
1.1129    raeburn  12717:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  12718:                 } else {
                   12719:                     my $maptitle = $mapres->compTitle();
                   12720:                     $maptitle =~ s/\W+/_/g;
                   12721:                     if ($maptitle ne '') {
                   12722:                         push(@pathitems,$maptitle);
                   12723:                     }
1.1068    raeburn  12724:                 }
                   12725:             }
                   12726:         }
                   12727:     }
                   12728:     return @pathitems;
                   12729: }
                   12730: 
                   12731: =pod
                   12732: 
1.1015    raeburn  12733: =item * &get_turnedin_filepath()
                   12734: 
                   12735: Determines path in a user's portfolio file for storage of files uploaded
                   12736: to a specific essayresponse or dropbox item.
                   12737: 
                   12738: Inputs: 3 required + 1 optional.
                   12739: $symb is symb for resource, $uname and $udom are for current user (required).
                   12740: $caller is optional (can be "submission", if routine is called when storing
                   12741: an upoaded file when "Submit Answer" button was pressed).
                   12742: 
                   12743: Returns array containing $path and $multiresp. 
                   12744: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   12745: than one file upload item.  Callers of routine should append partid as a 
                   12746: subdirectory to $path in cases where $multiresp is 1.
                   12747: 
                   12748: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   12749: 
                   12750: =cut
                   12751: 
                   12752: sub get_turnedin_filepath {
                   12753:     my ($symb,$uname,$udom,$caller) = @_;
                   12754:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   12755:     my $turnindir;
                   12756:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   12757:     $turnindir = $userhash{'turnindir'};
                   12758:     my ($path,$multiresp);
                   12759:     if ($turnindir eq '') {
                   12760:         if ($caller eq 'submission') {
                   12761:             $turnindir = &mt('turned in');
                   12762:             $turnindir =~ s/\W+/_/g;
                   12763:             my %newhash = (
                   12764:                             'turnindir' => $turnindir,
                   12765:                           );
                   12766:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   12767:         }
                   12768:     }
                   12769:     if ($turnindir ne '') {
                   12770:         $path = '/'.$turnindir.'/';
                   12771:         my ($multipart,$turnin,@pathitems);
                   12772:         my $navmap = Apache::lonnavmaps::navmap->new();
                   12773:         if (defined($navmap)) {
                   12774:             my $mapres = $navmap->getResourceByUrl($map);
                   12775:             if (ref($mapres)) {
                   12776:                 my $pcslist = $mapres->map_hierarchy();
                   12777:                 if ($pcslist ne '') {
                   12778:                     foreach my $pc (split(/,/,$pcslist)) {
                   12779:                         my $res = $navmap->getByMapPc($pc);
                   12780:                         if (ref($res)) {
                   12781:                             my $title = $res->compTitle();
                   12782:                             $title =~ s/\W+/_/g;
                   12783:                             if ($title ne '') {
1.1149    raeburn  12784:                                 if (($pc > 1) && (length($title) > 12)) {
                   12785:                                     $title = substr($title,0,12);
                   12786:                                 }
1.1015    raeburn  12787:                                 push(@pathitems,$title);
                   12788:                             }
                   12789:                         }
                   12790:                     }
                   12791:                 }
                   12792:                 my $maptitle = $mapres->compTitle();
                   12793:                 $maptitle =~ s/\W+/_/g;
                   12794:                 if ($maptitle ne '') {
1.1149    raeburn  12795:                     if (length($maptitle) > 12) {
                   12796:                         $maptitle = substr($maptitle,0,12);
                   12797:                     }
1.1015    raeburn  12798:                     push(@pathitems,$maptitle);
                   12799:                 }
                   12800:                 unless ($env{'request.state'} eq 'construct') {
                   12801:                     my $res = $navmap->getBySymb($symb);
                   12802:                     if (ref($res)) {
                   12803:                         my $partlist = $res->parts();
                   12804:                         my $totaluploads = 0;
                   12805:                         if (ref($partlist) eq 'ARRAY') {
                   12806:                             foreach my $part (@{$partlist}) {
                   12807:                                 my @types = $res->responseType($part);
                   12808:                                 my @ids = $res->responseIds($part);
                   12809:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   12810:                                     if ($types[$i] eq 'essay') {
                   12811:                                         my $partid = $part.'_'.$ids[$i];
                   12812:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   12813:                                             $totaluploads ++;
                   12814:                                         }
                   12815:                                     }
                   12816:                                 }
                   12817:                             }
                   12818:                             if ($totaluploads > 1) {
                   12819:                                 $multiresp = 1;
                   12820:                             }
                   12821:                         }
                   12822:                     }
                   12823:                 }
                   12824:             } else {
                   12825:                 return;
                   12826:             }
                   12827:         } else {
                   12828:             return;
                   12829:         }
                   12830:         my $restitle=&Apache::lonnet::gettitle($symb);
                   12831:         $restitle =~ s/\W+/_/g;
                   12832:         if ($restitle eq '') {
                   12833:             $restitle = ($resurl =~ m{/[^/]+$});
                   12834:             if ($restitle eq '') {
                   12835:                 $restitle = time;
                   12836:             }
                   12837:         }
1.1149    raeburn  12838:         if (length($restitle) > 12) {
                   12839:             $restitle = substr($restitle,0,12);
                   12840:         }
1.1015    raeburn  12841:         push(@pathitems,$restitle);
                   12842:         $path .= join('/',@pathitems);
                   12843:     }
                   12844:     return ($path,$multiresp);
                   12845: }
                   12846: 
                   12847: =pod
                   12848: 
1.464     albertel 12849: =back
1.41      ng       12850: 
1.112     bowersj2 12851: =head1 CSV Upload/Handling functions
1.38      albertel 12852: 
1.41      ng       12853: =over 4
                   12854: 
1.648     raeburn  12855: =item * &upfile_store($r)
1.41      ng       12856: 
                   12857: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 12858: needs $env{'form.upfile'}
1.41      ng       12859: returns $datatoken to be put into hidden field
                   12860: 
                   12861: =cut
1.31      albertel 12862: 
                   12863: sub upfile_store {
                   12864:     my $r=shift;
1.258     albertel 12865:     $env{'form.upfile'}=~s/\r/\n/gs;
                   12866:     $env{'form.upfile'}=~s/\f/\n/gs;
                   12867:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   12868:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 12869: 
1.258     albertel 12870:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   12871: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 12872:     {
1.158     raeburn  12873:         my $datafile = $r->dir_config('lonDaemons').
                   12874:                            '/tmp/'.$datatoken.'.tmp';
                   12875:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 12876:             print $fh $env{'form.upfile'};
1.158     raeburn  12877:             close($fh);
                   12878:         }
1.31      albertel 12879:     }
                   12880:     return $datatoken;
                   12881: }
                   12882: 
1.56      matthew  12883: =pod
                   12884: 
1.648     raeburn  12885: =item * &load_tmp_file($r)
1.41      ng       12886: 
                   12887: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 12888: needs $env{'form.datatoken'},
                   12889: sets $env{'form.upfile'} to the contents of the file
1.41      ng       12890: 
                   12891: =cut
1.31      albertel 12892: 
                   12893: sub load_tmp_file {
                   12894:     my $r=shift;
                   12895:     my @studentdata=();
                   12896:     {
1.158     raeburn  12897:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 12898:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  12899:         if ( open(my $fh,"<$studentfile") ) {
                   12900:             @studentdata=<$fh>;
                   12901:             close($fh);
                   12902:         }
1.31      albertel 12903:     }
1.258     albertel 12904:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 12905: }
                   12906: 
1.56      matthew  12907: =pod
                   12908: 
1.648     raeburn  12909: =item * &upfile_record_sep()
1.41      ng       12910: 
                   12911: Separate uploaded file into records
                   12912: returns array of records,
1.258     albertel 12913: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       12914: 
                   12915: =cut
1.31      albertel 12916: 
                   12917: sub upfile_record_sep {
1.258     albertel 12918:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 12919:     } else {
1.248     albertel 12920: 	my @records;
1.258     albertel 12921: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 12922: 	    if ($line=~/^\s*$/) { next; }
                   12923: 	    push(@records,$line);
                   12924: 	}
                   12925: 	return @records;
1.31      albertel 12926:     }
                   12927: }
                   12928: 
1.56      matthew  12929: =pod
                   12930: 
1.648     raeburn  12931: =item * &record_sep($record)
1.41      ng       12932: 
1.258     albertel 12933: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       12934: 
                   12935: =cut
                   12936: 
1.263     www      12937: sub takeleft {
                   12938:     my $index=shift;
                   12939:     return substr('0000'.$index,-4,4);
                   12940: }
                   12941: 
1.31      albertel 12942: sub record_sep {
                   12943:     my $record=shift;
                   12944:     my %components=();
1.258     albertel 12945:     if ($env{'form.upfiletype'} eq 'xml') {
                   12946:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 12947:         my $i=0;
1.356     albertel 12948:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 12949:             $field=~s/^(\"|\')//;
                   12950:             $field=~s/(\"|\')$//;
1.263     www      12951:             $components{&takeleft($i)}=$field;
1.31      albertel 12952:             $i++;
                   12953:         }
1.258     albertel 12954:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 12955:         my $i=0;
1.356     albertel 12956:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 12957:             $field=~s/^(\"|\')//;
                   12958:             $field=~s/(\"|\')$//;
1.263     www      12959:             $components{&takeleft($i)}=$field;
1.31      albertel 12960:             $i++;
                   12961:         }
                   12962:     } else {
1.561     www      12963:         my $separator=',';
1.480     banghart 12964:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      12965:             $separator=';';
1.480     banghart 12966:         }
1.31      albertel 12967:         my $i=0;
1.561     www      12968: # the character we are looking for to indicate the end of a quote or a record 
                   12969:         my $looking_for=$separator;
                   12970: # do not add the characters to the fields
                   12971:         my $ignore=0;
                   12972: # we just encountered a separator (or the beginning of the record)
                   12973:         my $just_found_separator=1;
                   12974: # store the field we are working on here
                   12975:         my $field='';
                   12976: # work our way through all characters in record
                   12977:         foreach my $character ($record=~/(.)/g) {
                   12978:             if ($character eq $looking_for) {
                   12979:                if ($character ne $separator) {
                   12980: # Found the end of a quote, again looking for separator
                   12981:                   $looking_for=$separator;
                   12982:                   $ignore=1;
                   12983:                } else {
                   12984: # Found a separator, store away what we got
                   12985:                   $components{&takeleft($i)}=$field;
                   12986: 	          $i++;
                   12987:                   $just_found_separator=1;
                   12988:                   $ignore=0;
                   12989:                   $field='';
                   12990:                }
                   12991:                next;
                   12992:             }
                   12993: # single or double quotation marks after a separator indicate beginning of a quote
                   12994: # we are now looking for the end of the quote and need to ignore separators
                   12995:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   12996:                $looking_for=$character;
                   12997:                next;
                   12998:             }
                   12999: # ignore would be true after we reached the end of a quote
                   13000:             if ($ignore) { next; }
                   13001:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   13002:             $field.=$character;
                   13003:             $just_found_separator=0; 
1.31      albertel 13004:         }
1.561     www      13005: # catch the very last entry, since we never encountered the separator
                   13006:         $components{&takeleft($i)}=$field;
1.31      albertel 13007:     }
                   13008:     return %components;
                   13009: }
                   13010: 
1.144     matthew  13011: ######################################################
                   13012: ######################################################
                   13013: 
1.56      matthew  13014: =pod
                   13015: 
1.648     raeburn  13016: =item * &upfile_select_html()
1.41      ng       13017: 
1.144     matthew  13018: Return HTML code to select a file from the users machine and specify 
                   13019: the file type.
1.41      ng       13020: 
                   13021: =cut
                   13022: 
1.144     matthew  13023: ######################################################
                   13024: ######################################################
1.31      albertel 13025: sub upfile_select_html {
1.144     matthew  13026:     my %Types = (
                   13027:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 13028:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  13029:                  space => &mt('Space separated'),
                   13030:                  tab   => &mt('Tabulator separated'),
                   13031: #                 xml   => &mt('HTML/XML'),
                   13032:                  );
                   13033:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  13034:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  13035:     foreach my $type (sort(keys(%Types))) {
                   13036:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   13037:     }
                   13038:     $Str .= "</select>\n";
                   13039:     return $Str;
1.31      albertel 13040: }
                   13041: 
1.301     albertel 13042: sub get_samples {
                   13043:     my ($records,$toget) = @_;
                   13044:     my @samples=({});
                   13045:     my $got=0;
                   13046:     foreach my $rec (@$records) {
                   13047: 	my %temp = &record_sep($rec);
                   13048: 	if (! grep(/\S/, values(%temp))) { next; }
                   13049: 	if (%temp) {
                   13050: 	    $samples[$got]=\%temp;
                   13051: 	    $got++;
                   13052: 	    if ($got == $toget) { last; }
                   13053: 	}
                   13054:     }
                   13055:     return \@samples;
                   13056: }
                   13057: 
1.144     matthew  13058: ######################################################
                   13059: ######################################################
                   13060: 
1.56      matthew  13061: =pod
                   13062: 
1.648     raeburn  13063: =item * &csv_print_samples($r,$records)
1.41      ng       13064: 
                   13065: Prints a table of sample values from each column uploaded $r is an
                   13066: Apache Request ref, $records is an arrayref from
                   13067: &Apache::loncommon::upfile_record_sep
                   13068: 
                   13069: =cut
                   13070: 
1.144     matthew  13071: ######################################################
                   13072: ######################################################
1.31      albertel 13073: sub csv_print_samples {
                   13074:     my ($r,$records) = @_;
1.662     bisitz   13075:     my $samples = &get_samples($records,5);
1.301     albertel 13076: 
1.594     raeburn  13077:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   13078:               &start_data_table_header_row());
1.356     albertel 13079:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   13080:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  13081:     $r->print(&end_data_table_header_row());
1.301     albertel 13082:     foreach my $hash (@$samples) {
1.594     raeburn  13083: 	$r->print(&start_data_table_row());
1.356     albertel 13084: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 13085: 	    $r->print('<td>');
1.356     albertel 13086: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 13087: 	    $r->print('</td>');
                   13088: 	}
1.594     raeburn  13089: 	$r->print(&end_data_table_row());
1.31      albertel 13090:     }
1.594     raeburn  13091:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 13092: }
                   13093: 
1.144     matthew  13094: ######################################################
                   13095: ######################################################
                   13096: 
1.56      matthew  13097: =pod
                   13098: 
1.648     raeburn  13099: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       13100: 
                   13101: Prints a table to create associations between values and table columns.
1.144     matthew  13102: 
1.41      ng       13103: $r is an Apache Request ref,
                   13104: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  13105: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       13106: 
                   13107: =cut
                   13108: 
1.144     matthew  13109: ######################################################
                   13110: ######################################################
1.31      albertel 13111: sub csv_print_select_table {
                   13112:     my ($r,$records,$d) = @_;
1.301     albertel 13113:     my $i=0;
                   13114:     my $samples = &get_samples($records,1);
1.144     matthew  13115:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  13116: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  13117:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  13118:               '<th>'.&mt('Column').'</th>'.
                   13119:               &end_data_table_header_row()."\n");
1.356     albertel 13120:     foreach my $array_ref (@$d) {
                   13121: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  13122: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 13123: 
1.875     bisitz   13124: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  13125: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 13126: 	$r->print('<option value="none"></option>');
1.356     albertel 13127: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   13128: 	    $r->print('<option value="'.$sample.'"'.
                   13129:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   13130:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 13131: 	}
1.594     raeburn  13132: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 13133: 	$i++;
                   13134:     }
1.594     raeburn  13135:     $r->print(&end_data_table());
1.31      albertel 13136:     $i--;
                   13137:     return $i;
                   13138: }
1.56      matthew  13139: 
1.144     matthew  13140: ######################################################
                   13141: ######################################################
                   13142: 
1.56      matthew  13143: =pod
1.31      albertel 13144: 
1.648     raeburn  13145: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       13146: 
                   13147: Prints a table of sample values from the upload and can make associate samples to internal names.
                   13148: 
                   13149: $r is an Apache Request ref,
                   13150: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   13151: $d is an array of 2 element arrays (internal name, displayed name)
                   13152: 
                   13153: =cut
                   13154: 
1.144     matthew  13155: ######################################################
                   13156: ######################################################
1.31      albertel 13157: sub csv_samples_select_table {
                   13158:     my ($r,$records,$d) = @_;
                   13159:     my $i=0;
1.144     matthew  13160:     #
1.662     bisitz   13161:     my $max_samples = 5;
                   13162:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  13163:     $r->print(&start_data_table().
                   13164:               &start_data_table_header_row().'<th>'.
                   13165:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   13166:               &end_data_table_header_row());
1.301     albertel 13167: 
                   13168:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  13169: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  13170: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 13171: 	foreach my $option (@$d) {
                   13172: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  13173: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 13174:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  13175:                       $display.'</option>');
1.31      albertel 13176: 	}
                   13177: 	$r->print('</select></td><td>');
1.662     bisitz   13178: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 13179: 	    if (defined($samples->[$line]{$key})) { 
                   13180: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   13181: 	    }
                   13182: 	}
1.594     raeburn  13183: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 13184: 	$i++;
                   13185:     }
1.594     raeburn  13186:     $r->print(&end_data_table());
1.31      albertel 13187:     $i--;
                   13188:     return($i);
1.115     matthew  13189: }
                   13190: 
1.144     matthew  13191: ######################################################
                   13192: ######################################################
                   13193: 
1.115     matthew  13194: =pod
                   13195: 
1.648     raeburn  13196: =item * &clean_excel_name($name)
1.115     matthew  13197: 
                   13198: Returns a replacement for $name which does not contain any illegal characters.
                   13199: 
                   13200: =cut
                   13201: 
1.144     matthew  13202: ######################################################
                   13203: ######################################################
1.115     matthew  13204: sub clean_excel_name {
                   13205:     my ($name) = @_;
                   13206:     $name =~ s/[:\*\?\/\\]//g;
                   13207:     if (length($name) > 31) {
                   13208:         $name = substr($name,0,31);
                   13209:     }
                   13210:     return $name;
1.25      albertel 13211: }
1.84      albertel 13212: 
1.85      albertel 13213: =pod
                   13214: 
1.648     raeburn  13215: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 13216: 
                   13217: Returns either 1 or undef
                   13218: 
                   13219: 1 if the part is to be hidden, undef if it is to be shown
                   13220: 
                   13221: Arguments are:
                   13222: 
                   13223: $id the id of the part to be checked
                   13224: $symb, optional the symb of the resource to check
                   13225: $udom, optional the domain of the user to check for
                   13226: $uname, optional the username of the user to check for
                   13227: 
                   13228: =cut
1.84      albertel 13229: 
                   13230: sub check_if_partid_hidden {
                   13231:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 13232:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 13233: 					 $symb,$udom,$uname);
1.141     albertel 13234:     my $truth=1;
                   13235:     #if the string starts with !, then the list is the list to show not hide
                   13236:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 13237:     my @hiddenlist=split(/,/,$hiddenparts);
                   13238:     foreach my $checkid (@hiddenlist) {
1.141     albertel 13239: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 13240:     }
1.141     albertel 13241:     return !$truth;
1.84      albertel 13242: }
1.127     matthew  13243: 
1.138     matthew  13244: 
                   13245: ############################################################
                   13246: ############################################################
                   13247: 
                   13248: =pod
                   13249: 
1.157     matthew  13250: =back 
                   13251: 
1.138     matthew  13252: =head1 cgi-bin script and graphing routines
                   13253: 
1.157     matthew  13254: =over 4
                   13255: 
1.648     raeburn  13256: =item * &get_cgi_id()
1.138     matthew  13257: 
                   13258: Inputs: none
                   13259: 
                   13260: Returns an id which can be used to pass environment variables
                   13261: to various cgi-bin scripts.  These environment variables will
                   13262: be removed from the users environment after a given time by
                   13263: the routine &Apache::lonnet::transfer_profile_to_env.
                   13264: 
                   13265: =cut
                   13266: 
                   13267: ############################################################
                   13268: ############################################################
1.152     albertel 13269: my $uniq=0;
1.136     matthew  13270: sub get_cgi_id {
1.154     albertel 13271:     $uniq=($uniq+1)%100000;
1.280     albertel 13272:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  13273: }
                   13274: 
1.127     matthew  13275: ############################################################
                   13276: ############################################################
                   13277: 
                   13278: =pod
                   13279: 
1.648     raeburn  13280: =item * &DrawBarGraph()
1.127     matthew  13281: 
1.138     matthew  13282: Facilitates the plotting of data in a (stacked) bar graph.
                   13283: Puts plot definition data into the users environment in order for 
                   13284: graph.png to plot it.  Returns an <img> tag for the plot.
                   13285: The bars on the plot are labeled '1','2',...,'n'.
                   13286: 
                   13287: Inputs:
                   13288: 
                   13289: =over 4
                   13290: 
                   13291: =item $Title: string, the title of the plot
                   13292: 
                   13293: =item $xlabel: string, text describing the X-axis of the plot
                   13294: 
                   13295: =item $ylabel: string, text describing the Y-axis of the plot
                   13296: 
                   13297: =item $Max: scalar, the maximum Y value to use in the plot
                   13298: If $Max is < any data point, the graph will not be rendered.
                   13299: 
1.140     matthew  13300: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  13301: they are plotted.  If undefined, default values will be used.
                   13302: 
1.178     matthew  13303: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   13304: 
1.138     matthew  13305: =item @Values: An array of array references.  Each array reference holds data
                   13306: to be plotted in a stacked bar chart.
                   13307: 
1.239     matthew  13308: =item If the final element of @Values is a hash reference the key/value
                   13309: pairs will be added to the graph definition.
                   13310: 
1.138     matthew  13311: =back
                   13312: 
                   13313: Returns:
                   13314: 
                   13315: An <img> tag which references graph.png and the appropriate identifying
                   13316: information for the plot.
                   13317: 
1.127     matthew  13318: =cut
                   13319: 
                   13320: ############################################################
                   13321: ############################################################
1.134     matthew  13322: sub DrawBarGraph {
1.178     matthew  13323:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  13324:     #
                   13325:     if (! defined($colors)) {
                   13326:         $colors = ['#33ff00', 
                   13327:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   13328:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   13329:                   ]; 
                   13330:     }
1.228     matthew  13331:     my $extra_settings = {};
                   13332:     if (ref($Values[-1]) eq 'HASH') {
                   13333:         $extra_settings = pop(@Values);
                   13334:     }
1.127     matthew  13335:     #
1.136     matthew  13336:     my $identifier = &get_cgi_id();
                   13337:     my $id = 'cgi.'.$identifier;        
1.129     matthew  13338:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  13339:         return '';
                   13340:     }
1.225     matthew  13341:     #
                   13342:     my @Labels;
                   13343:     if (defined($labels)) {
                   13344:         @Labels = @$labels;
                   13345:     } else {
                   13346:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   13347:             push (@Labels,$i+1);
                   13348:         }
                   13349:     }
                   13350:     #
1.129     matthew  13351:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  13352:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  13353:     my %ValuesHash;
                   13354:     my $NumSets=1;
                   13355:     foreach my $array (@Values) {
                   13356:         next if (! ref($array));
1.136     matthew  13357:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  13358:             join(',',@$array);
1.129     matthew  13359:     }
1.127     matthew  13360:     #
1.136     matthew  13361:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  13362:     if ($NumBars < 3) {
                   13363:         $width = 120+$NumBars*32;
1.220     matthew  13364:         $xskip = 1;
1.225     matthew  13365:         $bar_width = 30;
                   13366:     } elsif ($NumBars < 5) {
                   13367:         $width = 120+$NumBars*20;
                   13368:         $xskip = 1;
                   13369:         $bar_width = 20;
1.220     matthew  13370:     } elsif ($NumBars < 10) {
1.136     matthew  13371:         $width = 120+$NumBars*15;
                   13372:         $xskip = 1;
                   13373:         $bar_width = 15;
                   13374:     } elsif ($NumBars <= 25) {
                   13375:         $width = 120+$NumBars*11;
                   13376:         $xskip = 5;
                   13377:         $bar_width = 8;
                   13378:     } elsif ($NumBars <= 50) {
                   13379:         $width = 120+$NumBars*8;
                   13380:         $xskip = 5;
                   13381:         $bar_width = 4;
                   13382:     } else {
                   13383:         $width = 120+$NumBars*8;
                   13384:         $xskip = 5;
                   13385:         $bar_width = 4;
                   13386:     }
                   13387:     #
1.137     matthew  13388:     $Max = 1 if ($Max < 1);
                   13389:     if ( int($Max) < $Max ) {
                   13390:         $Max++;
                   13391:         $Max = int($Max);
                   13392:     }
1.127     matthew  13393:     $Title  = '' if (! defined($Title));
                   13394:     $xlabel = '' if (! defined($xlabel));
                   13395:     $ylabel = '' if (! defined($ylabel));
1.369     www      13396:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   13397:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   13398:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  13399:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  13400:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   13401:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   13402:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   13403:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13404:     $ValuesHash{$id.'.height'}   = $height;
                   13405:     $ValuesHash{$id.'.width'}    = $width;
                   13406:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   13407:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   13408:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  13409:     #
1.228     matthew  13410:     # Deal with other parameters
                   13411:     while (my ($key,$value) = each(%$extra_settings)) {
                   13412:         $ValuesHash{$id.'.'.$key} = $value;
                   13413:     }
                   13414:     #
1.646     raeburn  13415:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  13416:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   13417: }
                   13418: 
                   13419: ############################################################
                   13420: ############################################################
                   13421: 
                   13422: =pod
                   13423: 
1.648     raeburn  13424: =item * &DrawXYGraph()
1.137     matthew  13425: 
1.138     matthew  13426: Facilitates the plotting of data in an XY graph.
                   13427: Puts plot definition data into the users environment in order for 
                   13428: graph.png to plot it.  Returns an <img> tag for the plot.
                   13429: 
                   13430: Inputs:
                   13431: 
                   13432: =over 4
                   13433: 
                   13434: =item $Title: string, the title of the plot
                   13435: 
                   13436: =item $xlabel: string, text describing the X-axis of the plot
                   13437: 
                   13438: =item $ylabel: string, text describing the Y-axis of the plot
                   13439: 
                   13440: =item $Max: scalar, the maximum Y value to use in the plot
                   13441: If $Max is < any data point, the graph will not be rendered.
                   13442: 
                   13443: =item $colors: Array ref containing the hex color codes for the data to be 
                   13444: plotted in.  If undefined, default values will be used.
                   13445: 
                   13446: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13447: 
                   13448: =item $Ydata: Array ref containing Array refs.  
1.185     www      13449: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  13450: 
                   13451: =item %Values: hash indicating or overriding any default values which are 
                   13452: passed to graph.png.  
                   13453: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13454: 
                   13455: =back
                   13456: 
                   13457: Returns:
                   13458: 
                   13459: An <img> tag which references graph.png and the appropriate identifying
                   13460: information for the plot.
                   13461: 
1.137     matthew  13462: =cut
                   13463: 
                   13464: ############################################################
                   13465: ############################################################
                   13466: sub DrawXYGraph {
                   13467:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   13468:     #
                   13469:     # Create the identifier for the graph
                   13470:     my $identifier = &get_cgi_id();
                   13471:     my $id = 'cgi.'.$identifier;
                   13472:     #
                   13473:     $Title  = '' if (! defined($Title));
                   13474:     $xlabel = '' if (! defined($xlabel));
                   13475:     $ylabel = '' if (! defined($ylabel));
                   13476:     my %ValuesHash = 
                   13477:         (
1.369     www      13478:          $id.'.title'  => &escape($Title),
                   13479:          $id.'.xlabel' => &escape($xlabel),
                   13480:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  13481:          $id.'.y_max_value'=> $Max,
                   13482:          $id.'.labels'     => join(',',@$Xlabels),
                   13483:          $id.'.PlotType'   => 'XY',
                   13484:          );
                   13485:     #
                   13486:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13487:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13488:     }
                   13489:     #
                   13490:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   13491:         return '';
                   13492:     }
                   13493:     my $NumSets=1;
1.138     matthew  13494:     foreach my $array (@{$Ydata}){
1.137     matthew  13495:         next if (! ref($array));
                   13496:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   13497:     }
1.138     matthew  13498:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  13499:     #
                   13500:     # Deal with other parameters
                   13501:     while (my ($key,$value) = each(%Values)) {
                   13502:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  13503:     }
                   13504:     #
1.646     raeburn  13505:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  13506:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   13507: }
                   13508: 
                   13509: ############################################################
                   13510: ############################################################
                   13511: 
                   13512: =pod
                   13513: 
1.648     raeburn  13514: =item * &DrawXYYGraph()
1.138     matthew  13515: 
                   13516: Facilitates the plotting of data in an XY graph with two Y axes.
                   13517: Puts plot definition data into the users environment in order for 
                   13518: graph.png to plot it.  Returns an <img> tag for the plot.
                   13519: 
                   13520: Inputs:
                   13521: 
                   13522: =over 4
                   13523: 
                   13524: =item $Title: string, the title of the plot
                   13525: 
                   13526: =item $xlabel: string, text describing the X-axis of the plot
                   13527: 
                   13528: =item $ylabel: string, text describing the Y-axis of the plot
                   13529: 
                   13530: =item $colors: Array ref containing the hex color codes for the data to be 
                   13531: plotted in.  If undefined, default values will be used.
                   13532: 
                   13533: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13534: 
                   13535: =item $Ydata1: The first data set
                   13536: 
                   13537: =item $Min1: The minimum value of the left Y-axis
                   13538: 
                   13539: =item $Max1: The maximum value of the left Y-axis
                   13540: 
                   13541: =item $Ydata2: The second data set
                   13542: 
                   13543: =item $Min2: The minimum value of the right Y-axis
                   13544: 
                   13545: =item $Max2: The maximum value of the left Y-axis
                   13546: 
                   13547: =item %Values: hash indicating or overriding any default values which are 
                   13548: passed to graph.png.  
                   13549: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13550: 
                   13551: =back
                   13552: 
                   13553: Returns:
                   13554: 
                   13555: An <img> tag which references graph.png and the appropriate identifying
                   13556: information for the plot.
1.136     matthew  13557: 
                   13558: =cut
                   13559: 
                   13560: ############################################################
                   13561: ############################################################
1.137     matthew  13562: sub DrawXYYGraph {
                   13563:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   13564:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  13565:     #
                   13566:     # Create the identifier for the graph
                   13567:     my $identifier = &get_cgi_id();
                   13568:     my $id = 'cgi.'.$identifier;
                   13569:     #
                   13570:     $Title  = '' if (! defined($Title));
                   13571:     $xlabel = '' if (! defined($xlabel));
                   13572:     $ylabel = '' if (! defined($ylabel));
                   13573:     my %ValuesHash = 
                   13574:         (
1.369     www      13575:          $id.'.title'  => &escape($Title),
                   13576:          $id.'.xlabel' => &escape($xlabel),
                   13577:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  13578:          $id.'.labels' => join(',',@$Xlabels),
                   13579:          $id.'.PlotType' => 'XY',
                   13580:          $id.'.NumSets' => 2,
1.137     matthew  13581:          $id.'.two_axes' => 1,
                   13582:          $id.'.y1_max_value' => $Max1,
                   13583:          $id.'.y1_min_value' => $Min1,
                   13584:          $id.'.y2_max_value' => $Max2,
                   13585:          $id.'.y2_min_value' => $Min2,
1.136     matthew  13586:          );
                   13587:     #
1.137     matthew  13588:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13589:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13590:     }
                   13591:     #
                   13592:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   13593:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  13594:         return '';
                   13595:     }
                   13596:     my $NumSets=1;
1.137     matthew  13597:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  13598:         next if (! ref($array));
                   13599:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  13600:     }
                   13601:     #
                   13602:     # Deal with other parameters
                   13603:     while (my ($key,$value) = each(%Values)) {
                   13604:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  13605:     }
                   13606:     #
1.646     raeburn  13607:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 13608:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  13609: }
                   13610: 
                   13611: ############################################################
                   13612: ############################################################
                   13613: 
                   13614: =pod
                   13615: 
1.157     matthew  13616: =back 
                   13617: 
1.139     matthew  13618: =head1 Statistics helper routines?  
                   13619: 
                   13620: Bad place for them but what the hell.
                   13621: 
1.157     matthew  13622: =over 4
                   13623: 
1.648     raeburn  13624: =item * &chartlink()
1.139     matthew  13625: 
                   13626: Returns a link to the chart for a specific student.  
                   13627: 
                   13628: Inputs:
                   13629: 
                   13630: =over 4
                   13631: 
                   13632: =item $linktext: The text of the link
                   13633: 
                   13634: =item $sname: The students username
                   13635: 
                   13636: =item $sdomain: The students domain
                   13637: 
                   13638: =back
                   13639: 
1.157     matthew  13640: =back
                   13641: 
1.139     matthew  13642: =cut
                   13643: 
                   13644: ############################################################
                   13645: ############################################################
                   13646: sub chartlink {
                   13647:     my ($linktext, $sname, $sdomain) = @_;
                   13648:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      13649:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 13650:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  13651:        '">'.$linktext.'</a>';
1.153     matthew  13652: }
                   13653: 
                   13654: #######################################################
                   13655: #######################################################
                   13656: 
                   13657: =pod
                   13658: 
                   13659: =head1 Course Environment Routines
1.157     matthew  13660: 
                   13661: =over 4
1.153     matthew  13662: 
1.648     raeburn  13663: =item * &restore_course_settings()
1.153     matthew  13664: 
1.648     raeburn  13665: =item * &store_course_settings()
1.153     matthew  13666: 
                   13667: Restores/Store indicated form parameters from the course environment.
                   13668: Will not overwrite existing values of the form parameters.
                   13669: 
                   13670: Inputs: 
                   13671: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   13672: 
                   13673: a hash ref describing the data to be stored.  For example:
                   13674:    
                   13675: %Save_Parameters = ('Status' => 'scalar',
                   13676:     'chartoutputmode' => 'scalar',
                   13677:     'chartoutputdata' => 'scalar',
                   13678:     'Section' => 'array',
1.373     raeburn  13679:     'Group' => 'array',
1.153     matthew  13680:     'StudentData' => 'array',
                   13681:     'Maps' => 'array');
                   13682: 
                   13683: Returns: both routines return nothing
                   13684: 
1.631     raeburn  13685: =back
                   13686: 
1.153     matthew  13687: =cut
                   13688: 
                   13689: #######################################################
                   13690: #######################################################
                   13691: sub store_course_settings {
1.496     albertel 13692:     return &store_settings($env{'request.course.id'},@_);
                   13693: }
                   13694: 
                   13695: sub store_settings {
1.153     matthew  13696:     # save to the environment
                   13697:     # appenv the same items, just to be safe
1.300     albertel 13698:     my $udom  = $env{'user.domain'};
                   13699:     my $uname = $env{'user.name'};
1.496     albertel 13700:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13701:     my %SaveHash;
                   13702:     my %AppHash;
                   13703:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 13704:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 13705:         my $envname = 'environment.'.$basename;
1.258     albertel 13706:         if (exists($env{'form.'.$setting})) {
1.153     matthew  13707:             # Save this value away
                   13708:             if ($type eq 'scalar' &&
1.258     albertel 13709:                 (! exists($env{$envname}) || 
                   13710:                  $env{$envname} ne $env{'form.'.$setting})) {
                   13711:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   13712:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  13713:             } elsif ($type eq 'array') {
                   13714:                 my $stored_form;
1.258     albertel 13715:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  13716:                     $stored_form = join(',',
                   13717:                                         map {
1.369     www      13718:                                             &escape($_);
1.258     albertel 13719:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  13720:                 } else {
                   13721:                     $stored_form = 
1.369     www      13722:                         &escape($env{'form.'.$setting});
1.153     matthew  13723:                 }
                   13724:                 # Determine if the array contents are the same.
1.258     albertel 13725:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  13726:                     $SaveHash{$basename} = $stored_form;
                   13727:                     $AppHash{$envname}   = $stored_form;
                   13728:                 }
                   13729:             }
                   13730:         }
                   13731:     }
                   13732:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 13733:                                           $udom,$uname);
1.153     matthew  13734:     if ($put_result !~ /^(ok|delayed)/) {
                   13735:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   13736:                                  'got error:'.$put_result);
                   13737:     }
                   13738:     # Make sure these settings stick around in this session, too
1.646     raeburn  13739:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  13740:     return;
                   13741: }
                   13742: 
                   13743: sub restore_course_settings {
1.499     albertel 13744:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 13745: }
                   13746: 
                   13747: sub restore_settings {
                   13748:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13749:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 13750:         next if (exists($env{'form.'.$setting}));
1.496     albertel 13751:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  13752:             '.'.$setting;
1.258     albertel 13753:         if (exists($env{$envname})) {
1.153     matthew  13754:             if ($type eq 'scalar') {
1.258     albertel 13755:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  13756:             } elsif ($type eq 'array') {
1.258     albertel 13757:                 $env{'form.'.$setting} = [ 
1.153     matthew  13758:                                            map { 
1.369     www      13759:                                                &unescape($_); 
1.258     albertel 13760:                                            } split(',',$env{$envname})
1.153     matthew  13761:                                            ];
                   13762:             }
                   13763:         }
                   13764:     }
1.127     matthew  13765: }
                   13766: 
1.618     raeburn  13767: #######################################################
                   13768: #######################################################
                   13769: 
                   13770: =pod
                   13771: 
                   13772: =head1 Domain E-mail Routines  
                   13773: 
                   13774: =over 4
                   13775: 
1.648     raeburn  13776: =item * &build_recipient_list()
1.618     raeburn  13777: 
1.1144    raeburn  13778: Build recipient lists for following types of e-mail:
1.766     raeburn  13779: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144    raeburn  13780: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   13781: module change checking, student/employee ID conflict checks, as
                   13782: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   13783: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  13784: 
                   13785: Inputs:
1.619     raeburn  13786: defmail (scalar - email address of default recipient), 
1.1144    raeburn  13787: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   13788: requestsmail, updatesmail, or idconflictsmail).
                   13789: 
1.619     raeburn  13790: defdom (domain for which to retrieve configuration settings),
1.1144    raeburn  13791: 
1.619     raeburn  13792: origmail (scalar - email address of recipient from loncapa.conf, 
                   13793: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  13794: 
1.655     raeburn  13795: Returns: comma separated list of addresses to which to send e-mail.
                   13796: 
                   13797: =back
1.618     raeburn  13798: 
                   13799: =cut
                   13800: 
                   13801: ############################################################
                   13802: ############################################################
                   13803: sub build_recipient_list {
1.619     raeburn  13804:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  13805:     my @recipients;
                   13806:     my $otheremails;
                   13807:     my %domconfig =
                   13808:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   13809:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  13810:         if (exists($domconfig{'contacts'}{$mailing})) {
                   13811:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   13812:                 my @contacts = ('adminemail','supportemail');
                   13813:                 foreach my $item (@contacts) {
                   13814:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   13815:                         my $addr = $domconfig{'contacts'}{$item}; 
                   13816:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13817:                             push(@recipients,$addr);
                   13818:                         }
1.619     raeburn  13819:                     }
1.766     raeburn  13820:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  13821:                 }
                   13822:             }
1.766     raeburn  13823:         } elsif ($origmail ne '') {
                   13824:             push(@recipients,$origmail);
1.618     raeburn  13825:         }
1.619     raeburn  13826:     } elsif ($origmail ne '') {
                   13827:         push(@recipients,$origmail);
1.618     raeburn  13828:     }
1.688     raeburn  13829:     if (defined($defmail)) {
                   13830:         if ($defmail ne '') {
                   13831:             push(@recipients,$defmail);
                   13832:         }
1.618     raeburn  13833:     }
                   13834:     if ($otheremails) {
1.619     raeburn  13835:         my @others;
                   13836:         if ($otheremails =~ /,/) {
                   13837:             @others = split(/,/,$otheremails);
1.618     raeburn  13838:         } else {
1.619     raeburn  13839:             push(@others,$otheremails);
                   13840:         }
                   13841:         foreach my $addr (@others) {
                   13842:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13843:                 push(@recipients,$addr);
                   13844:             }
1.618     raeburn  13845:         }
                   13846:     }
1.619     raeburn  13847:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  13848:     return $recipientlist;
                   13849: }
                   13850: 
1.127     matthew  13851: ############################################################
                   13852: ############################################################
1.154     albertel 13853: 
1.655     raeburn  13854: =pod
                   13855: 
1.1224    musolffc 13856: =over 4
                   13857: 
1.1223    musolffc 13858: =item * &mime_email()
                   13859: 
                   13860: Sends an email with a possible attachment
                   13861: 
                   13862: Inputs:
                   13863: 
                   13864: =over 4
                   13865: 
                   13866: from -              Sender's email address
                   13867: 
                   13868: to -                Email address of recipient
                   13869: 
                   13870: subject -           Subject of email
                   13871: 
                   13872: body -              Body of email
                   13873: 
                   13874: cc_string -         Carbon copy email address
                   13875: 
                   13876: bcc -               Blind carbon copy email address
                   13877: 
                   13878: type -              File type of attachment
                   13879: 
                   13880: attachment_path -   Path of file to be attached
                   13881: 
                   13882: file_name -         Name of file to be attached
                   13883: 
                   13884: attachment_text -   The body of an attachment of type "TEXT"
                   13885: 
                   13886: =back
                   13887: 
                   13888: =back
                   13889: 
                   13890: =cut
                   13891: 
                   13892: ############################################################
                   13893: ############################################################
                   13894: 
                   13895: sub mime_email {
                   13896:     my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path, 
                   13897:         $file_name, $attachment_text) = @_;
                   13898:     my $msg = MIME::Lite->new(
                   13899:              From    => $from,
                   13900:              To      => $to,
                   13901:              Subject => $subject,
                   13902:              Type    =>'TEXT',
                   13903:              Data    => $body,
                   13904:              );
                   13905:     if ($cc_string ne '') {
                   13906:         $msg->add("Cc" => $cc_string);
                   13907:     }
                   13908:     if ($bcc ne '') {
                   13909:         $msg->add("Bcc" => $bcc);
                   13910:     }
                   13911:     $msg->attr("content-type"         => "text/plain");
                   13912:     $msg->attr("content-type.charset" => "UTF-8");
                   13913:     # Attach file if given
                   13914:     if ($attachment_path) {
                   13915:         unless ($file_name) {
                   13916:             if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
                   13917:         }
                   13918:         my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
                   13919:         $msg->attach(Type     => $type,
                   13920:                      Path     => $attachment_path,
                   13921:                      Filename => $file_name
                   13922:                      );
                   13923:     # Otherwise attach text if given
                   13924:     } elsif ($attachment_text) {
                   13925:         $msg->attach(Type => 'TEXT',
                   13926:                      Data => $attachment_text);
                   13927:     }
                   13928:     # Send it
                   13929:     $msg->send('sendmail');
                   13930: }
                   13931: 
                   13932: ############################################################
                   13933: ############################################################
                   13934: 
                   13935: =pod
                   13936: 
1.655     raeburn  13937: =head1 Course Catalog Routines
                   13938: 
                   13939: =over 4
                   13940: 
                   13941: =item * &gather_categories()
                   13942: 
                   13943: Converts category definitions - keys of categories hash stored in  
                   13944: coursecategories in configuration.db on the primary library server in a 
                   13945: domain - to an array.  Also generates javascript and idx hash used to 
                   13946: generate Domain Coordinator interface for editing Course Categories.
                   13947: 
                   13948: Inputs:
1.663     raeburn  13949: 
1.655     raeburn  13950: categories (reference to hash of category definitions).
1.663     raeburn  13951: 
1.655     raeburn  13952: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13953:       categories and subcategories).
1.663     raeburn  13954: 
1.655     raeburn  13955: idx (reference to hash of counters used in Domain Coordinator interface for 
                   13956:       editing Course Categories).
1.663     raeburn  13957: 
1.655     raeburn  13958: jsarray (reference to array of categories used to create Javascript arrays for
                   13959:          Domain Coordinator interface for editing Course Categories).
                   13960: 
                   13961: Returns: nothing
                   13962: 
                   13963: Side effects: populates cats, idx and jsarray. 
                   13964: 
                   13965: =cut
                   13966: 
                   13967: sub gather_categories {
                   13968:     my ($categories,$cats,$idx,$jsarray) = @_;
                   13969:     my %counters;
                   13970:     my $num = 0;
                   13971:     foreach my $item (keys(%{$categories})) {
                   13972:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   13973:         if ($container eq '' && $depth == 0) {
                   13974:             $cats->[$depth][$categories->{$item}] = $cat;
                   13975:         } else {
                   13976:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   13977:         }
                   13978:         my ($escitem,$tail) = split(/:/,$item,2);
                   13979:         if ($counters{$tail} eq '') {
                   13980:             $counters{$tail} = $num;
                   13981:             $num ++;
                   13982:         }
                   13983:         if (ref($idx) eq 'HASH') {
                   13984:             $idx->{$item} = $counters{$tail};
                   13985:         }
                   13986:         if (ref($jsarray) eq 'ARRAY') {
                   13987:             push(@{$jsarray->[$counters{$tail}]},$item);
                   13988:         }
                   13989:     }
                   13990:     return;
                   13991: }
                   13992: 
                   13993: =pod
                   13994: 
                   13995: =item * &extract_categories()
                   13996: 
                   13997: Used to generate breadcrumb trails for course categories.
                   13998: 
                   13999: Inputs:
1.663     raeburn  14000: 
1.655     raeburn  14001: categories (reference to hash of category definitions).
1.663     raeburn  14002: 
1.655     raeburn  14003: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14004:       categories and subcategories).
1.663     raeburn  14005: 
1.655     raeburn  14006: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  14007: 
1.655     raeburn  14008: allitems (reference to hash - key is category key 
                   14009:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  14010: 
1.655     raeburn  14011: idx (reference to hash of counters used in Domain Coordinator interface for
                   14012:       editing Course Categories).
1.663     raeburn  14013: 
1.655     raeburn  14014: jsarray (reference to array of categories used to create Javascript arrays for
                   14015:          Domain Coordinator interface for editing Course Categories).
                   14016: 
1.665     raeburn  14017: subcats (reference to hash of arrays containing all subcategories within each 
                   14018:          category, -recursive)
                   14019: 
1.655     raeburn  14020: Returns: nothing
                   14021: 
                   14022: Side effects: populates trails and allitems hash references.
                   14023: 
                   14024: =cut
                   14025: 
                   14026: sub extract_categories {
1.665     raeburn  14027:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  14028:     if (ref($categories) eq 'HASH') {
                   14029:         &gather_categories($categories,$cats,$idx,$jsarray);
                   14030:         if (ref($cats->[0]) eq 'ARRAY') {
                   14031:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   14032:                 my $name = $cats->[0][$i];
                   14033:                 my $item = &escape($name).'::0';
                   14034:                 my $trailstr;
                   14035:                 if ($name eq 'instcode') {
                   14036:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  14037:                 } elsif ($name eq 'communities') {
                   14038:                     $trailstr = &mt('Communities');
1.655     raeburn  14039:                 } else {
                   14040:                     $trailstr = $name;
                   14041:                 }
                   14042:                 if ($allitems->{$item} eq '') {
                   14043:                     push(@{$trails},$trailstr);
                   14044:                     $allitems->{$item} = scalar(@{$trails})-1;
                   14045:                 }
                   14046:                 my @parents = ($name);
                   14047:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   14048:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   14049:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  14050:                         if (ref($subcats) eq 'HASH') {
                   14051:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   14052:                         }
                   14053:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   14054:                     }
                   14055:                 } else {
                   14056:                     if (ref($subcats) eq 'HASH') {
                   14057:                         $subcats->{$item} = [];
1.655     raeburn  14058:                     }
                   14059:                 }
                   14060:             }
                   14061:         }
                   14062:     }
                   14063:     return;
                   14064: }
                   14065: 
                   14066: =pod
                   14067: 
1.1162    raeburn  14068: =item * &recurse_categories()
1.655     raeburn  14069: 
                   14070: Recursively used to generate breadcrumb trails for course categories.
                   14071: 
                   14072: Inputs:
1.663     raeburn  14073: 
1.655     raeburn  14074: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14075:       categories and subcategories).
1.663     raeburn  14076: 
1.655     raeburn  14077: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  14078: 
                   14079: category (current course category, for which breadcrumb trail is being generated).
                   14080: 
                   14081: trails (reference to array of breadcrumb trails for each category).
                   14082: 
1.655     raeburn  14083: allitems (reference to hash - key is category key
                   14084:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  14085: 
1.655     raeburn  14086: parents (array containing containers directories for current category, 
                   14087:          back to top level). 
                   14088: 
                   14089: Returns: nothing
                   14090: 
                   14091: Side effects: populates trails and allitems hash references
                   14092: 
                   14093: =cut
                   14094: 
                   14095: sub recurse_categories {
1.665     raeburn  14096:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  14097:     my $shallower = $depth - 1;
                   14098:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   14099:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   14100:             my $name = $cats->[$depth]{$category}[$k];
                   14101:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   14102:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   14103:             if ($allitems->{$item} eq '') {
                   14104:                 push(@{$trails},$trailstr);
                   14105:                 $allitems->{$item} = scalar(@{$trails})-1;
                   14106:             }
                   14107:             my $deeper = $depth+1;
                   14108:             push(@{$parents},$category);
1.665     raeburn  14109:             if (ref($subcats) eq 'HASH') {
                   14110:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   14111:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   14112:                     my $higher;
                   14113:                     if ($j > 0) {
                   14114:                         $higher = &escape($parents->[$j]).':'.
                   14115:                                   &escape($parents->[$j-1]).':'.$j;
                   14116:                     } else {
                   14117:                         $higher = &escape($parents->[$j]).'::'.$j;
                   14118:                     }
                   14119:                     push(@{$subcats->{$higher}},$subcat);
                   14120:                 }
                   14121:             }
                   14122:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   14123:                                 $subcats);
1.655     raeburn  14124:             pop(@{$parents});
                   14125:         }
                   14126:     } else {
                   14127:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   14128:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   14129:         if ($allitems->{$item} eq '') {
                   14130:             push(@{$trails},$trailstr);
                   14131:             $allitems->{$item} = scalar(@{$trails})-1;
                   14132:         }
                   14133:     }
                   14134:     return;
                   14135: }
                   14136: 
1.663     raeburn  14137: =pod
                   14138: 
1.1162    raeburn  14139: =item * &assign_categories_table()
1.663     raeburn  14140: 
                   14141: Create a datatable for display of hierarchical categories in a domain,
                   14142: with checkboxes to allow a course to be categorized. 
                   14143: 
                   14144: Inputs:
                   14145: 
                   14146: cathash - reference to hash of categories defined for the domain (from
                   14147:           configuration.db)
                   14148: 
                   14149: currcat - scalar with an & separated list of categories assigned to a course. 
                   14150: 
1.919     raeburn  14151: type    - scalar contains course type (Course or Community).
                   14152: 
1.663     raeburn  14153: Returns: $output (markup to be displayed) 
                   14154: 
                   14155: =cut
                   14156: 
                   14157: sub assign_categories_table {
1.919     raeburn  14158:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  14159:     my $output;
                   14160:     if (ref($cathash) eq 'HASH') {
                   14161:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   14162:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   14163:         $maxdepth = scalar(@cats);
                   14164:         if (@cats > 0) {
                   14165:             my $itemcount = 0;
                   14166:             if (ref($cats[0]) eq 'ARRAY') {
                   14167:                 my @currcategories;
                   14168:                 if ($currcat ne '') {
                   14169:                     @currcategories = split('&',$currcat);
                   14170:                 }
1.919     raeburn  14171:                 my $table;
1.663     raeburn  14172:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   14173:                     my $parent = $cats[0][$i];
1.919     raeburn  14174:                     next if ($parent eq 'instcode');
                   14175:                     if ($type eq 'Community') {
                   14176:                         next unless ($parent eq 'communities');
                   14177:                     } else {
                   14178:                         next if ($parent eq 'communities');
                   14179:                     }
1.663     raeburn  14180:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   14181:                     my $item = &escape($parent).'::0';
                   14182:                     my $checked = '';
                   14183:                     if (@currcategories > 0) {
                   14184:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   14185:                             $checked = ' checked="checked"';
1.663     raeburn  14186:                         }
                   14187:                     }
1.919     raeburn  14188:                     my $parent_title = $parent;
                   14189:                     if ($parent eq 'communities') {
                   14190:                         $parent_title = &mt('Communities');
                   14191:                     }
                   14192:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   14193:                               '<input type="checkbox" name="usecategory" value="'.
                   14194:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   14195:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  14196:                     my $depth = 1;
                   14197:                     push(@path,$parent);
1.919     raeburn  14198:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  14199:                     pop(@path);
1.919     raeburn  14200:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  14201:                     $itemcount ++;
                   14202:                 }
1.919     raeburn  14203:                 if ($itemcount) {
                   14204:                     $output = &Apache::loncommon::start_data_table().
                   14205:                               $table.
                   14206:                               &Apache::loncommon::end_data_table();
                   14207:                 }
1.663     raeburn  14208:             }
                   14209:         }
                   14210:     }
                   14211:     return $output;
                   14212: }
                   14213: 
                   14214: =pod
                   14215: 
1.1162    raeburn  14216: =item * &assign_category_rows()
1.663     raeburn  14217: 
                   14218: Create a datatable row for display of nested categories in a domain,
                   14219: with checkboxes to allow a course to be categorized,called recursively.
                   14220: 
                   14221: Inputs:
                   14222: 
                   14223: itemcount - track row number for alternating colors
                   14224: 
                   14225: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   14226:       categories and subcategories.
                   14227: 
                   14228: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   14229: 
                   14230: parent - parent of current category item
                   14231: 
                   14232: path - Array containing all categories back up through the hierarchy from the
                   14233:        current category to the top level.
                   14234: 
                   14235: currcategories - reference to array of current categories assigned to the course
                   14236: 
                   14237: Returns: $output (markup to be displayed).
                   14238: 
                   14239: =cut
                   14240: 
                   14241: sub assign_category_rows {
                   14242:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   14243:     my ($text,$name,$item,$chgstr);
                   14244:     if (ref($cats) eq 'ARRAY') {
                   14245:         my $maxdepth = scalar(@{$cats});
                   14246:         if (ref($cats->[$depth]) eq 'HASH') {
                   14247:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   14248:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   14249:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145    raeburn  14250:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  14251:                 for (my $j=0; $j<$numchildren; $j++) {
                   14252:                     $name = $cats->[$depth]{$parent}[$j];
                   14253:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   14254:                     my $deeper = $depth+1;
                   14255:                     my $checked = '';
                   14256:                     if (ref($currcategories) eq 'ARRAY') {
                   14257:                         if (@{$currcategories} > 0) {
                   14258:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   14259:                                 $checked = ' checked="checked"';
1.663     raeburn  14260:                             }
                   14261:                         }
                   14262:                     }
1.664     raeburn  14263:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   14264:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  14265:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   14266:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   14267:                              '</td><td>';
1.663     raeburn  14268:                     if (ref($path) eq 'ARRAY') {
                   14269:                         push(@{$path},$name);
                   14270:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   14271:                         pop(@{$path});
                   14272:                     }
                   14273:                     $text .= '</td></tr>';
                   14274:                 }
                   14275:                 $text .= '</table></td>';
                   14276:             }
                   14277:         }
                   14278:     }
                   14279:     return $text;
                   14280: }
                   14281: 
1.1181    raeburn  14282: =pod
                   14283: 
                   14284: =back
                   14285: 
                   14286: =cut
                   14287: 
1.655     raeburn  14288: ############################################################
                   14289: ############################################################
                   14290: 
                   14291: 
1.443     albertel 14292: sub commit_customrole {
1.664     raeburn  14293:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  14294:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 14295:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   14296:                          ($end?', ending '.localtime($end):'').': <b>'.
                   14297:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  14298:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 14299:                  '</b><br />';
                   14300:     return $output;
                   14301: }
                   14302: 
                   14303: sub commit_standardrole {
1.1116    raeburn  14304:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  14305:     my ($output,$logmsg,$linefeed);
                   14306:     if ($context eq 'auto') {
                   14307:         $linefeed = "\n";
                   14308:     } else {
                   14309:         $linefeed = "<br />\n";
                   14310:     }  
1.443     albertel 14311:     if ($three eq 'st') {
1.541     raeburn  14312:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116    raeburn  14313:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  14314:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  14315:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   14316:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 14317:         } else {
1.541     raeburn  14318:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 14319:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  14320:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   14321:             if ($context eq 'auto') {
                   14322:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   14323:             } else {
                   14324:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   14325:                &mt('Add to classlist').': <b>ok</b>';
                   14326:             }
                   14327:             $output .= $linefeed;
1.443     albertel 14328:         }
                   14329:     } else {
                   14330:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   14331:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  14332:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  14333:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  14334:         if ($context eq 'auto') {
                   14335:             $output .= $result.$linefeed;
                   14336:         } else {
                   14337:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   14338:         }
1.443     albertel 14339:     }
                   14340:     return $output;
                   14341: }
                   14342: 
                   14343: sub commit_studentrole {
1.1116    raeburn  14344:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   14345:         $credits) = @_;
1.626     raeburn  14346:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  14347:     if ($context eq 'auto') {
                   14348:         $linefeed = "\n";
                   14349:     } else {
                   14350:         $linefeed = '<br />'."\n";
                   14351:     }
1.443     albertel 14352:     if (defined($one) && defined($two)) {
                   14353:         my $cid=$one.'_'.$two;
                   14354:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   14355:         my $secchange = 0;
                   14356:         my $expire_role_result;
                   14357:         my $modify_section_result;
1.628     raeburn  14358:         if ($oldsec ne '-1') { 
                   14359:             if ($oldsec ne $sec) {
1.443     albertel 14360:                 $secchange = 1;
1.628     raeburn  14361:                 my $now = time;
1.443     albertel 14362:                 my $uurl='/'.$cid;
                   14363:                 $uurl=~s/\_/\//g;
                   14364:                 if ($oldsec) {
                   14365:                     $uurl.='/'.$oldsec;
                   14366:                 }
1.626     raeburn  14367:                 $oldsecurl = $uurl;
1.628     raeburn  14368:                 $expire_role_result = 
1.652     raeburn  14369:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  14370:                 if ($env{'request.course.sec'} ne '') { 
                   14371:                     if ($expire_role_result eq 'refused') {
                   14372:                         my @roles = ('st');
                   14373:                         my @statuses = ('previous');
                   14374:                         my @roledoms = ($one);
                   14375:                         my $withsec = 1;
                   14376:                         my %roleshash = 
                   14377:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   14378:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   14379:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   14380:                             my ($oldstart,$oldend) = 
                   14381:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   14382:                             if ($oldend > 0 && $oldend <= $now) {
                   14383:                                 $expire_role_result = 'ok';
                   14384:                             }
                   14385:                         }
                   14386:                     }
                   14387:                 }
1.443     albertel 14388:                 $result = $expire_role_result;
                   14389:             }
                   14390:         }
                   14391:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116    raeburn  14392:             $modify_section_result = 
                   14393:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   14394:                                                            undef,undef,undef,$sec,
                   14395:                                                            $end,$start,'','',$cid,
                   14396:                                                            '',$context,$credits);
1.443     albertel 14397:             if ($modify_section_result =~ /^ok/) {
                   14398:                 if ($secchange == 1) {
1.628     raeburn  14399:                     if ($sec eq '') {
                   14400:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   14401:                     } else {
                   14402:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   14403:                     }
1.443     albertel 14404:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  14405:                     if ($sec eq '') {
                   14406:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   14407:                     } else {
                   14408:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   14409:                     }
1.443     albertel 14410:                 } else {
1.628     raeburn  14411:                     if ($sec eq '') {
                   14412:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   14413:                     } else {
                   14414:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   14415:                     }
1.443     albertel 14416:                 }
                   14417:             } else {
1.1115    raeburn  14418:                 if ($secchange) { 
1.628     raeburn  14419:                     $$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;
                   14420:                 } else {
                   14421:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   14422:                 }
1.443     albertel 14423:             }
                   14424:             $result = $modify_section_result;
                   14425:         } elsif ($secchange == 1) {
1.628     raeburn  14426:             if ($oldsec eq '') {
1.1103    raeburn  14427:                 $$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  14428:             } else {
                   14429:                 $$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;
                   14430:             }
1.626     raeburn  14431:             if ($expire_role_result eq 'refused') {
                   14432:                 my $newsecurl = '/'.$cid;
                   14433:                 $newsecurl =~ s/\_/\//g;
                   14434:                 if ($sec ne '') {
                   14435:                     $newsecurl.='/'.$sec;
                   14436:                 }
                   14437:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   14438:                     if ($sec eq '') {
                   14439:                         $$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;
                   14440:                     } else {
                   14441:                         $$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;
                   14442:                     }
                   14443:                 }
                   14444:             }
1.443     albertel 14445:         }
                   14446:     } else {
1.626     raeburn  14447:         $$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 14448:         $result = "error: incomplete course id\n";
                   14449:     }
                   14450:     return $result;
                   14451: }
                   14452: 
1.1108    raeburn  14453: sub show_role_extent {
                   14454:     my ($scope,$context,$role) = @_;
                   14455:     $scope =~ s{^/}{};
                   14456:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   14457:     push(@courseroles,'co');
                   14458:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   14459:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   14460:         $scope =~ s{/}{_};
                   14461:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   14462:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   14463:         my ($audom,$auname) = split(/\//,$scope);
                   14464:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   14465:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   14466:     } else {
                   14467:         $scope =~ s{/$}{};
                   14468:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   14469:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   14470:     }
                   14471: }
                   14472: 
1.443     albertel 14473: ############################################################
                   14474: ############################################################
                   14475: 
1.566     albertel 14476: sub check_clone {
1.578     raeburn  14477:     my ($args,$linefeed) = @_;
1.566     albertel 14478:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   14479:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   14480:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   14481:     my $clonemsg;
                   14482:     my $can_clone = 0;
1.944     raeburn  14483:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  14484:     if ($lctype ne 'community') {
                   14485:         $lctype = 'course';
                   14486:     }
1.566     albertel 14487:     if ($clonehome eq 'no_host') {
1.944     raeburn  14488:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  14489:             $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'});
                   14490:         } else {
                   14491:             $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'});
                   14492:         }     
1.566     albertel 14493:     } else {
                   14494: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  14495:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  14496:             if ($clonedesc{'type'} ne 'Community') {
                   14497:                  $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'});
                   14498:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   14499:             }
                   14500:         }
1.882     raeburn  14501: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   14502:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 14503: 	    $can_clone = 1;
                   14504: 	} else {
1.1221    raeburn  14505: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566     albertel 14506: 						 $args->{'clonedomain'},$args->{'clonecourse'});
1.1221    raeburn  14507:             if ($clonehash{'cloners'} eq '') {
                   14508:                 my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
                   14509:                 if ($domdefs{'canclone'}) {
                   14510:                     unless ($domdefs{'canclone'} eq 'none') {
                   14511:                         if ($domdefs{'canclone'} eq 'domain') {
                   14512:                             if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
                   14513:                                 $can_clone = 1;
                   14514:                             }
                   14515:                         } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
                   14516:                                  ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                   14517:                             if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
                   14518:                                                                           $clonehash{'internal.coursecode'},$args->{'crscode'})) {
                   14519:                                 $can_clone = 1;
                   14520:                             }
                   14521:                         }
                   14522:                     }
                   14523:                 }
1.578     raeburn  14524:             } else {
1.1221    raeburn  14525: 	        my @cloners = split(/,/,$clonehash{'cloners'});
                   14526:                 if (grep(/^\*$/,@cloners)) {
1.942     raeburn  14527:                     $can_clone = 1;
1.1221    raeburn  14528:                 } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942     raeburn  14529:                     $can_clone = 1;
1.1225  ! raeburn  14530:                 } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
        !          14531:                     $can_clone = 1;
1.1221    raeburn  14532:                 }
                   14533:                 unless ($can_clone) {
1.1225  ! raeburn  14534:                     if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
        !          14535:                         ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
1.1221    raeburn  14536:                         my (%gotdomdefaults,%gotcodedefaults);
                   14537:                         foreach my $cloner (@cloners) {
                   14538:                             if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
                   14539:                                 ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
                   14540:                                 my (%codedefaults,@code_order);
                   14541:                                 if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
                   14542:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
                   14543:                                         %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
                   14544:                                     }
                   14545:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
                   14546:                                         @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
                   14547:                                     }
                   14548:                                 } else {
                   14549:                                     &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
                   14550:                                                                             \%codedefaults,
                   14551:                                                                             \@code_order);
                   14552:                                     $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
                   14553:                                     $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
                   14554:                                 }
                   14555:                                 if (@code_order > 0) {
                   14556:                                     if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
                   14557:                                                                                 $cloner,$clonehash{'internal.coursecode'},
                   14558:                                                                                 $args->{'crscode'})) {
                   14559:                                         $can_clone = 1;
                   14560:                                         last;
                   14561:                                     }
                   14562:                                 }
                   14563:                             }
                   14564:                         }
                   14565:                     }
1.1225  ! raeburn  14566:                 }
        !          14567:             }
        !          14568:             unless ($can_clone) {
        !          14569:                 my $ccrole = 'cc';
        !          14570:                 if ($args->{'crstype'} eq 'Community') {
        !          14571:                     $ccrole = 'co';
        !          14572:                 }
        !          14573: 	        my %roleshash =
        !          14574: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
        !          14575: 					          $args->{'ccdomain'},
        !          14576:                                                   'userroles',['active'],[$ccrole],
        !          14577: 					          [$args->{'clonedomain'}]);
        !          14578: 	        if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
        !          14579:                     $can_clone = 1;
        !          14580:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
        !          14581:                                                           $args->{'ccuname'},$args->{'ccdomain'})) {
        !          14582:                     $can_clone = 1;
1.1221    raeburn  14583:                 }
                   14584:             }
                   14585:             unless ($can_clone) {
                   14586:                 if ($args->{'crstype'} eq 'Community') {
                   14587:                     $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'});
1.942     raeburn  14588:                 } else {
1.1221    raeburn  14589:                     $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'});
                   14590:                 }
1.566     albertel 14591: 	    }
1.578     raeburn  14592:         }
1.566     albertel 14593:     }
                   14594:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   14595: }
                   14596: 
1.444     albertel 14597: sub construct_course {
1.1166    raeburn  14598:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444     albertel 14599:     my $outcome;
1.541     raeburn  14600:     my $linefeed =  '<br />'."\n";
                   14601:     if ($context eq 'auto') {
                   14602:         $linefeed = "\n";
                   14603:     }
1.566     albertel 14604: 
                   14605: #
                   14606: # Are we cloning?
                   14607: #
                   14608:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   14609:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  14610: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 14611: 	if ($context ne 'auto') {
1.578     raeburn  14612:             if ($clonemsg ne '') {
                   14613: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   14614:             }
1.566     albertel 14615: 	}
                   14616: 	$outcome .= $clonemsg.$linefeed;
                   14617: 
                   14618:         if (!$can_clone) {
                   14619: 	    return (0,$outcome);
                   14620: 	}
                   14621:     }
                   14622: 
1.444     albertel 14623: #
                   14624: # Open course
                   14625: #
                   14626:     my $crstype = lc($args->{'crstype'});
                   14627:     my %cenv=();
                   14628:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   14629:                                              $args->{'cdescr'},
                   14630:                                              $args->{'curl'},
                   14631:                                              $args->{'course_home'},
                   14632:                                              $args->{'nonstandard'},
                   14633:                                              $args->{'crscode'},
                   14634:                                              $args->{'ccuname'}.':'.
                   14635:                                              $args->{'ccdomain'},
1.882     raeburn  14636:                                              $args->{'crstype'},
1.885     raeburn  14637:                                              $cnum,$context,$category);
1.444     albertel 14638: 
                   14639:     # Note: The testing routines depend on this being output; see 
                   14640:     # Utils::Course. This needs to at least be output as a comment
                   14641:     # if anyone ever decides to not show this, and Utils::Course::new
                   14642:     # will need to be suitably modified.
1.541     raeburn  14643:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  14644:     if ($$courseid =~ /^error:/) {
                   14645:         return (0,$outcome);
                   14646:     }
                   14647: 
1.444     albertel 14648: #
                   14649: # Check if created correctly
                   14650: #
1.479     albertel 14651:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 14652:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  14653:     if ($crsuhome eq 'no_host') {
                   14654:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   14655:         return (0,$outcome);
                   14656:     }
1.541     raeburn  14657:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 14658: 
1.444     albertel 14659: #
1.566     albertel 14660: # Do the cloning
                   14661: #   
                   14662:     if ($can_clone && $cloneid) {
                   14663: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   14664: 	if ($context ne 'auto') {
                   14665: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   14666: 	}
                   14667: 	$outcome .= $clonemsg.$linefeed;
                   14668: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 14669: # Copy all files
1.637     www      14670: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 14671: # Restore URL
1.566     albertel 14672: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 14673: # Restore title
1.566     albertel 14674: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  14675: # Restore creation date, creator and creation context.
                   14676:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   14677:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   14678:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 14679: # Mark as cloned
1.566     albertel 14680: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      14681: # Need to clone grading mode
                   14682:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   14683:         $cenv{'grading'}=$newenv{'grading'};
                   14684: # Do not clone these environment entries
                   14685:         &Apache::lonnet::del('environment',
                   14686:                   ['default_enrollment_start_date',
                   14687:                    'default_enrollment_end_date',
                   14688:                    'question.email',
                   14689:                    'policy.email',
                   14690:                    'comment.email',
                   14691:                    'pch.users.denied',
1.725     raeburn  14692:                    'plc.users.denied',
                   14693:                    'hidefromcat',
1.1121    raeburn  14694:                    'checkforpriv',
1.1166    raeburn  14695:                    'categories',
                   14696:                    'internal.uniquecode'],
1.638     www      14697:                    $$crsudom,$$crsunum);
1.1170    raeburn  14698:         if ($args->{'textbook'}) {
                   14699:             $cenv{'internal.textbook'} = $args->{'textbook'};
                   14700:         }
1.444     albertel 14701:     }
1.566     albertel 14702: 
1.444     albertel 14703: #
                   14704: # Set environment (will override cloned, if existing)
                   14705: #
                   14706:     my @sections = ();
                   14707:     my @xlists = ();
                   14708:     if ($args->{'crstype'}) {
                   14709:         $cenv{'type'}=$args->{'crstype'};
                   14710:     }
                   14711:     if ($args->{'crsid'}) {
                   14712:         $cenv{'courseid'}=$args->{'crsid'};
                   14713:     }
                   14714:     if ($args->{'crscode'}) {
                   14715:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   14716:     }
                   14717:     if ($args->{'crsquota'} ne '') {
                   14718:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   14719:     } else {
                   14720:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   14721:     }
                   14722:     if ($args->{'ccuname'}) {
                   14723:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   14724:                                         ':'.$args->{'ccdomain'};
                   14725:     } else {
                   14726:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   14727:     }
1.1116    raeburn  14728:     if ($args->{'defaultcredits'}) {
                   14729:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   14730:     }
1.444     albertel 14731:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   14732:     if ($args->{'crssections'}) {
                   14733:         $cenv{'internal.sectionnums'} = '';
                   14734:         if ($args->{'crssections'} =~ m/,/) {
                   14735:             @sections = split/,/,$args->{'crssections'};
                   14736:         } else {
                   14737:             $sections[0] = $args->{'crssections'};
                   14738:         }
                   14739:         if (@sections > 0) {
                   14740:             foreach my $item (@sections) {
                   14741:                 my ($sec,$gp) = split/:/,$item;
                   14742:                 my $class = $args->{'crscode'}.$sec;
                   14743:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   14744:                 $cenv{'internal.sectionnums'} .= $item.',';
                   14745:                 unless ($addcheck eq 'ok') {
                   14746:                     push @badclasses, $class;
                   14747:                 }
                   14748:             }
                   14749:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   14750:         }
                   14751:     }
                   14752: # do not hide course coordinator from staff listing, 
                   14753: # even if privileged
                   14754:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121    raeburn  14755: # add course coordinator's domain to domains to check for privileged users
                   14756: # if different to course domain
                   14757:     if ($$crsudom ne $args->{'ccdomain'}) {
                   14758:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   14759:     }
1.444     albertel 14760: # add crosslistings
                   14761:     if ($args->{'crsxlist'}) {
                   14762:         $cenv{'internal.crosslistings'}='';
                   14763:         if ($args->{'crsxlist'} =~ m/,/) {
                   14764:             @xlists = split/,/,$args->{'crsxlist'};
                   14765:         } else {
                   14766:             $xlists[0] = $args->{'crsxlist'};
                   14767:         }
                   14768:         if (@xlists > 0) {
                   14769:             foreach my $item (@xlists) {
                   14770:                 my ($xl,$gp) = split/:/,$item;
                   14771:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   14772:                 $cenv{'internal.crosslistings'} .= $item.',';
                   14773:                 unless ($addcheck eq 'ok') {
                   14774:                     push @badclasses, $xl;
                   14775:                 }
                   14776:             }
                   14777:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   14778:         }
                   14779:     }
                   14780:     if ($args->{'autoadds'}) {
                   14781:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   14782:     }
                   14783:     if ($args->{'autodrops'}) {
                   14784:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   14785:     }
                   14786: # check for notification of enrollment changes
                   14787:     my @notified = ();
                   14788:     if ($args->{'notify_owner'}) {
                   14789:         if ($args->{'ccuname'} ne '') {
                   14790:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   14791:         }
                   14792:     }
                   14793:     if ($args->{'notify_dc'}) {
                   14794:         if ($uname ne '') { 
1.630     raeburn  14795:             push(@notified,$uname.':'.$udom);
1.444     albertel 14796:         }
                   14797:     }
                   14798:     if (@notified > 0) {
                   14799:         my $notifylist;
                   14800:         if (@notified > 1) {
                   14801:             $notifylist = join(',',@notified);
                   14802:         } else {
                   14803:             $notifylist = $notified[0];
                   14804:         }
                   14805:         $cenv{'internal.notifylist'} = $notifylist;
                   14806:     }
                   14807:     if (@badclasses > 0) {
                   14808:         my %lt=&Apache::lonlocal::texthash(
                   14809:                 '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',
                   14810:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   14811:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   14812:         );
1.541     raeburn  14813:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   14814:                            ' ('.$lt{'adby'}.')';
                   14815:         if ($context eq 'auto') {
                   14816:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 14817:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  14818:             foreach my $item (@badclasses) {
                   14819:                 if ($context eq 'auto') {
                   14820:                     $outcome .= " - $item\n";
                   14821:                 } else {
                   14822:                     $outcome .= "<li>$item</li>\n";
                   14823:                 }
                   14824:             }
                   14825:             if ($context eq 'auto') {
                   14826:                 $outcome .= $linefeed;
                   14827:             } else {
1.566     albertel 14828:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  14829:             }
                   14830:         } 
1.444     albertel 14831:     }
                   14832:     if ($args->{'no_end_date'}) {
                   14833:         $args->{'endaccess'} = 0;
                   14834:     }
                   14835:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   14836:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   14837:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   14838:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   14839:     if ($args->{'showphotos'}) {
                   14840:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   14841:     }
                   14842:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   14843:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   14844:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   14845:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  14846:             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'); 
                   14847:             if ($context eq 'auto') {
                   14848:                 $outcome .= $krb_msg;
                   14849:             } else {
1.566     albertel 14850:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  14851:             }
                   14852:             $outcome .= $linefeed;
1.444     albertel 14853:         }
                   14854:     }
                   14855:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   14856:        if ($args->{'setpolicy'}) {
                   14857:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14858:        }
                   14859:        if ($args->{'setcontent'}) {
                   14860:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14861:        }
                   14862:     }
                   14863:     if ($args->{'reshome'}) {
                   14864: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   14865: 	$cenv{'reshome'}=~s/\/+$/\//;
                   14866:     }
                   14867: #
                   14868: # course has keyed access
                   14869: #
                   14870:     if ($args->{'setkeys'}) {
                   14871:        $cenv{'keyaccess'}='yes';
                   14872:     }
                   14873: # if specified, key authority is not course, but user
                   14874: # only active if keyaccess is yes
                   14875:     if ($args->{'keyauth'}) {
1.487     albertel 14876: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   14877: 	$user = &LONCAPA::clean_username($user);
                   14878: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     14879: 	if ($user ne '' && $domain ne '') {
1.487     albertel 14880: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 14881: 	}
                   14882:     }
                   14883: 
1.1166    raeburn  14884: #
1.1167    raeburn  14885: #  generate and store uniquecode (available to course requester), if course should have one.
1.1166    raeburn  14886: #
                   14887:     if ($args->{'uniquecode'}) {
                   14888:         my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
                   14889:         if ($code) {
                   14890:             $cenv{'internal.uniquecode'} = $code;
1.1167    raeburn  14891:             my %crsinfo =
                   14892:                 &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
                   14893:             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   14894:                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   14895:                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
                   14896:             } 
1.1166    raeburn  14897:             if (ref($coderef)) {
                   14898:                 $$coderef = $code;
                   14899:             }
                   14900:         }
                   14901:     }
                   14902: 
1.444     albertel 14903:     if ($args->{'disresdis'}) {
                   14904:         $cenv{'pch.roles.denied'}='st';
                   14905:     }
                   14906:     if ($args->{'disablechat'}) {
                   14907:         $cenv{'plc.roles.denied'}='st';
                   14908:     }
                   14909: 
                   14910:     # Record we've not yet viewed the Course Initialization Helper for this 
                   14911:     # course
                   14912:     $cenv{'course.helper.not.run'} = 1;
                   14913:     #
                   14914:     # Use new Randomseed
                   14915:     #
                   14916:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   14917:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   14918:     #
                   14919:     # The encryption code and receipt prefix for this course
                   14920:     #
                   14921:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   14922:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   14923:     #
                   14924:     # By default, use standard grading
                   14925:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   14926: 
1.541     raeburn  14927:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   14928:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14929: #
                   14930: # Open all assignments
                   14931: #
                   14932:     if ($args->{'openall'}) {
                   14933:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   14934:        my %storecontent = ($storeunder         => time,
                   14935:                            $storeunder.'.type' => 'date_start');
                   14936:        
                   14937:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  14938:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14939:    }
                   14940: #
                   14941: # Set first page
                   14942: #
                   14943:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   14944: 	    || ($cloneid)) {
1.445     albertel 14945: 	use LONCAPA::map;
1.444     albertel 14946: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 14947: 
                   14948: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   14949:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   14950: 
1.444     albertel 14951:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   14952:         my $title; my $url;
                   14953:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   14954: 	    $title=&mt('Syllabus');
1.444     albertel 14955:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   14956:         } else {
1.963     raeburn  14957:             $title=&mt('Table of Contents');
1.444     albertel 14958:             $url='/adm/navmaps';
                   14959:         }
1.445     albertel 14960: 
                   14961:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   14962: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   14963: 
                   14964: 	if ($errtext) { $fatal=2; }
1.541     raeburn  14965:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 14966:     }
1.566     albertel 14967: 
                   14968:     return (1,$outcome);
1.444     albertel 14969: }
                   14970: 
1.1166    raeburn  14971: sub make_unique_code {
                   14972:     my ($cdom,$cnum) = @_;
                   14973:     # get lock on uniquecodes db
                   14974:     my $lockhash = {
                   14975:                       $cnum."\0".'uniquecodes' => $env{'user.name'}.
                   14976:                                                   ':'.$env{'user.domain'},
                   14977:                    };
                   14978:     my $tries = 0;
                   14979:     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   14980:     my ($code,$error);
                   14981:   
                   14982:     while (($gotlock ne 'ok') && ($tries<3)) {
                   14983:         $tries ++;
                   14984:         sleep 1;
                   14985:         $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   14986:     }
                   14987:     if ($gotlock eq 'ok') {
                   14988:         my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
                   14989:         my $gotcode;
                   14990:         my $attempts = 0;
                   14991:         while ((!$gotcode) && ($attempts < 100)) {
                   14992:             $code = &generate_code();
                   14993:             if (!exists($currcodes{$code})) {
                   14994:                 $gotcode = 1;
                   14995:                 unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                   14996:                     $error = 'nostore';
                   14997:                 }
                   14998:             }
                   14999:             $attempts ++;
                   15000:         }
                   15001:         my @del_lock = ($cnum."\0".'uniquecodes');
                   15002:         my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
                   15003:     } else {
                   15004:         $error = 'nolock';
                   15005:     }
                   15006:     return ($code,$error);
                   15007: }
                   15008: 
                   15009: sub generate_code {
                   15010:     my $code;
                   15011:     my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
                   15012:     for (my $i=0; $i<6; $i++) {
                   15013:         my $lettnum = int (rand 2);
                   15014:         my $item = '';
                   15015:         if ($lettnum) {
                   15016:             $item = $letts[int( rand(18) )];
                   15017:         } else {
                   15018:             $item = 1+int( rand(8) );
                   15019:         }
                   15020:         $code .= $item;
                   15021:     }
                   15022:     return $code;
                   15023: }
                   15024: 
1.444     albertel 15025: ############################################################
                   15026: ############################################################
                   15027: 
1.953     droeschl 15028: #SD
                   15029: # only Community and Course, or anything else?
1.378     raeburn  15030: sub course_type {
                   15031:     my ($cid) = @_;
                   15032:     if (!defined($cid)) {
                   15033:         $cid = $env{'request.course.id'};
                   15034:     }
1.404     albertel 15035:     if (defined($env{'course.'.$cid.'.type'})) {
                   15036:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  15037:     } else {
                   15038:         return 'Course';
1.377     raeburn  15039:     }
                   15040: }
1.156     albertel 15041: 
1.406     raeburn  15042: sub group_term {
                   15043:     my $crstype = &course_type();
                   15044:     my %names = (
                   15045:                   'Course' => 'group',
1.865     raeburn  15046:                   'Community' => 'group',
1.406     raeburn  15047:                 );
                   15048:     return $names{$crstype};
                   15049: }
                   15050: 
1.902     raeburn  15051: sub course_types {
1.1165    raeburn  15052:     my @types = ('official','unofficial','community','textbook');
1.902     raeburn  15053:     my %typename = (
                   15054:                          official   => 'Official course',
                   15055:                          unofficial => 'Unofficial course',
                   15056:                          community  => 'Community',
1.1165    raeburn  15057:                          textbook   => 'Textbook course',
1.902     raeburn  15058:                    );
                   15059:     return (\@types,\%typename);
                   15060: }
                   15061: 
1.156     albertel 15062: sub icon {
                   15063:     my ($file)=@_;
1.505     albertel 15064:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 15065:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 15066:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 15067:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   15068: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   15069: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   15070: 	            $curfext.".gif") {
                   15071: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   15072: 		$curfext.".gif";
                   15073: 	}
                   15074:     }
1.249     albertel 15075:     return &lonhttpdurl($iconname);
1.154     albertel 15076: } 
1.84      albertel 15077: 
1.575     albertel 15078: sub lonhttpdurl {
1.692     www      15079: #
                   15080: # Had been used for "small fry" static images on separate port 8080.
                   15081: # Modify here if lightweight http functionality desired again.
                   15082: # Currently eliminated due to increasing firewall issues.
                   15083: #
1.575     albertel 15084:     my ($url)=@_;
1.692     www      15085:     return $url;
1.215     albertel 15086: }
                   15087: 
1.213     albertel 15088: sub connection_aborted {
                   15089:     my ($r)=@_;
                   15090:     $r->print(" ");$r->rflush();
                   15091:     my $c = $r->connection;
                   15092:     return $c->aborted();
                   15093: }
                   15094: 
1.221     foxr     15095: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     15096: #    strings as 'strings'.
                   15097: sub escape_single {
1.221     foxr     15098:     my ($input) = @_;
1.223     albertel 15099:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     15100:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   15101:     return $input;
                   15102: }
1.223     albertel 15103: 
1.222     foxr     15104: #  Same as escape_single, but escape's "'s  This 
                   15105: #  can be used for  "strings"
                   15106: sub escape_double {
                   15107:     my ($input) = @_;
                   15108:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   15109:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   15110:     return $input;
                   15111: }
1.223     albertel 15112:  
1.222     foxr     15113: #   Escapes the last element of a full URL.
                   15114: sub escape_url {
                   15115:     my ($url)   = @_;
1.238     raeburn  15116:     my @urlslices = split(/\//, $url,-1);
1.369     www      15117:     my $lastitem = &escape(pop(@urlslices));
1.1203    raeburn  15118:     return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222     foxr     15119: }
1.462     albertel 15120: 
1.820     raeburn  15121: sub compare_arrays {
                   15122:     my ($arrayref1,$arrayref2) = @_;
                   15123:     my (@difference,%count);
                   15124:     @difference = ();
                   15125:     %count = ();
                   15126:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   15127:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   15128:         foreach my $element (keys(%count)) {
                   15129:             if ($count{$element} == 1) {
                   15130:                 push(@difference,$element);
                   15131:             }
                   15132:         }
                   15133:     }
                   15134:     return @difference;
                   15135: }
                   15136: 
1.817     bisitz   15137: # -------------------------------------------------------- Initialize user login
1.462     albertel 15138: sub init_user_environment {
1.463     albertel 15139:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 15140:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   15141: 
                   15142:     my $public=($username eq 'public' && $domain eq 'public');
                   15143: 
                   15144: # See if old ID present, if so, remove
                   15145: 
1.1062    raeburn  15146:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 15147:     my $now=time;
                   15148: 
                   15149:     if ($public) {
                   15150: 	my $max_public=100;
                   15151: 	my $oldest;
                   15152: 	my $oldest_time=0;
                   15153: 	for(my $next=1;$next<=$max_public;$next++) {
                   15154: 	    if (-e $lonids."/publicuser_$next.id") {
                   15155: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   15156: 		if ($mtime<$oldest_time || !$oldest_time) {
                   15157: 		    $oldest_time=$mtime;
                   15158: 		    $oldest=$next;
                   15159: 		}
                   15160: 	    } else {
                   15161: 		$cookie="publicuser_$next";
                   15162: 		last;
                   15163: 	    }
                   15164: 	}
                   15165: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   15166:     } else {
1.463     albertel 15167: 	# if this isn't a robot, kill any existing non-robot sessions
                   15168: 	if (!$args->{'robot'}) {
                   15169: 	    opendir(DIR,$lonids);
                   15170: 	    while ($filename=readdir(DIR)) {
                   15171: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   15172: 		    unlink($lonids.'/'.$filename);
                   15173: 		}
1.462     albertel 15174: 	    }
1.463     albertel 15175: 	    closedir(DIR);
1.1204    raeburn  15176: # If there is a undeleted lockfile for the user's paste buffer remove it.
                   15177:             my $namespace = 'nohist_courseeditor';
                   15178:             my $lockingkey = 'paste'."\0".'locked_num';
                   15179:             my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
                   15180:                                                 $domain,$username);
                   15181:             if (exists($lockhash{$lockingkey})) {
                   15182:                 my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
                   15183:                 unless ($delresult eq 'ok') {
                   15184:                     &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
                   15185:                 }
                   15186:             }
1.462     albertel 15187: 	}
                   15188: # Give them a new cookie
1.463     albertel 15189: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      15190: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 15191: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 15192:     
                   15193: # Initialize roles
                   15194: 
1.1062    raeburn  15195: 	($userroles,$firstaccenv,$timerintenv) = 
                   15196:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 15197:     }
                   15198: # ------------------------------------ Check browser type and MathML capability
                   15199: 
1.1194    raeburn  15200:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
                   15201:         $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462     albertel 15202: 
                   15203: # ------------------------------------------------------------- Get environment
                   15204: 
                   15205:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   15206:     my ($tmp) = keys(%userenv);
                   15207:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   15208:     } else {
                   15209: 	undef(%userenv);
                   15210:     }
                   15211:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   15212: 	$form->{'interface'}=$userenv{'interface'};
                   15213:     }
                   15214:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   15215: 
                   15216: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   15217:     foreach my $option ('interface','localpath','localres') {
                   15218:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 15219:     }
                   15220: # --------------------------------------------------------- Write first profile
                   15221: 
                   15222:     {
                   15223: 	my %initial_env = 
                   15224: 	    ("user.name"          => $username,
                   15225: 	     "user.domain"        => $domain,
                   15226: 	     "user.home"          => $authhost,
                   15227: 	     "browser.type"       => $clientbrowser,
                   15228: 	     "browser.version"    => $clientversion,
                   15229: 	     "browser.mathml"     => $clientmathml,
                   15230: 	     "browser.unicode"    => $clientunicode,
                   15231: 	     "browser.os"         => $clientos,
1.1137    raeburn  15232:              "browser.mobile"     => $clientmobile,
1.1141    raeburn  15233:              "browser.info"       => $clientinfo,
1.1194    raeburn  15234:              "browser.osversion"  => $clientosversion,
1.462     albertel 15235: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   15236: 	     "request.course.fn"  => '',
                   15237: 	     "request.course.uri" => '',
                   15238: 	     "request.course.sec" => '',
                   15239: 	     "request.role"       => 'cm',
                   15240: 	     "request.role.adv"   => $env{'user.adv'},
                   15241: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   15242: 
                   15243:         if ($form->{'localpath'}) {
                   15244: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   15245: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   15246:         }
                   15247: 	
                   15248: 	if ($form->{'interface'}) {
                   15249: 	    $form->{'interface'}=~s/\W//gs;
                   15250: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   15251: 	    $env{'browser.interface'}=$form->{'interface'};
                   15252: 	}
                   15253: 
1.1157    raeburn  15254:         if ($form->{'iptoken'}) {
                   15255:             my $lonhost = $r->dir_config('lonHostID');
                   15256:             $initial_env{"user.noloadbalance"} = $lonhost;
                   15257:             $env{'user.noloadbalance'} = $lonhost;
                   15258:         }
                   15259: 
1.981     raeburn  15260:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  15261:         my %domdef;
                   15262:         unless ($domain eq 'public') {
                   15263:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   15264:         }
1.980     raeburn  15265: 
1.1081    raeburn  15266:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  15267:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  15268:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   15269:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  15270:         }
                   15271: 
1.1165    raeburn  15272:         foreach my $crstype ('official','unofficial','community','textbook') {
1.765     raeburn  15273:             $userenv{'canrequest.'.$crstype} =
                   15274:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  15275:                                                   'reload','requestcourses',
                   15276:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  15277:         }
                   15278: 
1.1092    raeburn  15279:         $userenv{'canrequest.author'} =
                   15280:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   15281:                                         'reload','requestauthor',
                   15282:                                         \%userenv,\%domdef,\%is_adv);
                   15283:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   15284:                                              $domain,$username);
                   15285:         my $reqstatus = $reqauthor{'author_status'};
                   15286:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { 
                   15287:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   15288:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   15289:                                                   $reqauthor{'author'}{'timestamp'};
                   15290:             }
                   15291:         }
                   15292: 
1.462     albertel 15293: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  15294: 
1.462     albertel 15295: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   15296: 		 &GDBM_WRCREAT(),0640)) {
                   15297: 	    &_add_to_env(\%disk_env,\%initial_env);
                   15298: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   15299: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  15300:             if (ref($firstaccenv) eq 'HASH') {
                   15301:                 &_add_to_env(\%disk_env,$firstaccenv);
                   15302:             }
                   15303:             if (ref($timerintenv) eq 'HASH') {
                   15304:                 &_add_to_env(\%disk_env,$timerintenv);
                   15305:             }
1.463     albertel 15306: 	    if (ref($args->{'extra_env'})) {
                   15307: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   15308: 	    }
1.462     albertel 15309: 	    untie(%disk_env);
                   15310: 	} else {
1.705     tempelho 15311: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   15312: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 15313: 	    return 'error: '.$!;
                   15314: 	}
                   15315:     }
                   15316:     $env{'request.role'}='cm';
                   15317:     $env{'request.role.adv'}=$env{'user.adv'};
                   15318:     $env{'browser.type'}=$clientbrowser;
                   15319: 
                   15320:     return $cookie;
                   15321: 
                   15322: }
                   15323: 
                   15324: sub _add_to_env {
                   15325:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  15326:     if (ref($env_data) eq 'HASH') {
                   15327:         while (my ($key,$value) = each(%$env_data)) {
                   15328: 	    $idf->{$prefix.$key} = $value;
                   15329: 	    $env{$prefix.$key}   = $value;
                   15330:         }
1.462     albertel 15331:     }
                   15332: }
                   15333: 
1.685     tempelho 15334: # --- Get the symbolic name of a problem and the url
                   15335: sub get_symb {
                   15336:     my ($request,$silent) = @_;
1.726     raeburn  15337:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 15338:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   15339:     if ($symb eq '') {
                   15340:         if (!$silent) {
1.1071    raeburn  15341:             if (ref($request)) { 
                   15342:                 $request->print("Unable to handle ambiguous references:$url:.");
                   15343:             }
1.685     tempelho 15344:             return ();
                   15345:         }
                   15346:     }
                   15347:     &Apache::lonenc::check_decrypt(\$symb);
                   15348:     return ($symb);
                   15349: }
                   15350: 
                   15351: # --------------------------------------------------------------Get annotation
                   15352: 
                   15353: sub get_annotation {
                   15354:     my ($symb,$enc) = @_;
                   15355: 
                   15356:     my $key = $symb;
                   15357:     if (!$enc) {
                   15358:         $key =
                   15359:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   15360:     }
                   15361:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   15362:     return $annotation{$key};
                   15363: }
                   15364: 
                   15365: sub clean_symb {
1.731     raeburn  15366:     my ($symb,$delete_enc) = @_;
1.685     tempelho 15367: 
                   15368:     &Apache::lonenc::check_decrypt(\$symb);
                   15369:     my $enc = $env{'request.enc'};
1.731     raeburn  15370:     if ($delete_enc) {
1.730     raeburn  15371:         delete($env{'request.enc'});
                   15372:     }
1.685     tempelho 15373: 
                   15374:     return ($symb,$enc);
                   15375: }
1.462     albertel 15376: 
1.1181    raeburn  15377: ############################################################
                   15378: ############################################################
                   15379: 
                   15380: =pod
                   15381: 
                   15382: =head1 Routines for building display used to search for courses
                   15383: 
                   15384: 
                   15385: =over 4
                   15386: 
                   15387: =item * &build_filters()
                   15388: 
                   15389: Create markup for a table used to set filters to use when selecting
1.1182    raeburn  15390: courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
                   15391: and quotacheck.pl
                   15392: 
1.1181    raeburn  15393: 
                   15394: Inputs:
                   15395: 
                   15396: filterlist - anonymous array of fields to include as potential filters 
                   15397: 
                   15398: crstype - course type
                   15399: 
                   15400: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                   15401:               to pop-open a course selector (will contain "extra element"). 
                   15402: 
                   15403: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
                   15404: 
                   15405: filter - anonymous hash of criteria and their values
                   15406: 
                   15407: action - form action
                   15408: 
                   15409: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
                   15410: 
1.1182    raeburn  15411: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181    raeburn  15412: 
                   15413: cloneruname - username of owner of new course who wants to clone
                   15414: 
                   15415: clonerudom - domain of owner of new course who wants to clone
                   15416: 
                   15417: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community) 
                   15418: 
                   15419: codetitlesref - reference to array of titles of components in institutional codes (official courses)
                   15420: 
                   15421: codedom - domain
                   15422: 
                   15423: formname - value of form element named "form". 
                   15424: 
                   15425: fixeddom - domain, if fixed.
                   15426: 
                   15427: prevphase - value to assign to form element named "phase" when going back to the previous screen  
                   15428: 
                   15429: cnameelement - name of form element in form on opener page which will receive title of selected course 
                   15430: 
                   15431: cnumelement - name of form element in form on opener page which will receive courseID  of selected course
                   15432: 
                   15433: cdomelement - name of form element in form on opener page which will receive domain of selected course
                   15434: 
                   15435: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
                   15436: 
                   15437: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
                   15438: 
                   15439: clonewarning - warning message about missing information for intended course owner when DC creates a course
                   15440: 
1.1182    raeburn  15441: 
1.1181    raeburn  15442: Returns: $output - HTML for display of search criteria, and hidden form elements.
                   15443: 
1.1182    raeburn  15444: 
1.1181    raeburn  15445: Side Effects: None
                   15446: 
                   15447: =cut
                   15448: 
                   15449: # ---------------------------------------------- search for courses based on last activity etc.
                   15450: 
                   15451: sub build_filters {
                   15452:     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
                   15453:         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
                   15454:         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
                   15455:         $cnameelement,$cnumelement,$cdomelement,$setroles,
                   15456:         $clonetext,$clonewarning) = @_;
1.1182    raeburn  15457:     my ($list,$jscript);
1.1181    raeburn  15458:     my $onchange = 'javascript:updateFilters(this)';
                   15459:     my ($domainselectform,$sincefilterform,$createdfilterform,
                   15460:         $ownerdomselectform,$persondomselectform,$instcodeform,
                   15461:         $typeselectform,$instcodetitle);
                   15462:     if ($formname eq '') {
                   15463:         $formname = $caller;
                   15464:     }
                   15465:     foreach my $item (@{$filterlist}) {
                   15466:         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   15467:                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
                   15468:             if ($item eq 'domainfilter') {
                   15469:                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
                   15470:             } elsif ($item eq 'coursefilter') {
                   15471:                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
                   15472:             } elsif ($item eq 'ownerfilter') {
                   15473:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   15474:             } elsif ($item eq 'ownerdomfilter') {
                   15475:                 $filter->{'ownerdomfilter'} =
                   15476:                     &LONCAPA::clean_domain($filter->{$item});
                   15477:                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                   15478:                                                        'ownerdomfilter',1);
                   15479:             } elsif ($item eq 'personfilter') {
                   15480:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   15481:             } elsif ($item eq 'persondomfilter') {
                   15482:                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                   15483:                                                         'persondomfilter',1);
                   15484:             } else {
                   15485:                 $filter->{$item} =~ s/\W//g;
                   15486:             }
                   15487:             if (!$filter->{$item}) {
                   15488:                 $filter->{$item} = '';
                   15489:             }
                   15490:         }
                   15491:         if ($item eq 'domainfilter') {
                   15492:             my $allow_blank = 1;
                   15493:             if ($formname eq 'portform') {
                   15494:                 $allow_blank=0;
                   15495:             } elsif ($formname eq 'studentform') {
                   15496:                 $allow_blank=0;
                   15497:             }
                   15498:             if ($fixeddom) {
                   15499:                 $domainselectform = '<input type="hidden" name="domainfilter"'.
                   15500:                                     ' value="'.$codedom.'" />'.
                   15501:                                     &Apache::lonnet::domain($codedom,'description');
                   15502:             } else {
                   15503:                 $domainselectform = &select_dom_form($filter->{$item},
                   15504:                                                      'domainfilter',
                   15505:                                                       $allow_blank,'',$onchange);
                   15506:             }
                   15507:         } else {
                   15508:             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
                   15509:         }
                   15510:     }
                   15511: 
                   15512:     # last course activity filter and selection
                   15513:     $sincefilterform = &timebased_select_form('sincefilter',$filter);
                   15514: 
                   15515:     # course created filter and selection
                   15516:     if (exists($filter->{'createdfilter'})) {
                   15517:         $createdfilterform = &timebased_select_form('createdfilter',$filter);
                   15518:     }
                   15519: 
                   15520:     my %lt = &Apache::lonlocal::texthash(
                   15521:                 'cac' => "$crstype Activity",
                   15522:                 'ccr' => "$crstype Created",
                   15523:                 'cde' => "$crstype Title",
                   15524:                 'cdo' => "$crstype Domain",
                   15525:                 'ins' => 'Institutional Code',
                   15526:                 'inc' => 'Institutional Categorization',
                   15527:                 'cow' => "$crstype Owner/Co-owner",
                   15528:                 'cop' => "$crstype Personnel Includes",
                   15529:                 'cog' => 'Type',
                   15530:              );
                   15531: 
                   15532:     if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   15533:         my $typeval = 'Course';
                   15534:         if ($crstype eq 'Community') {
                   15535:             $typeval = 'Community';
                   15536:         }
                   15537:         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
                   15538:     } else {
                   15539:         $typeselectform =  '<select name="type" size="1"';
                   15540:         if ($onchange) {
                   15541:             $typeselectform .= ' onchange="'.$onchange.'"';
                   15542:         }
                   15543:         $typeselectform .= '>'."\n";
                   15544:         foreach my $posstype ('Course','Community') {
                   15545:             $typeselectform.='<option value="'.$posstype.'"'.
                   15546:                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
                   15547:         }
                   15548:         $typeselectform.="</select>";
                   15549:     }
                   15550: 
                   15551:     my ($cloneableonlyform,$cloneabletitle);
                   15552:     if (exists($filter->{'cloneableonly'})) {
                   15553:         my $cloneableon = '';
                   15554:         my $cloneableoff = ' checked="checked"';
                   15555:         if ($filter->{'cloneableonly'}) {
                   15556:             $cloneableon = $cloneableoff;
                   15557:             $cloneableoff = '';
                   15558:         }
                   15559:         $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>';
                   15560:         if ($formname eq 'ccrs') {
1.1187    bisitz   15561:             $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181    raeburn  15562:         } else {
                   15563:             $cloneabletitle = &mt('Cloneable by you');
                   15564:         }
                   15565:     }
                   15566:     my $officialjs;
                   15567:     if ($crstype eq 'Course') {
                   15568:         if (exists($filter->{'instcodefilter'})) {
1.1182    raeburn  15569: #            if (($fixeddom) || ($formname eq 'requestcrs') ||
                   15570: #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
                   15571:             if ($codedom) { 
1.1181    raeburn  15572:                 $officialjs = 1;
                   15573:                 ($instcodeform,$jscript,$$numtitlesref) =
                   15574:                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                   15575:                                                                   $officialjs,$codetitlesref);
                   15576:                 if ($jscript) {
1.1182    raeburn  15577:                     $jscript = '<script type="text/javascript">'."\n".
                   15578:                                '// <![CDATA['."\n".
                   15579:                                $jscript."\n".
                   15580:                                '// ]]>'."\n".
                   15581:                                '</script>'."\n";
1.1181    raeburn  15582:                 }
                   15583:             }
                   15584:             if ($instcodeform eq '') {
                   15585:                 $instcodeform =
                   15586:                     '<input type="text" name="instcodefilter" size="10" value="'.
                   15587:                     $list->{'instcodefilter'}.'" />';
                   15588:                 $instcodetitle = $lt{'ins'};
                   15589:             } else {
                   15590:                 $instcodetitle = $lt{'inc'};
                   15591:             }
                   15592:             if ($fixeddom) {
                   15593:                 $instcodetitle .= '<br />('.$codedom.')';
                   15594:             }
                   15595:         }
                   15596:     }
                   15597:     my $output = qq|
                   15598: <form method="post" name="filterpicker" action="$action">
                   15599: <input type="hidden" name="form" value="$formname" />
                   15600: |;
                   15601:     if ($formname eq 'modifycourse') {
                   15602:         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                   15603:                    '<input type="hidden" name="prevphase" value="'.
                   15604:                    $prevphase.'" />'."\n";
1.1198    musolffc 15605:     } elsif ($formname eq 'quotacheck') {
                   15606:         $output .= qq|
                   15607: <input type="hidden" name="sortby" value="" />
                   15608: <input type="hidden" name="sortorder" value="" />
                   15609: |;
                   15610:     } else {
1.1181    raeburn  15611:         my $name_input;
                   15612:         if ($cnameelement ne '') {
                   15613:             $name_input = '<input type="hidden" name="cnameelement" value="'.
                   15614:                           $cnameelement.'" />';
                   15615:         }
                   15616:         $output .= qq|
1.1182    raeburn  15617: <input type="hidden" name="cnumelement" value="$cnumelement" />
                   15618: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181    raeburn  15619: $name_input
                   15620: $roleelement
                   15621: $multelement
                   15622: $typeelement
                   15623: |;
                   15624:         if ($formname eq 'portform') {
                   15625:             $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
                   15626:         }
                   15627:     }
                   15628:     if ($fixeddom) {
                   15629:         $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
                   15630:     }
                   15631:     $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
                   15632:     if ($sincefilterform) {
                   15633:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                   15634:                   .$sincefilterform
                   15635:                   .&Apache::lonhtmlcommon::row_closure();
                   15636:     }
                   15637:     if ($createdfilterform) {
                   15638:         $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                   15639:                   .$createdfilterform
                   15640:                   .&Apache::lonhtmlcommon::row_closure();
                   15641:     }
                   15642:     if ($domainselectform) {
                   15643:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                   15644:                   .$domainselectform
                   15645:                   .&Apache::lonhtmlcommon::row_closure();
                   15646:     }
                   15647:     if ($typeselectform) {
                   15648:         if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   15649:             $output .= $typeselectform;
                   15650:         } else {
                   15651:             $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                   15652:                       .$typeselectform
                   15653:                       .&Apache::lonhtmlcommon::row_closure();
                   15654:         }
                   15655:     }
                   15656:     if ($instcodeform) {
                   15657:         $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                   15658:                   .$instcodeform
                   15659:                   .&Apache::lonhtmlcommon::row_closure();
                   15660:     }
                   15661:     if (exists($filter->{'ownerfilter'})) {
                   15662:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                   15663:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   15664:                    '<input type="text" name="ownerfilter" size="20" value="'.
                   15665:                    $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   15666:                    $ownerdomselectform.'</td></tr></table>'.
                   15667:                    &Apache::lonhtmlcommon::row_closure();
                   15668:     }
                   15669:     if (exists($filter->{'personfilter'})) {
                   15670:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                   15671:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   15672:                    '<input type="text" name="personfilter" size="20" value="'.
                   15673:                    $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   15674:                    $persondomselectform.'</td></tr></table>'.
                   15675:                    &Apache::lonhtmlcommon::row_closure();
                   15676:     }
                   15677:     if (exists($filter->{'coursefilter'})) {
                   15678:         $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                   15679:                   .'<input type="text" name="coursefilter" size="25" value="'
                   15680:                   .$list->{'coursefilter'}.'" />'
                   15681:                   .&Apache::lonhtmlcommon::row_closure();
                   15682:     }
                   15683:     if ($cloneableonlyform) {
                   15684:         $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                   15685:                    $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
                   15686:     }
                   15687:     if (exists($filter->{'descriptfilter'})) {
                   15688:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                   15689:                   .'<input type="text" name="descriptfilter" size="40" value="'
                   15690:                   .$list->{'descriptfilter'}.'" />'
                   15691:                   .&Apache::lonhtmlcommon::row_closure(1);
                   15692:     }
                   15693:     $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                   15694:                '<input type="hidden" name="updater" value="" />'."\n".
                   15695:                '<input type="submit" name="gosearch" value="'.
                   15696:                &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
                   15697:     return $jscript.$clonewarning.$output;
                   15698: }
                   15699: 
                   15700: =pod 
                   15701: 
                   15702: =item * &timebased_select_form()
                   15703: 
1.1182    raeburn  15704: Create markup for a dropdown list used to select a time-based
1.1181    raeburn  15705: filter e.g., Course Activity, Course Created, when searching for courses
                   15706: or communities
                   15707: 
                   15708: Inputs:
                   15709: 
                   15710: item - name of form element (sincefilter or createdfilter)
                   15711: 
                   15712: filter - anonymous hash of criteria and their values
                   15713: 
                   15714: Returns: HTML for a select box contained a blank, then six time selections,
                   15715:          with value set in incoming form variables currently selected. 
                   15716: 
                   15717: Side Effects: None
                   15718: 
                   15719: =cut
                   15720: 
                   15721: sub timebased_select_form {
                   15722:     my ($item,$filter) = @_;
                   15723:     if (ref($filter) eq 'HASH') {
                   15724:         $filter->{$item} =~ s/[^\d-]//g;
                   15725:         if (!$filter->{$item}) { $filter->{$item}=-1; }
                   15726:         return &select_form(
                   15727:                             $filter->{$item},
                   15728:                             $item,
                   15729:                             {      '-1' => '',
                   15730:                                 '86400' => &mt('today'),
                   15731:                                '604800' => &mt('last week'),
                   15732:                               '2592000' => &mt('last month'),
                   15733:                               '7776000' => &mt('last three months'),
                   15734:                              '15552000' => &mt('last six months'),
                   15735:                              '31104000' => &mt('last year'),
                   15736:                     'select_form_order' =>
                   15737:                            ['-1','86400','604800','2592000','7776000',
                   15738:                             '15552000','31104000']});
                   15739:     }
                   15740: }
                   15741: 
                   15742: =pod
                   15743: 
                   15744: =item * &js_changer()
                   15745: 
                   15746: Create script tag containing Javascript used to submit course search form
1.1183    raeburn  15747: when course type or domain is changed, and also to hide 'Searching ...' on
                   15748: page load completion for page showing search result.
1.1181    raeburn  15749: 
                   15750: Inputs: None
                   15751: 
1.1183    raeburn  15752: Returns: markup containing updateFilters() and hideSearching() javascript functions. 
1.1181    raeburn  15753: 
                   15754: Side Effects: None
                   15755: 
                   15756: =cut
                   15757: 
                   15758: sub js_changer {
                   15759:     return <<ENDJS;
                   15760: <script type="text/javascript">
                   15761: // <![CDATA[
                   15762: function updateFilters(caller) {
                   15763:     if (typeof(caller) != "undefined") {
                   15764:         document.filterpicker.updater.value = caller.name;
                   15765:     }
                   15766:     document.filterpicker.submit();
                   15767: }
1.1183    raeburn  15768: 
                   15769: function hideSearching() {
                   15770:     if (document.getElementById('searching')) {
                   15771:         document.getElementById('searching').style.display = 'none';
                   15772:     }
                   15773:     return;
                   15774: }
                   15775: 
1.1181    raeburn  15776: // ]]>
                   15777: </script>
                   15778: 
                   15779: ENDJS
                   15780: }
                   15781: 
                   15782: =pod
                   15783: 
1.1182    raeburn  15784: =item * &search_courses()
                   15785: 
                   15786: Process selected filters form course search form and pass to lonnet::courseiddump
                   15787: to retrieve a hash for which keys are courseIDs which match the selected filters.
                   15788: 
                   15789: Inputs:
                   15790: 
                   15791: dom - domain being searched 
                   15792: 
                   15793: type - course type ('Course' or 'Community' or '.' if any).
                   15794: 
                   15795: filter - anonymous hash of criteria and their values
                   15796: 
                   15797: numtitles - for institutional codes - number of categories
                   15798: 
                   15799: cloneruname - optional username of new course owner
                   15800: 
                   15801: clonerudom - optional domain of new course owner
                   15802: 
1.1221    raeburn  15803: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, 
1.1182    raeburn  15804:             (used when DC is using course creation form)
                   15805: 
                   15806: codetitles - reference to array of titles of components in institutional codes (official courses).
                   15807: 
1.1221    raeburn  15808: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
                   15809:            (and so can clone automatically)
                   15810: 
                   15811: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
                   15812: 
                   15813: reqinstcode - institutional code of new course, where search_courses is used to identify potential 
                   15814:               courses to clone 
1.1182    raeburn  15815: 
                   15816: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
                   15817: 
                   15818: 
                   15819: Side Effects: None
                   15820: 
                   15821: =cut
                   15822: 
                   15823: 
                   15824: sub search_courses {
1.1221    raeburn  15825:     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
                   15826:         $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182    raeburn  15827:     my (%courses,%showcourses,$cloner);
                   15828:     if (($filter->{'ownerfilter'} ne '') ||
                   15829:         ($filter->{'ownerdomfilter'} ne '')) {
                   15830:         $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                   15831:                                        $filter->{'ownerdomfilter'};
                   15832:     }
                   15833:     foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
                   15834:         if (!$filter->{$item}) {
                   15835:             $filter->{$item}='.';
                   15836:         }
                   15837:     }
                   15838:     my $now = time;
                   15839:     my $timefilter =
                   15840:        ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
                   15841:     my ($createdbefore,$createdafter);
                   15842:     if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
                   15843:         $createdbefore = $now;
                   15844:         $createdafter = $now-$filter->{'createdfilter'};
                   15845:     }
                   15846:     my ($instcodefilter,$regexpok);
                   15847:     if ($numtitles) {
                   15848:         if ($env{'form.official'} eq 'on') {
                   15849:             $instcodefilter =
                   15850:                 &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   15851:             $regexpok = 1;
                   15852:         } elsif ($env{'form.official'} eq 'off') {
                   15853:             $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   15854:             unless ($instcodefilter eq '') {
                   15855:                 $regexpok = -1;
                   15856:             }
                   15857:         }
                   15858:     } else {
                   15859:         $instcodefilter = $filter->{'instcodefilter'};
                   15860:     }
                   15861:     if ($instcodefilter eq '') { $instcodefilter = '.'; }
                   15862:     if ($type eq '') { $type = '.'; }
                   15863: 
                   15864:     if (($clonerudom ne '') && ($cloneruname ne '')) {
                   15865:         $cloner = $cloneruname.':'.$clonerudom;
                   15866:     }
                   15867:     %courses = &Apache::lonnet::courseiddump($dom,
                   15868:                                              $filter->{'descriptfilter'},
                   15869:                                              $timefilter,
                   15870:                                              $instcodefilter,
                   15871:                                              $filter->{'combownerfilter'},
                   15872:                                              $filter->{'coursefilter'},
                   15873:                                              undef,undef,$type,$regexpok,undef,undef,
1.1221    raeburn  15874:                                              undef,undef,$cloner,$cc_clone,
1.1182    raeburn  15875:                                              $filter->{'cloneableonly'},
                   15876:                                              $createdbefore,$createdafter,undef,
1.1221    raeburn  15877:                                              $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182    raeburn  15878:     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
                   15879:         my $ccrole;
                   15880:         if ($type eq 'Community') {
                   15881:             $ccrole = 'co';
                   15882:         } else {
                   15883:             $ccrole = 'cc';
                   15884:         }
                   15885:         my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                   15886:                                                      $filter->{'persondomfilter'},
                   15887:                                                      'userroles',undef,
                   15888:                                                      [$ccrole,'in','ad','ep','ta','cr'],
                   15889:                                                      $dom);
                   15890:         foreach my $role (keys(%rolehash)) {
                   15891:             my ($cnum,$cdom,$courserole) = split(':',$role);
                   15892:             my $cid = $cdom.'_'.$cnum;
                   15893:             if (exists($courses{$cid})) {
                   15894:                 if (ref($courses{$cid}) eq 'HASH') {
                   15895:                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                   15896:                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
                   15897:                             push (@{$courses{$cid}{roles}},$courserole);
                   15898:                         }
                   15899:                     } else {
                   15900:                         $courses{$cid}{roles} = [$courserole];
                   15901:                     }
                   15902:                     $showcourses{$cid} = $courses{$cid};
                   15903:                 }
                   15904:             }
                   15905:         }
                   15906:         %courses = %showcourses;
                   15907:     }
                   15908:     return %courses;
                   15909: }
                   15910: 
                   15911: =pod
                   15912: 
1.1181    raeburn  15913: =back
                   15914: 
1.1207    raeburn  15915: =head1 Routines for version requirements for current course.
                   15916: 
                   15917: =over 4
                   15918: 
                   15919: =item * &check_release_required()
                   15920: 
                   15921: Compares required LON-CAPA version with version on server, and
                   15922: if required version is newer looks for a server with the required version.
                   15923: 
                   15924: Looks first at servers in user's owen domain; if none suitable, looks at
                   15925: servers in course's domain are permitted to host sessions for user's domain.
                   15926: 
                   15927: Inputs:
                   15928: 
                   15929: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   15930: 
                   15931: $courseid - Course ID of current course
                   15932: 
                   15933: $rolecode - User's current role in course (for switchserver query string).
                   15934: 
                   15935: $required - LON-CAPA version needed by course (format: Major.Minor).
                   15936: 
                   15937: 
                   15938: Returns:
                   15939: 
                   15940: $switchserver - query string tp append to /adm/switchserver call (if 
                   15941:                 current server's LON-CAPA version is too old. 
                   15942: 
                   15943: $warning - Message is displayed if no suitable server could be found.
                   15944: 
                   15945: =cut
                   15946: 
                   15947: sub check_release_required {
                   15948:     my ($loncaparev,$courseid,$rolecode,$required) = @_;
                   15949:     my ($switchserver,$warning);
                   15950:     if ($required ne '') {
                   15951:         my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
                   15952:         my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   15953:         if ($reqdmajor ne '' && $reqdminor ne '') {
                   15954:             my $otherserver;
                   15955:             if (($major eq '' && $minor eq '') ||
                   15956:                 (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
                   15957:                 my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
                   15958:                 my $switchlcrev =
                   15959:                     &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
                   15960:                                                            $userdomserver);
                   15961:                 my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   15962:                 if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
                   15963:                     (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
                   15964:                     my $cdom = $env{'course.'.$courseid.'.domain'};
                   15965:                     if ($cdom ne $env{'user.domain'}) {
                   15966:                         my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
                   15967:                         my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
                   15968:                         my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   15969:                         my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
                   15970:                         my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
                   15971:                         my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
                   15972:                         my $canhost =
                   15973:                             &Apache::lonnet::can_host_session($env{'user.domain'},
                   15974:                                                               $coursedomserver,
                   15975:                                                               $remoterev,
                   15976:                                                               $udomdefaults{'remotesessions'},
                   15977:                                                               $defdomdefaults{'hostedsessions'});
                   15978: 
                   15979:                         if ($canhost) {
                   15980:                             $otherserver = $coursedomserver;
                   15981:                         } else {
                   15982:                             $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain.");
                   15983:                         }
                   15984:                     } else {
                   15985:                         $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'<br />'.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain).");
                   15986:                     }
                   15987:                 } else {
                   15988:                     $otherserver = $userdomserver;
                   15989:                 }
                   15990:             }
                   15991:             if ($otherserver ne '') {
                   15992:                 $switchserver = 'otherserver='.$otherserver.'&amp;role='.$rolecode;
                   15993:             }
                   15994:         }
                   15995:     }
                   15996:     return ($switchserver,$warning);
                   15997: }
                   15998: 
                   15999: =pod
                   16000: 
                   16001: =item * &check_release_result()
                   16002: 
                   16003: Inputs:
                   16004: 
                   16005: $switchwarning - Warning message if no suitable server found to host session.
                   16006: 
                   16007: $switchserver - query string to append to /adm/switchserver containing lonHostID
                   16008:                 and current role.
                   16009: 
                   16010: Returns: HTML to display with information about requirement to switch server.
                   16011:          Either displaying warning with link to Roles/Courses screen or
                   16012:          display link to switchserver.
                   16013: 
1.1181    raeburn  16014: =cut
                   16015: 
1.1207    raeburn  16016: sub check_release_result {
                   16017:     my ($switchwarning,$switchserver) = @_;
                   16018:     my $output = &start_page('Selected course unavailable on this server').
                   16019:                  '<p class="LC_warning">';
                   16020:     if ($switchwarning) {
                   16021:         $output .= $switchwarning.'<br /><a href="/adm/roles">';
                   16022:         if (&show_course()) {
                   16023:             $output .= &mt('Display courses');
                   16024:         } else {
                   16025:             $output .= &mt('Display roles');
                   16026:         }
                   16027:         $output .= '</a>';
                   16028:     } elsif ($switchserver) {
                   16029:         $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
                   16030:                    '<br />'.
                   16031:                    '<a href="/adm/switchserver?'.$switchserver.'">'.
                   16032:                    &mt('Switch Server').
                   16033:                    '</a>';
                   16034:     }
                   16035:     $output .= '</p>'.&end_page();
                   16036:     return $output;
                   16037: }
                   16038: 
                   16039: =pod
                   16040: 
                   16041: =item * &needs_coursereinit()
                   16042: 
                   16043: Determine if course contents stored for user's session needs to be
                   16044: refreshed, because content has changed since "Big Hash" last tied.
                   16045: 
                   16046: Check for change is made if time last checked is more than 10 minutes ago
                   16047: (by default).
                   16048: 
                   16049: Inputs:
                   16050: 
                   16051: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   16052: 
                   16053: $interval (optional) - Time which may elapse (in s) between last check for content
                   16054:                        change in current course. (default: 600 s).  
                   16055: 
                   16056: Returns: an array; first element is:
                   16057: 
                   16058: =over 4
                   16059: 
                   16060: 'switch' - if content updates mean user's session
                   16061:            needs to be switched to a server running a newer LON-CAPA version
                   16062:  
                   16063: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
                   16064:            on current server hosting user's session                
                   16065: 
                   16066: ''       - if no action required.
                   16067: 
                   16068: =back
                   16069: 
                   16070: If first item element is 'switch':
                   16071: 
                   16072: second item is $switchwarning - Warning message if no suitable server found to host session. 
                   16073: 
                   16074: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
                   16075:                               and current role. 
                   16076: 
                   16077: otherwise: no other elements returned.
                   16078: 
                   16079: =back
                   16080: 
                   16081: =cut
                   16082: 
                   16083: sub needs_coursereinit {
                   16084:     my ($loncaparev,$interval) = @_;
                   16085:     return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
                   16086:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   16087:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   16088:     my $now = time;
                   16089:     if ($interval eq '') {
                   16090:         $interval = 600;
                   16091:     }
                   16092:     if (($now-$env{'request.course.timechecked'})>$interval) {
                   16093:         my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
                   16094:         &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
                   16095:         if ($lastchange > $env{'request.course.tied'}) {
                   16096:             my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   16097:             if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
                   16098:                 my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
                   16099:                 if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
                   16100:                     &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
                   16101:                                              $curr_reqd_hash{'internal.releaserequired'}});
                   16102:                     my ($switchserver,$switchwarning) =
                   16103:                         &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
                   16104:                                                 $curr_reqd_hash{'internal.releaserequired'});
                   16105:                     if ($switchwarning ne '' || $switchserver ne '') {
                   16106:                         return ('switch',$switchwarning,$switchserver);
                   16107:                     }
                   16108:                 }
                   16109:             }
                   16110:             return ('update');
                   16111:         }
                   16112:     }
                   16113:     return ();
                   16114: }
1.1181    raeburn  16115: 
1.1083    raeburn  16116: sub update_content_constraints {
                   16117:     my ($cdom,$cnum,$chome,$cid) = @_;
                   16118:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   16119:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   16120:     my %checkresponsetypes;
                   16121:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1219    raeburn  16122:         my ($item,$name,$value,$valmatch) = split(/:/,$key);
1.1083    raeburn  16123:         if ($item eq 'resourcetag') {
                   16124:             if ($name eq 'responsetype') {
                   16125:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   16126:             }
                   16127:         }
                   16128:     }
                   16129:     my $navmap = Apache::lonnavmaps::navmap->new();
                   16130:     if (defined($navmap)) {
                   16131:         my %allresponses;
                   16132:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   16133:             my %responses = $res->responseTypes();
                   16134:             foreach my $key (keys(%responses)) {
                   16135:                 next unless(exists($checkresponsetypes{$key}));
                   16136:                 $allresponses{$key} += $responses{$key};
                   16137:             }
                   16138:         }
                   16139:         foreach my $key (keys(%allresponses)) {
                   16140:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   16141:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   16142:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   16143:             }
                   16144:         }
                   16145:         undef($navmap);
                   16146:     }
                   16147:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   16148:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   16149:     }
                   16150:     return;
                   16151: }
                   16152: 
1.1110    raeburn  16153: sub allmaps_incourse {
                   16154:     my ($cdom,$cnum,$chome,$cid) = @_;
                   16155:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   16156:         $cid = $env{'request.course.id'};
                   16157:         $cdom = $env{'course.'.$cid.'.domain'};
                   16158:         $cnum = $env{'course.'.$cid.'.num'};
                   16159:         $chome = $env{'course.'.$cid.'.home'};
                   16160:     }
                   16161:     my %allmaps = ();
                   16162:     my $lastchange =
                   16163:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   16164:     if ($lastchange > $env{'request.course.tied'}) {
                   16165:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   16166:         unless ($ferr) {
                   16167:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   16168:         }
                   16169:     }
                   16170:     my $navmap = Apache::lonnavmaps::navmap->new();
                   16171:     if (defined($navmap)) {
                   16172:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   16173:             $allmaps{$res->src()} = 1;
                   16174:         }
                   16175:     }
                   16176:     return \%allmaps;
                   16177: }
                   16178: 
1.1083    raeburn  16179: sub parse_supplemental_title {
                   16180:     my ($title) = @_;
                   16181: 
                   16182:     my ($foldertitle,$renametitle);
                   16183:     if ($title =~ /&amp;&amp;&amp;/) {
                   16184:         $title = &HTML::Entites::decode($title);
                   16185:     }
                   16186:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   16187:         $renametitle=$4;
                   16188:         my ($time,$uname,$udom) = ($1,$2,$3);
                   16189:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   16190:         my $name =  &plainname($uname,$udom);
                   16191:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   16192:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   16193:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   16194:             $name.': <br />'.$foldertitle;
                   16195:     }
                   16196:     if (wantarray) {
                   16197:         return ($title,$foldertitle,$renametitle);
                   16198:     }
                   16199:     return $title;
                   16200: }
                   16201: 
1.1143    raeburn  16202: sub recurse_supplemental {
                   16203:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
                   16204:     if ($suppmap) {
                   16205:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   16206:         if ($fatal) {
                   16207:             $errors ++;
                   16208:         } else {
                   16209:             if ($#LONCAPA::map::resources > 0) {
                   16210:                 foreach my $res (@LONCAPA::map::resources) {
                   16211:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                   16212:                     if (($src ne '') && ($status eq 'res')) {
1.1146    raeburn  16213:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                   16214:                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143    raeburn  16215:                         } else {
                   16216:                             $numfiles ++;
                   16217:                         }
                   16218:                     }
                   16219:                 }
                   16220:             }
                   16221:         }
                   16222:     }
                   16223:     return ($numfiles,$errors);
                   16224: }
                   16225: 
1.1101    raeburn  16226: sub symb_to_docspath {
                   16227:     my ($symb) = @_;
                   16228:     return unless ($symb);
                   16229:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   16230:     if ($resurl=~/\.(sequence|page)$/) {
                   16231:         $mapurl=$resurl;
                   16232:     } elsif ($resurl eq 'adm/navmaps') {
                   16233:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   16234:     }
                   16235:     my $mapresobj;
                   16236:     my $navmap = Apache::lonnavmaps::navmap->new();
                   16237:     if (ref($navmap)) {
                   16238:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   16239:     }
                   16240:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   16241:     my $type=$2;
                   16242:     my $path;
                   16243:     if (ref($mapresobj)) {
                   16244:         my $pcslist = $mapresobj->map_hierarchy();
                   16245:         if ($pcslist ne '') {
                   16246:             foreach my $pc (split(/,/,$pcslist)) {
                   16247:                 next if ($pc <= 1);
                   16248:                 my $res = $navmap->getByMapPc($pc);
                   16249:                 if (ref($res)) {
                   16250:                     my $thisurl = $res->src();
                   16251:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   16252:                     my $thistitle = $res->title();
                   16253:                     $path .= '&'.
                   16254:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146    raeburn  16255:                              &escape($thistitle).
1.1101    raeburn  16256:                              ':'.$res->randompick().
                   16257:                              ':'.$res->randomout().
                   16258:                              ':'.$res->encrypted().
                   16259:                              ':'.$res->randomorder().
                   16260:                              ':'.$res->is_page();
                   16261:                 }
                   16262:             }
                   16263:         }
                   16264:         $path =~ s/^\&//;
                   16265:         my $maptitle = $mapresobj->title();
                   16266:         if ($mapurl eq 'default') {
1.1129    raeburn  16267:             $maptitle = 'Main Content';
1.1101    raeburn  16268:         }
                   16269:         $path .= (($path ne '')? '&' : '').
                   16270:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  16271:                  &escape($maptitle).
1.1101    raeburn  16272:                  ':'.$mapresobj->randompick().
                   16273:                  ':'.$mapresobj->randomout().
                   16274:                  ':'.$mapresobj->encrypted().
                   16275:                  ':'.$mapresobj->randomorder().
                   16276:                  ':'.$mapresobj->is_page();
                   16277:     } else {
                   16278:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   16279:         my $ispage = (($type eq 'page')? 1 : '');
                   16280:         if ($mapurl eq 'default') {
1.1129    raeburn  16281:             $maptitle = 'Main Content';
1.1101    raeburn  16282:         }
                   16283:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  16284:                 &escape($maptitle).':::::'.$ispage;
1.1101    raeburn  16285:     }
                   16286:     unless ($mapurl eq 'default') {
                   16287:         $path = 'default&'.
1.1146    raeburn  16288:                 &escape('Main Content').
1.1101    raeburn  16289:                 ':::::&'.$path;
                   16290:     }
                   16291:     return $path;
                   16292: }
                   16293: 
1.1094    raeburn  16294: sub captcha_display {
                   16295:     my ($context,$lonhost) = @_;
                   16296:     my ($output,$error);
                   16297:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095    raeburn  16298:     if ($captcha eq 'original') {
1.1094    raeburn  16299:         $output = &create_captcha();
                   16300:         unless ($output) {
1.1172    raeburn  16301:             $error = 'captcha';
1.1094    raeburn  16302:         }
                   16303:     } elsif ($captcha eq 'recaptcha') {
                   16304:         $output = &create_recaptcha($pubkey);
                   16305:         unless ($output) {
1.1172    raeburn  16306:             $error = 'recaptcha';
1.1094    raeburn  16307:         }
                   16308:     }
1.1176    raeburn  16309:     return ($output,$error,$captcha);
1.1094    raeburn  16310: }
                   16311: 
                   16312: sub captcha_response {
                   16313:     my ($context,$lonhost) = @_;
                   16314:     my ($captcha_chk,$captcha_error);
                   16315:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095    raeburn  16316:     if ($captcha eq 'original') {
1.1094    raeburn  16317:         ($captcha_chk,$captcha_error) = &check_captcha();
                   16318:     } elsif ($captcha eq 'recaptcha') {
                   16319:         $captcha_chk = &check_recaptcha($privkey);
                   16320:     } else {
                   16321:         $captcha_chk = 1;
                   16322:     }
                   16323:     return ($captcha_chk,$captcha_error);
                   16324: }
                   16325: 
                   16326: sub get_captcha_config {
                   16327:     my ($context,$lonhost) = @_;
1.1095    raeburn  16328:     my ($captcha,$pubkey,$privkey,$hashtocheck);
1.1094    raeburn  16329:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   16330:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   16331:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095    raeburn  16332:     if ($context eq 'usercreation') {
                   16333:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   16334:         if (ref($domconfig{$context}) eq 'HASH') {
                   16335:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   16336:             if (ref($hashtocheck) eq 'HASH') {
                   16337:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   16338:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   16339:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   16340:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   16341:                     }
                   16342:                     if ($privkey && $pubkey) {
                   16343:                         $captcha = 'recaptcha';
                   16344:                     } else {
                   16345:                         $captcha = 'original';
                   16346:                     }
                   16347:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   16348:                     $captcha = 'original';
                   16349:                 }
1.1094    raeburn  16350:             }
1.1095    raeburn  16351:         } else {
                   16352:             $captcha = 'captcha';
                   16353:         }
                   16354:     } elsif ($context eq 'login') {
                   16355:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   16356:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   16357:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   16358:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094    raeburn  16359:             if ($privkey && $pubkey) {
                   16360:                 $captcha = 'recaptcha';
1.1095    raeburn  16361:             } else {
                   16362:                 $captcha = 'original';
1.1094    raeburn  16363:             }
1.1095    raeburn  16364:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   16365:             $captcha = 'original';
1.1094    raeburn  16366:         }
                   16367:     }
                   16368:     return ($captcha,$pubkey,$privkey);
                   16369: }
                   16370: 
                   16371: sub create_captcha {
                   16372:     my %captcha_params = &captcha_settings();
                   16373:     my ($output,$maxtries,$tries) = ('',10,0);
                   16374:     while ($tries < $maxtries) {
                   16375:         $tries ++;
                   16376:         my $captcha = Authen::Captcha->new (
                   16377:                                            output_folder => $captcha_params{'output_dir'},
                   16378:                                            data_folder   => $captcha_params{'db_dir'},
                   16379:                                           );
                   16380:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   16381: 
                   16382:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   16383:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   16384:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
1.1176    raeburn  16385:                       '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
                   16386:                       '<br />'.
                   16387:                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094    raeburn  16388:             last;
                   16389:         }
                   16390:     }
                   16391:     return $output;
                   16392: }
                   16393: 
                   16394: sub captcha_settings {
                   16395:     my %captcha_params = (
                   16396:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   16397:                            www_output_dir => "/captchaspool",
                   16398:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   16399:                            numchars       => '5',
                   16400:                          );
                   16401:     return %captcha_params;
                   16402: }
                   16403: 
                   16404: sub check_captcha {
                   16405:     my ($captcha_chk,$captcha_error);
                   16406:     my $code = $env{'form.code'};
                   16407:     my $md5sum = $env{'form.crypt'};
                   16408:     my %captcha_params = &captcha_settings();
                   16409:     my $captcha = Authen::Captcha->new(
                   16410:                       output_folder => $captcha_params{'output_dir'},
                   16411:                       data_folder   => $captcha_params{'db_dir'},
                   16412:                   );
1.1109    raeburn  16413:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094    raeburn  16414:     my %captcha_hash = (
                   16415:                         0       => 'Code not checked (file error)',
                   16416:                        -1      => 'Failed: code expired',
                   16417:                        -2      => 'Failed: invalid code (not in database)',
                   16418:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   16419:     );
                   16420:     if ($captcha_chk != 1) {
                   16421:         $captcha_error = $captcha_hash{$captcha_chk}
                   16422:     }
                   16423:     return ($captcha_chk,$captcha_error);
                   16424: }
                   16425: 
                   16426: sub create_recaptcha {
                   16427:     my ($pubkey) = @_;
1.1153    raeburn  16428:     my $use_ssl;
                   16429:     if ($ENV{'SERVER_PORT'} == 443) {
                   16430:         $use_ssl = 1;
                   16431:     }
1.1094    raeburn  16432:     my $captcha = Captcha::reCAPTCHA->new;
                   16433:     return $captcha->get_options_setter({theme => 'white'})."\n".
1.1153    raeburn  16434:            $captcha->get_html($pubkey,undef,$use_ssl).
1.1213    raeburn  16435:            &mt('If the text is hard to read, [_1] will replace them.',
1.1133    raeburn  16436:                '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1094    raeburn  16437:            '<br /><br />';
                   16438: }
                   16439: 
                   16440: sub check_recaptcha {
                   16441:     my ($privkey) = @_;
                   16442:     my $captcha_chk;
                   16443:     my $captcha = Captcha::reCAPTCHA->new;
                   16444:     my $captcha_result =
                   16445:         $captcha->check_answer(
                   16446:                                 $privkey,
                   16447:                                 $ENV{'REMOTE_ADDR'},
                   16448:                                 $env{'form.recaptcha_challenge_field'},
                   16449:                                 $env{'form.recaptcha_response_field'},
                   16450:                               );
                   16451:     if ($captcha_result->{is_valid}) {
                   16452:         $captcha_chk = 1;
                   16453:     }
                   16454:     return $captcha_chk;
                   16455: }
                   16456: 
1.1174    raeburn  16457: sub emailusername_info {
1.1177    raeburn  16458:     my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1174    raeburn  16459:     my %titles = &Apache::lonlocal::texthash (
                   16460:                      lastname      => 'Last Name',
                   16461:                      firstname     => 'First Name',
                   16462:                      institution   => 'School/college/university',
                   16463:                      location      => "School's city, state/province, country",
                   16464:                      web           => "School's web address",
                   16465:                      officialemail => 'E-mail address at institution (if different)',
                   16466:                  );
                   16467:     return (\@fields,\%titles);
                   16468: }
                   16469: 
1.1161    raeburn  16470: sub cleanup_html {
                   16471:     my ($incoming) = @_;
                   16472:     my $outgoing;
                   16473:     if ($incoming ne '') {
                   16474:         $outgoing = $incoming;
                   16475:         $outgoing =~ s/;/&#059;/g;
                   16476:         $outgoing =~ s/\#/&#035;/g;
                   16477:         $outgoing =~ s/\&/&#038;/g;
                   16478:         $outgoing =~ s/</&#060;/g;
                   16479:         $outgoing =~ s/>/&#062;/g;
                   16480:         $outgoing =~ s/\(/&#040/g;
                   16481:         $outgoing =~ s/\)/&#041;/g;
                   16482:         $outgoing =~ s/"/&#034;/g;
                   16483:         $outgoing =~ s/'/&#039;/g;
                   16484:         $outgoing =~ s/\$/&#036;/g;
                   16485:         $outgoing =~ s{/}{&#047;}g;
                   16486:         $outgoing =~ s/=/&#061;/g;
                   16487:         $outgoing =~ s/\\/&#092;/g
                   16488:     }
                   16489:     return $outgoing;
                   16490: }
                   16491: 
1.1190    musolffc 16492: # Checks for critical messages and returns a redirect url if one exists.
                   16493: # $interval indicates how often to check for messages.
                   16494: sub critical_redirect {
                   16495:     my ($interval) = @_;
                   16496:     if ((time-$env{'user.criticalcheck.time'})>$interval) {
                   16497:         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, 
                   16498:                                         $env{'user.name'});
                   16499:         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191    raeburn  16500:         my $redirecturl;
1.1190    musolffc 16501:         if ($what[0]) {
                   16502: 	    if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
                   16503: 	        $redirecturl='/adm/email?critical=display';
1.1191    raeburn  16504: 	        my $url=&Apache::lonnet::absolute_url().$redirecturl;
                   16505:                 return (1, $url);
1.1190    musolffc 16506:             }
1.1191    raeburn  16507:         }
                   16508:     } 
                   16509:     return ();
1.1190    musolffc 16510: }
                   16511: 
1.1174    raeburn  16512: # Use:
                   16513: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                   16514: #
                   16515: ##################################################
                   16516: #          password associated functions         #
                   16517: ##################################################
                   16518: sub des_keys {
                   16519:     # Make a new key for DES encryption.
                   16520:     # Each key has two parts which are returned separately.
                   16521:     # Please note:  Each key must be passed through the &hex function
                   16522:     # before it is output to the web browser.  The hex versions cannot
                   16523:     # be used to decrypt.
                   16524:     my @hexstr=('0','1','2','3','4','5','6','7',
                   16525:                 '8','9','a','b','c','d','e','f');
                   16526:     my $lkey='';
                   16527:     for (0..7) {
                   16528:         $lkey.=$hexstr[rand(15)];
                   16529:     }
                   16530:     my $ukey='';
                   16531:     for (0..7) {
                   16532:         $ukey.=$hexstr[rand(15)];
                   16533:     }
                   16534:     return ($lkey,$ukey);
                   16535: }
                   16536: 
                   16537: sub des_decrypt {
                   16538:     my ($key,$cyphertext) = @_;
                   16539:     my $keybin=pack("H16",$key);
                   16540:     my $cypher;
                   16541:     if ($Crypt::DES::VERSION>=2.03) {
                   16542:         $cypher=new Crypt::DES $keybin;
                   16543:     } else {
                   16544:         $cypher=new DES $keybin;
                   16545:     }
                   16546:     my $plaintext=
                   16547:         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
                   16548:     $plaintext.=
                   16549:         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
                   16550:     $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
                   16551:     return $plaintext;
                   16552: }
                   16553: 
1.112     bowersj2 16554: 1;
                   16555: __END__;
1.41      ng       16556: 

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