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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1291  ! raeburn     4: # $Id: loncommon.pm,v 1.1290 2017/08/11 18:58:16 raeburn Exp $
1.10      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.1       albertel   28: 
                     29: # Makes a table out of the previous attempts
1.2       albertel   30: # Inputs result_from_symbread, user, domain, course_id
1.16      harris41   31: # Reads in non-network-related .tab files
1.1       albertel   32: 
1.35      matthew    33: # POD header:
                     34: 
1.45      matthew    35: =pod
                     36: 
1.35      matthew    37: =head1 NAME
                     38: 
                     39: Apache::loncommon - pile of common routines
                     40: 
                     41: =head1 SYNOPSIS
                     42: 
1.112     bowersj2   43: Common routines for manipulating connections, student answers,
                     44:     domains, common Javascript fragments, etc.
1.35      matthew    45: 
1.112     bowersj2   46: =head1 OVERVIEW
1.35      matthew    47: 
1.112     bowersj2   48: A collection of commonly used subroutines that don't have a natural
                     49: home anywhere else. This collection helps remove
1.35      matthew    50: redundancy from other modules and increase efficiency of memory usage.
                     51: 
                     52: =cut 
                     53: 
                     54: # End of POD header
1.1       albertel   55: package Apache::loncommon;
                     56: 
                     57: use strict;
1.258     albertel   58: use Apache::lonnet;
1.46      matthew    59: use GDBM_File;
1.51      www        60: use POSIX qw(strftime mktime);
1.82      www        61: use Apache::lonmenu();
1.498     albertel   62: use Apache::lonenc();
1.117     www        63: use Apache::lonlocal;
1.685     tempelho   64: use Apache::lonnet();
1.139     matthew    65: use HTML::Entities;
1.334     albertel   66: use Apache::lonhtmlcommon();
                     67: use Apache::loncoursedata();
1.344     albertel   68: use Apache::lontexconvert();
1.444     albertel   69: use Apache::lonclonecourse();
1.1108    raeburn    70: use Apache::lonuserutils();
1.1110    raeburn    71: use Apache::lonuserstate();
1.1182    raeburn    72: use Apache::courseclassifier();
1.479     albertel   73: use LONCAPA qw(:DEFAULT :match);
1.1280    raeburn    74: use LONCAPA::LWPReq;
1.657     raeburn    75: use DateTime::TimeZone;
1.1241    raeburn    76: use DateTime::Locale;
1.1220    raeburn    77: use Encode();
1.1091    foxr       78: use Text::Aspell;
1.1094    raeburn    79: use Authen::Captcha;
                     80: use Captcha::reCAPTCHA;
1.1234    raeburn    81: use JSON::DWIW;
                     82: use LWP::UserAgent;
1.1174    raeburn    83: use Crypt::DES;
                     84: use DynaLoader; # for Crypt::DES version
1.1223    musolffc   85: use MIME::Lite;
                     86: use MIME::Types;
1.117     www        87: 
1.517     raeburn    88: # ---------------------------------------------- Designs
                     89: use vars qw(%defaultdesign);
                     90: 
1.22      www        91: my $readit;
                     92: 
1.517     raeburn    93: 
1.157     matthew    94: ##
                     95: ## Global Variables
                     96: ##
1.46      matthew    97: 
1.643     foxr       98: 
                     99: # ----------------------------------------------- SSI with retries:
                    100: #
                    101: 
                    102: =pod
                    103: 
1.648     raeburn   104: =head1 Server Side include with retries:
1.643     foxr      105: 
                    106: =over 4
                    107: 
1.648     raeburn   108: =item * &ssi_with_retries(resource,retries form)
1.643     foxr      109: 
                    110: Performs an ssi with some number of retries.  Retries continue either
                    111: until the result is ok or until the retry count supplied by the
                    112: caller is exhausted.  
                    113: 
                    114: Inputs:
1.648     raeburn   115: 
                    116: =over 4
                    117: 
1.643     foxr      118: resource   - Identifies the resource to insert.
1.648     raeburn   119: 
1.643     foxr      120: retries    - Count of the number of retries allowed.
1.648     raeburn   121: 
1.643     foxr      122: form       - Hash that identifies the rendering options.
                    123: 
1.648     raeburn   124: =back
                    125: 
                    126: Returns:
                    127: 
                    128: =over 4
                    129: 
1.643     foxr      130: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   131: 
1.643     foxr      132: response   - The response from the last attempt (which may or may not have been successful.
                    133: 
1.648     raeburn   134: =back
                    135: 
                    136: =back
                    137: 
1.643     foxr      138: =cut
                    139: 
                    140: sub ssi_with_retries {
                    141:     my ($resource, $retries, %form) = @_;
                    142: 
                    143: 
                    144:     my $ok = 0;			# True if we got a good response.
                    145:     my $content;
                    146:     my $response;
                    147: 
                    148:     # Try to get the ssi done. within the retries count:
                    149: 
                    150:     do {
                    151: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    152: 	$ok      = $response->is_success;
1.650     www       153:         if (!$ok) {
                    154:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    155:         }
1.643     foxr      156: 	$retries--;
                    157:     } while (!$ok && ($retries > 0));
                    158: 
                    159:     if (!$ok) {
                    160: 	$content = '';		# On error return an empty content.
                    161:     }
                    162:     return ($content, $response);
                    163: 
                    164: }
                    165: 
                    166: 
                    167: 
1.20      www       168: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  169: my %language;
1.124     www       170: my %supported_language;
1.1088    foxr      171: my %supported_codes;
1.1048    foxr      172: my %latex_language;		# For choosing hyphenation in <transl..>
                    173: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  174: my %cprtag;
1.192     taceyjo1  175: my %scprtag;
1.351     www       176: my %fe; my %fd; my %fm;
1.41      ng        177: my %category_extensions;
1.12      harris41  178: 
1.46      matthew   179: # ---------------------------------------------- Thesaurus variables
1.144     matthew   180: #
                    181: # %Keywords:
                    182: #      A hash used by &keyword to determine if a word is considered a keyword.
                    183: # $thesaurus_db_file 
                    184: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   185: 
                    186: my %Keywords;
                    187: my $thesaurus_db_file;
                    188: 
1.144     matthew   189: #
                    190: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    191: # thesaurus.tab, and filecategories.tab.
                    192: #
1.18      www       193: BEGIN {
1.46      matthew   194:     # Variable initialization
                    195:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    196:     #
1.22      www       197:     unless ($readit) {
1.12      harris41  198: # ------------------------------------------------------------------- languages
                    199:     {
1.158     raeburn   200:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    201:                                    '/language.tab';
                    202:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  203:             while (my $line = <$fh>) {
                    204:                 next if ($line=~/^\#/);
                    205:                 chomp($line);
1.1088    foxr      206:                 my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   207:                 $language{$key}=$val.' - '.$enc;
                    208:                 if ($sup) {
                    209:                     $supported_language{$key}=$sup;
1.1088    foxr      210: 		    $supported_codes{$key}   = $code;
1.158     raeburn   211:                 }
1.1048    foxr      212: 		if ($latex) {
                    213: 		    $latex_language_bykey{$key} = $latex;
1.1088    foxr      214: 		    $latex_language{$code} = $latex;
1.1048    foxr      215: 		}
1.158     raeburn   216:             }
                    217:             close($fh);
                    218:         }
1.12      harris41  219:     }
                    220: # ------------------------------------------------------------------ copyrights
                    221:     {
1.158     raeburn   222:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    223:                                   '/copyright.tab';
                    224:         if ( open (my $fh,"<$copyrightfile") ) {
1.356     albertel  225:             while (my $line = <$fh>) {
                    226:                 next if ($line=~/^\#/);
                    227:                 chomp($line);
                    228:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   229:                 $cprtag{$key}=$val;
                    230:             }
                    231:             close($fh);
                    232:         }
1.12      harris41  233:     }
1.351     www       234: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  235:     {
                    236:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    237:                                   '/source_copyright.tab';
                    238:         if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356     albertel  239:             while (my $line = <$fh>) {
                    240:                 next if ($line =~ /^\#/);
                    241:                 chomp($line);
                    242:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  243:                 $scprtag{$key}=$val;
                    244:             }
                    245:             close($fh);
                    246:         }
                    247:     }
1.63      www       248: 
1.517     raeburn   249: # -------------------------------------------------------------- default domain designs
1.63      www       250:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   251:     my $designfile = $designdir.'/default.tab';
                    252:     if ( open (my $fh,"<$designfile") ) {
                    253:         while (my $line = <$fh>) {
                    254:             next if ($line =~ /^\#/);
                    255:             chomp($line);
                    256:             my ($key,$val)=(split(/\=/,$line));
                    257:             if ($val) { $defaultdesign{$key}=$val; }
                    258:         }
                    259:         close($fh);
1.63      www       260:     }
                    261: 
1.15      harris41  262: # ------------------------------------------------------------- file categories
                    263:     {
1.158     raeburn   264:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    265:                                   '/filecategories.tab';
                    266:         if ( open (my $fh,"<$categoryfile") ) {
1.356     albertel  267: 	    while (my $line = <$fh>) {
                    268: 		next if ($line =~ /^\#/);
                    269: 		chomp($line);
                    270:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.1263    raeburn   271:                 push(@{$category_extensions{lc($category)}},$extension);
1.158     raeburn   272:             }
                    273:             close($fh);
                    274:         }
                    275: 
1.15      harris41  276:     }
1.12      harris41  277: # ------------------------------------------------------------------ file types
                    278:     {
1.158     raeburn   279:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    280:                '/filetypes.tab';
                    281:         if ( open (my $fh,"<$typesfile") ) {
1.356     albertel  282:             while (my $line = <$fh>) {
                    283: 		next if ($line =~ /^\#/);
                    284: 		chomp($line);
                    285:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   286:                 if ($descr ne '') {
                    287:                     $fe{$ending}=lc($emb);
                    288:                     $fd{$ending}=$descr;
1.351     www       289:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   290:                 }
                    291:             }
                    292:             close($fh);
                    293:         }
1.12      harris41  294:     }
1.22      www       295:     &Apache::lonnet::logthis(
1.705     tempelho  296:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       297:     $readit=1;
1.46      matthew   298:     }  # end of unless($readit) 
1.32      matthew   299:     
                    300: }
1.112     bowersj2  301: 
1.42      matthew   302: ###############################################################
                    303: ##           HTML and Javascript Helper Functions            ##
                    304: ###############################################################
                    305: 
                    306: =pod 
                    307: 
1.112     bowersj2  308: =head1 HTML and Javascript Functions
1.42      matthew   309: 
1.112     bowersj2  310: =over 4
                    311: 
1.648     raeburn   312: =item * &browser_and_searcher_javascript()
1.112     bowersj2  313: 
                    314: X<browsing, javascript>X<searching, javascript>Returns a string
                    315: containing javascript with two functions, C<openbrowser> and
                    316: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    317: tags.
1.42      matthew   318: 
1.648     raeburn   319: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   320: 
                    321: inputs: formname, elementname, only, omit
                    322: 
                    323: formname and elementname indicate the name of the html form and name of
                    324: the element that the results of the browsing selection are to be placed in. 
                    325: 
                    326: Specifying 'only' will restrict the browser to displaying only files
1.185     www       327: with the given extension.  Can be a comma separated list.
1.42      matthew   328: 
                    329: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       330: with the given extension.  Can be a comma separated list.
1.42      matthew   331: 
1.648     raeburn   332: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   333: 
                    334: Inputs: formname, elementname
                    335: 
                    336: formname and elementname specify the name of the html form and the name
                    337: of the element the selection from the search results will be placed in.
1.542     raeburn   338: 
1.42      matthew   339: =cut
                    340: 
                    341: sub browser_and_searcher_javascript {
1.199     albertel  342:     my ($mode)=@_;
                    343:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  344:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   345:     return <<END;
1.219     albertel  346: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   347:     var editbrowser = null;
1.135     albertel  348:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       349:         var url = '$resurl/?';
1.42      matthew   350:         if (editbrowser == null) {
                    351:             url += 'launch=1&';
                    352:         }
                    353:         url += 'catalogmode=interactive&';
1.199     albertel  354:         url += 'mode=$mode&';
1.611     albertel  355:         url += 'inhibitmenu=yes&';
1.42      matthew   356:         url += 'form=' + formname + '&';
                    357:         if (only != null) {
                    358:             url += 'only=' + only + '&';
1.217     albertel  359:         } else {
                    360:             url += 'only=&';
                    361: 	}
1.42      matthew   362:         if (omit != null) {
                    363:             url += 'omit=' + omit + '&';
1.217     albertel  364:         } else {
                    365:             url += 'omit=&';
                    366: 	}
1.135     albertel  367:         if (titleelement != null) {
                    368:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  369:         } else {
                    370: 	    url += 'titleelement=&';
                    371: 	}
1.42      matthew   372:         url += 'element=' + elementname + '';
                    373:         var title = 'Browser';
1.435     albertel  374:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   375:         options += ',width=700,height=600';
                    376:         editbrowser = open(url,title,options,'1');
                    377:         editbrowser.focus();
                    378:     }
                    379:     var editsearcher;
1.135     albertel  380:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   381:         var url = '/adm/searchcat?';
                    382:         if (editsearcher == null) {
                    383:             url += 'launch=1&';
                    384:         }
                    385:         url += 'catalogmode=interactive&';
1.199     albertel  386:         url += 'mode=$mode&';
1.42      matthew   387:         url += 'form=' + formname + '&';
1.135     albertel  388:         if (titleelement != null) {
                    389:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  390:         } else {
                    391: 	    url += 'titleelement=&';
                    392: 	}
1.42      matthew   393:         url += 'element=' + elementname + '';
                    394:         var title = 'Search';
1.435     albertel  395:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   396:         options += ',width=700,height=600';
                    397:         editsearcher = open(url,title,options,'1');
                    398:         editsearcher.focus();
                    399:     }
1.219     albertel  400: // END LON-CAPA Internal -->
1.42      matthew   401: END
1.170     www       402: }
                    403: 
                    404: sub lastresurl {
1.258     albertel  405:     if ($env{'environment.lastresurl'}) {
                    406: 	return $env{'environment.lastresurl'}
1.170     www       407:     } else {
                    408: 	return '/res';
                    409:     }
                    410: }
                    411: 
                    412: sub storeresurl {
                    413:     my $resurl=&Apache::lonnet::clutter(shift);
                    414:     unless ($resurl=~/^\/res/) { return 0; }
                    415:     $resurl=~s/\/$//;
                    416:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   417:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       418:     return 1;
1.42      matthew   419: }
                    420: 
1.74      www       421: sub studentbrowser_javascript {
1.111     www       422:    unless (
1.258     albertel  423:             (($env{'request.course.id'}) && 
1.302     albertel  424:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    425: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    426: 					  '/'.$env{'request.course.sec'})
                    427: 	      ))
1.258     albertel  428:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       429:           ) { return ''; }  
1.74      www       430:    return (<<'ENDSTDBRW');
1.776     bisitz    431: <script type="text/javascript" language="Javascript">
1.824     bisitz    432: // <![CDATA[
1.74      www       433:     var stdeditbrowser;
1.999     www       434:     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74      www       435:         var url = '/adm/pickstudent?';
                    436:         var filter;
1.558     albertel  437: 	if (!ignorefilter) {
                    438: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    439: 	}
1.74      www       440:         if (filter != null) {
                    441:            if (filter != '') {
                    442:                url += 'filter='+filter+'&';
                    443: 	   }
                    444:         }
                    445:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       446:                                     '&udomelement='+udom+
                    447:                                     '&clicker='+clicker;
1.111     www       448: 	if (roleflag) { url+="&roles=1"; }
1.793     raeburn   449:         if (courseadvonly) { url+="&courseadvonly=1"; }
1.102     www       450:         var title = 'Student_Browser';
1.74      www       451:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    452:         options += ',width=700,height=600';
                    453:         stdeditbrowser = open(url,title,options,'1');
                    454:         stdeditbrowser.focus();
                    455:     }
1.824     bisitz    456: // ]]>
1.74      www       457: </script>
                    458: ENDSTDBRW
                    459: }
1.42      matthew   460: 
1.1003    www       461: sub resourcebrowser_javascript {
                    462:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       463:    return (<<'ENDRESBRW');
1.1003    www       464: <script type="text/javascript" language="Javascript">
                    465: // <![CDATA[
                    466:     var reseditbrowser;
1.1004    www       467:     function openresbrowser(formname,reslink) {
1.1005    www       468:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       469:         var title = 'Resource_Browser';
                    470:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       471:         options += ',width=700,height=500';
1.1004    www       472:         reseditbrowser = open(url,title,options,'1');
                    473:         reseditbrowser.focus();
1.1003    www       474:     }
                    475: // ]]>
                    476: </script>
1.1004    www       477: ENDRESBRW
1.1003    www       478: }
                    479: 
1.74      www       480: sub selectstudent_link {
1.999     www       481:    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
                    482:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    483:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    484:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  485:    if ($env{'request.course.id'}) {  
1.302     albertel  486:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    487: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    488: 					'/'.$env{'request.course.sec'})) {
1.111     www       489: 	   return '';
                    490:        }
1.999     www       491:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793     raeburn   492:        if ($courseadvonly)  {
                    493:            $callargs .= ",'',1,1";
                    494:        }
                    495:        return '<span class="LC_nobreak">'.
                    496:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    497:               &mt('Select User').'</a></span>';
1.74      www       498:    }
1.258     albertel  499:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       500:        $callargs .= ",'',1"; 
1.793     raeburn   501:        return '<span class="LC_nobreak">'.
                    502:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    503:               &mt('Select User').'</a></span>';
1.111     www       504:    }
                    505:    return '';
1.91      www       506: }
                    507: 
1.1004    www       508: sub selectresource_link {
                    509:    my ($form,$reslink,$arg)=@_;
                    510:    
                    511:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    512:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    513:    unless ($env{'request.course.id'}) { return $arg; }
                    514:    return '<span class="LC_nobreak">'.
                    515:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    516:               $arg.'</a></span>';
                    517: }
                    518: 
                    519: 
                    520: 
1.653     raeburn   521: sub authorbrowser_javascript {
                    522:     return <<"ENDAUTHORBRW";
1.776     bisitz    523: <script type="text/javascript" language="JavaScript">
1.824     bisitz    524: // <![CDATA[
1.653     raeburn   525: var stdeditbrowser;
                    526: 
                    527: function openauthorbrowser(formname,udom) {
                    528:     var url = '/adm/pickauthor?';
                    529:     url += 'form='+formname+'&roledom='+udom;
                    530:     var title = 'Author_Browser';
                    531:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    532:     options += ',width=700,height=600';
                    533:     stdeditbrowser = open(url,title,options,'1');
                    534:     stdeditbrowser.focus();
                    535: }
                    536: 
1.824     bisitz    537: // ]]>
1.653     raeburn   538: </script>
                    539: ENDAUTHORBRW
                    540: }
                    541: 
1.91      www       542: sub coursebrowser_javascript {
1.1116    raeburn   543:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1221    raeburn   544:         $credits_element,$instcode) = @_;
1.932     raeburn   545:     my $wintitle = 'Course_Browser';
1.931     raeburn   546:     if ($crstype eq 'Community') {
1.932     raeburn   547:         $wintitle = 'Community_Browser';
1.909     raeburn   548:     }
1.876     raeburn   549:     my $id_functions = &javascript_index_functions();
                    550:     my $output = '
1.776     bisitz    551: <script type="text/javascript" language="JavaScript">
1.824     bisitz    552: // <![CDATA[
1.468     raeburn   553:     var stdeditbrowser;'."\n";
1.876     raeburn   554: 
                    555:     $output .= <<"ENDSTDBRW";
1.909     raeburn   556:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       557:         var url = '/adm/pickcourse?';
1.895     raeburn   558:         var formid = getFormIdByName(formname);
1.876     raeburn   559:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  560:         if (domainfilter != null) {
                    561:            if (domainfilter != '') {
                    562:                url += 'domainfilter='+domainfilter+'&';
                    563: 	   }
                    564:         }
1.91      www       565:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  566: 	                            '&cdomelement='+udom+
                    567:                                     '&cnameelement='+desc;
1.468     raeburn   568:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   569:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   570:                 url += '&roleelement='+extra_element;
                    571:                 if (domainfilter == null || domainfilter == '') {
                    572:                     url += '&domainfilter='+extra_element;
                    573:                 }
1.234     raeburn   574:             }
1.468     raeburn   575:             else {
                    576:                 if (formname == 'portform') {
                    577:                     url += '&setroles='+extra_element;
1.800     raeburn   578:                 } else {
                    579:                     if (formname == 'rules') {
                    580:                         url += '&fixeddom='+extra_element; 
                    581:                     }
1.468     raeburn   582:                 }
                    583:             }     
1.230     raeburn   584:         }
1.909     raeburn   585:         if (type != null && type != '') {
                    586:             url += '&type='+type;
                    587:         }
                    588:         if (type_elem != null && type_elem != '') {
                    589:             url += '&typeelement='+type_elem;
                    590:         }
1.872     raeburn   591:         if (formname == 'ccrs') {
                    592:             var ownername = document.forms[formid].ccuname.value;
                    593:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1238    raeburn   594:             url += '&cloner='+ownername+':'+ownerdom;
                    595:             if (type == 'Course') {
                    596:                 url += '&crscode='+document.forms[formid].crscode.value;
                    597:             }
1.1221    raeburn   598:         }
                    599:         if (formname == 'requestcrs') {
                    600:             url += '&crsdom=$domainfilter&crscode=$instcode';
1.872     raeburn   601:         }
1.293     raeburn   602:         if (multflag !=null && multflag != '') {
                    603:             url += '&multiple='+multflag;
                    604:         }
1.909     raeburn   605:         var title = '$wintitle';
1.91      www       606:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    607:         options += ',width=700,height=600';
                    608:         stdeditbrowser = open(url,title,options,'1');
                    609:         stdeditbrowser.focus();
                    610:     }
1.876     raeburn   611: $id_functions
                    612: ENDSTDBRW
1.1116    raeburn   613:     if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
                    614:         $output .= &setsec_javascript($sec_element,$formname,$role_element,
                    615:                                       $credits_element);
1.876     raeburn   616:     }
                    617:     $output .= '
                    618: // ]]>
                    619: </script>';
                    620:     return $output;
                    621: }
                    622: 
                    623: sub javascript_index_functions {
                    624:     return <<"ENDJS";
                    625: 
                    626: function getFormIdByName(formname) {
                    627:     for (var i=0;i<document.forms.length;i++) {
                    628:         if (document.forms[i].name == formname) {
                    629:             return i;
                    630:         }
                    631:     }
                    632:     return -1;
                    633: }
                    634: 
                    635: function getIndexByName(formid,item) {
                    636:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    637:         if (document.forms[formid].elements[i].name == item) {
                    638:             return i;
                    639:         }
                    640:     }
                    641:     return -1;
                    642: }
1.468     raeburn   643: 
1.876     raeburn   644: function getDomainFromSelectbox(formname,udom) {
                    645:     var userdom;
                    646:     var formid = getFormIdByName(formname);
                    647:     if (formid > -1) {
                    648:         var domid = getIndexByName(formid,udom);
                    649:         if (domid > -1) {
                    650:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    651:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    652:             }
                    653:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    654:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   655:             }
                    656:         }
                    657:     }
1.876     raeburn   658:     return userdom;
                    659: }
                    660: 
                    661: ENDJS
1.468     raeburn   662: 
1.876     raeburn   663: }
                    664: 
1.1017    raeburn   665: sub javascript_array_indexof {
1.1018    raeburn   666:     return <<ENDJS;
1.1017    raeburn   667: <script type="text/javascript" language="JavaScript">
                    668: // <![CDATA[
                    669: 
                    670: if (!Array.prototype.indexOf) {
                    671:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    672:         "use strict";
                    673:         if (this === void 0 || this === null) {
                    674:             throw new TypeError();
                    675:         }
                    676:         var t = Object(this);
                    677:         var len = t.length >>> 0;
                    678:         if (len === 0) {
                    679:             return -1;
                    680:         }
                    681:         var n = 0;
                    682:         if (arguments.length > 0) {
                    683:             n = Number(arguments[1]);
1.1088    foxr      684:             if (n !== n) { // shortcut for verifying if it is NaN
1.1017    raeburn   685:                 n = 0;
                    686:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    687:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    688:             }
                    689:         }
                    690:         if (n >= len) {
                    691:             return -1;
                    692:         }
                    693:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    694:         for (; k < len; k++) {
                    695:             if (k in t && t[k] === searchElement) {
                    696:                 return k;
                    697:             }
                    698:         }
                    699:         return -1;
                    700:     }
                    701: }
                    702: 
                    703: // ]]>
                    704: </script>
                    705: 
                    706: ENDJS
                    707: 
                    708: }
                    709: 
1.876     raeburn   710: sub userbrowser_javascript {
                    711:     my $id_functions = &javascript_index_functions();
                    712:     return <<"ENDUSERBRW";
                    713: 
1.888     raeburn   714: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   715:     var url = '/adm/pickuser?';
                    716:     var userdom = getDomainFromSelectbox(formname,udom);
                    717:     if (userdom != null) {
                    718:        if (userdom != '') {
                    719:            url += 'srchdom='+userdom+'&';
                    720:        }
                    721:     }
                    722:     url += 'form=' + formname + '&unameelement='+uname+
                    723:                                 '&udomelement='+udom+
                    724:                                 '&ulastelement='+ulast+
                    725:                                 '&ufirstelement='+ufirst+
                    726:                                 '&uemailelement='+uemail+
1.881     raeburn   727:                                 '&hideudomelement='+hideudom+
                    728:                                 '&coursedom='+crsdom;
1.888     raeburn   729:     if ((caller != null) && (caller != undefined)) {
                    730:         url += '&caller='+caller;
                    731:     }
1.876     raeburn   732:     var title = 'User_Browser';
                    733:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    734:     options += ',width=700,height=600';
                    735:     var stdeditbrowser = open(url,title,options,'1');
                    736:     stdeditbrowser.focus();
                    737: }
                    738: 
1.888     raeburn   739: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   740:     var formid = getFormIdByName(formname);
                    741:     if (formid > -1) {
1.888     raeburn   742:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   743:         var domid = getIndexByName(formid,udom);
                    744:         var hidedomid = getIndexByName(formid,origdom);
                    745:         if (hidedomid > -1) {
                    746:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   747:             var unameval = document.forms[formid].elements[unameid].value;
                    748:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    749:                 if (domid > -1) {
                    750:                     var slct = document.forms[formid].elements[domid];
                    751:                     if (slct.type == 'select-one') {
                    752:                         var i;
                    753:                         for (i=0;i<slct.length;i++) {
                    754:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    755:                         }
                    756:                     }
                    757:                     if (slct.type == 'hidden') {
                    758:                         slct.value = fixeddom;
1.876     raeburn   759:                     }
                    760:                 }
1.468     raeburn   761:             }
                    762:         }
                    763:     }
1.876     raeburn   764:     return;
                    765: }
                    766: 
                    767: $id_functions
                    768: ENDUSERBRW
1.468     raeburn   769: }
                    770: 
                    771: sub setsec_javascript {
1.1116    raeburn   772:     my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905     raeburn   773:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    774:         $communityrolestr);
                    775:     if ($role_element ne '') {
                    776:         my @allroles = ('st','ta','ep','in','ad');
                    777:         foreach my $crstype ('Course','Community') {
                    778:             if ($crstype eq 'Community') {
                    779:                 foreach my $role (@allroles) {
                    780:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    781:                 }
                    782:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    783:             } else {
                    784:                 foreach my $role (@allroles) {
                    785:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    786:                 }
                    787:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    788:             }
                    789:         }
                    790:         $rolestr = '"'.join('","',@allroles).'"';
                    791:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    792:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    793:     }
1.468     raeburn   794:     my $setsections = qq|
                    795: function setSect(sectionlist) {
1.629     raeburn   796:     var sectionsArray = new Array();
                    797:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    798:         sectionsArray = sectionlist.split(",");
                    799:     }
1.468     raeburn   800:     var numSections = sectionsArray.length;
                    801:     document.$formname.$sec_element.length = 0;
                    802:     if (numSections == 0) {
                    803:         document.$formname.$sec_element.multiple=false;
                    804:         document.$formname.$sec_element.size=1;
                    805:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    806:     } else {
                    807:         if (numSections == 1) {
                    808:             document.$formname.$sec_element.multiple=false;
                    809:             document.$formname.$sec_element.size=1;
                    810:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    811:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    812:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    813:         } else {
                    814:             for (var i=0; i<numSections; i++) {
                    815:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    816:             }
                    817:             document.$formname.$sec_element.multiple=true
                    818:             if (numSections < 3) {
                    819:                 document.$formname.$sec_element.size=numSections;
                    820:             } else {
                    821:                 document.$formname.$sec_element.size=3;
                    822:             }
                    823:             document.$formname.$sec_element.options[0].selected = false
                    824:         }
                    825:     }
1.91      www       826: }
1.905     raeburn   827: 
                    828: function setRole(crstype) {
1.468     raeburn   829: |;
1.905     raeburn   830:     if ($role_element eq '') {
                    831:         $setsections .= '    return;
                    832: }
                    833: ';
                    834:     } else {
                    835:         $setsections .= qq|
                    836:     var elementLength = document.$formname.$role_element.length;
                    837:     var allroles = Array($rolestr);
                    838:     var courserolenames = Array($courserolestr);
                    839:     var communityrolenames = Array($communityrolestr);
                    840:     if (elementLength != undefined) {
                    841:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    842:             if (crstype == 'Course') {
                    843:                 return;
                    844:             } else {
                    845:                 allroles[5] = 'co';
                    846:                 for (var i=0; i<6; i++) {
                    847:                     document.$formname.$role_element.options[i].value = allroles[i];
                    848:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    849:                 }
                    850:             }
                    851:         } else {
                    852:             if (crstype == 'Community') {
                    853:                 return;
                    854:             } else {
                    855:                 allroles[5] = 'cc';
                    856:                 for (var i=0; i<6; i++) {
                    857:                     document.$formname.$role_element.options[i].value = allroles[i];
                    858:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    859:                 }
                    860:             }
                    861:         }
                    862:     }
                    863:     return;
                    864: }
                    865: |;
                    866:     }
1.1116    raeburn   867:     if ($credits_element) {
                    868:         $setsections .= qq|
                    869: function setCredits(defaultcredits) {
                    870:     document.$formname.$credits_element.value = defaultcredits;
                    871:     return;
                    872: }
                    873: |;
                    874:     }
1.468     raeburn   875:     return $setsections;
                    876: }
                    877: 
1.91      www       878: sub selectcourse_link {
1.909     raeburn   879:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    880:        $typeelement) = @_;
                    881:    my $type = $selecttype;
1.871     raeburn   882:    my $linktext = &mt('Select Course');
                    883:    if ($selecttype eq 'Community') {
1.909     raeburn   884:        $linktext = &mt('Select Community');
1.1239    raeburn   885:    } elsif ($selecttype eq 'Placement') {
                    886:        $linktext = &mt('Select Placement Test'); 
1.906     raeburn   887:    } elsif ($selecttype eq 'Course/Community') {
                    888:        $linktext = &mt('Select Course/Community');
1.909     raeburn   889:        $type = '';
1.1019    raeburn   890:    } elsif ($selecttype eq 'Select') {
                    891:        $linktext = &mt('Select');
                    892:        $type = '';
1.871     raeburn   893:    }
1.787     bisitz    894:    return '<span class="LC_nobreak">'
                    895:          ."<a href='"
                    896:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    897:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   898:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   899:          ."'>".$linktext.'</a>'
1.787     bisitz    900:          .'</span>';
1.74      www       901: }
1.42      matthew   902: 
1.653     raeburn   903: sub selectauthor_link {
                    904:    my ($form,$udom)=@_;
                    905:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    906:           &mt('Select Author').'</a>';
                    907: }
                    908: 
1.876     raeburn   909: sub selectuser_link {
1.881     raeburn   910:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   911:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   912:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   913:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   914:            ');">'.$linktext.'</a>';
1.876     raeburn   915: }
                    916: 
1.273     raeburn   917: sub check_uncheck_jscript {
                    918:     my $jscript = <<"ENDSCRT";
                    919: function checkAll(field) {
                    920:     if (field.length > 0) {
                    921:         for (i = 0; i < field.length; i++) {
1.1093    raeburn   922:             if (!field[i].disabled) { 
                    923:                 field[i].checked = true;
                    924:             }
1.273     raeburn   925:         }
                    926:     } else {
1.1093    raeburn   927:         if (!field.disabled) { 
                    928:             field.checked = true;
                    929:         }
1.273     raeburn   930:     }
                    931: }
                    932:  
                    933: function uncheckAll(field) {
                    934:     if (field.length > 0) {
                    935:         for (i = 0; i < field.length; i++) {
                    936:             field[i].checked = false ;
1.543     albertel  937:         }
                    938:     } else {
1.273     raeburn   939:         field.checked = false ;
                    940:     }
                    941: }
                    942: ENDSCRT
                    943:     return $jscript;
                    944: }
                    945: 
1.656     www       946: sub select_timezone {
1.1256    raeburn   947:    my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
                    948:    my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.659     raeburn   949:    if ($includeempty) {
                    950:        $output .= '<option value=""';
                    951:        if (($selected eq '') || ($selected eq 'local')) {
                    952:            $output .= ' selected="selected" ';
                    953:        }
                    954:        $output .= '> </option>';
                    955:    }
1.657     raeburn   956:    my @timezones = DateTime::TimeZone->all_names;
                    957:    foreach my $tzone (@timezones) {
                    958:        $output.= '<option value="'.$tzone.'"';
                    959:        if ($tzone eq $selected) {
                    960:            $output.=' selected="selected"';
                    961:        }
                    962:        $output.=">$tzone</option>\n";
1.656     www       963:    }
                    964:    $output.="</select>";
                    965:    return $output;
                    966: }
1.273     raeburn   967: 
1.687     raeburn   968: sub select_datelocale {
1.1256    raeburn   969:     my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
                    970:     my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.687     raeburn   971:     if ($includeempty) {
                    972:         $output .= '<option value=""';
                    973:         if ($selected eq '') {
                    974:             $output .= ' selected="selected" ';
                    975:         }
                    976:         $output .= '> </option>';
                    977:     }
1.1241    raeburn   978:     my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   979:     my (@possibles,%locale_names);
1.1241    raeburn   980:     my @locales = DateTime::Locale->ids();
                    981:     foreach my $id (@locales) {
                    982:         if ($id ne '') {
                    983:             my ($en_terr,$native_terr);
                    984:             my $loc = DateTime::Locale->load($id);
                    985:             if (ref($loc)) {
                    986:                 $en_terr = $loc->name();
                    987:                 $native_terr = $loc->native_name();
1.687     raeburn   988:                 if (grep(/^en$/,@languages) || !@languages) {
                    989:                     if ($en_terr ne '') {
                    990:                         $locale_names{$id} = '('.$en_terr.')';
                    991:                     } elsif ($native_terr ne '') {
                    992:                         $locale_names{$id} = $native_terr;
                    993:                     }
                    994:                 } else {
                    995:                     if ($native_terr ne '') {
                    996:                         $locale_names{$id} = $native_terr.' ';
                    997:                     } elsif ($en_terr ne '') {
                    998:                         $locale_names{$id} = '('.$en_terr.')';
                    999:                     }
                   1000:                 }
1.1220    raeburn  1001:                 $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1241    raeburn  1002:                 push(@possibles,$id);
                   1003:             } 
1.687     raeburn  1004:         }
                   1005:     }
                   1006:     foreach my $item (sort(@possibles)) {
                   1007:         $output.= '<option value="'.$item.'"';
                   1008:         if ($item eq $selected) {
                   1009:             $output.=' selected="selected"';
                   1010:         }
                   1011:         $output.=">$item";
                   1012:         if ($locale_names{$item} ne '') {
1.1220    raeburn  1013:             $output.='  '.$locale_names{$item};
1.687     raeburn  1014:         }
                   1015:         $output.="</option>\n";
                   1016:     }
                   1017:     $output.="</select>";
                   1018:     return $output;
                   1019: }
                   1020: 
1.792     raeburn  1021: sub select_language {
1.1256    raeburn  1022:     my ($name,$selected,$includeempty,$noedit) = @_;
1.792     raeburn  1023:     my %langchoices;
                   1024:     if ($includeempty) {
1.1117    raeburn  1025:         %langchoices = ('' => 'No language preference');
1.792     raeburn  1026:     }
                   1027:     foreach my $id (&languageids()) {
                   1028:         my $code = &supportedlanguagecode($id);
                   1029:         if ($code) {
                   1030:             $langchoices{$code} = &plainlanguagedescription($id);
                   1031:         }
                   1032:     }
1.1117    raeburn  1033:     %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.1256    raeburn  1034:     return &select_form($selected,$name,\%langchoices,undef,$noedit);
1.792     raeburn  1035: }
                   1036: 
1.42      matthew  1037: =pod
1.36      matthew  1038: 
1.1088    foxr     1039: 
                   1040: =item * &list_languages()
                   1041: 
                   1042: Returns an array reference that is suitable for use in language prompters.
                   1043: Each array element is itself a two element array.  The first element
                   1044: is the language code.  The second element a descsriptiuon of the 
                   1045: language itself.  This is suitable for use in e.g.
                   1046: &Apache::edit::select_arg (once dereferenced that is).
                   1047: 
                   1048: =cut 
                   1049: 
                   1050: sub list_languages {
                   1051:     my @lang_choices;
                   1052: 
                   1053:     foreach my $id (&languageids()) {
                   1054: 	my $code = &supportedlanguagecode($id);
                   1055: 	if ($code) {
                   1056: 	    my $selector    = $supported_codes{$id};
                   1057: 	    my $description = &plainlanguagedescription($id);
1.1263    raeburn  1058: 	    push(@lang_choices, [$selector, $description]);
1.1088    foxr     1059: 	}
                   1060:     }
                   1061:     return \@lang_choices;
                   1062: }
                   1063: 
                   1064: =pod
                   1065: 
1.648     raeburn  1066: =item * &linked_select_forms(...)
1.36      matthew  1067: 
                   1068: linked_select_forms returns a string containing a <script></script> block
                   1069: and html for two <select> menus.  The select menus will be linked in that
                   1070: changing the value of the first menu will result in new values being placed
                   1071: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1072: order unless a defined order is provided.
1.36      matthew  1073: 
                   1074: linked_select_forms takes the following ordered inputs:
                   1075: 
                   1076: =over 4
                   1077: 
1.112     bowersj2 1078: =item * $formname, the name of the <form> tag
1.36      matthew  1079: 
1.112     bowersj2 1080: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1081: 
1.112     bowersj2 1082: =item * $firstdefault, the default value for the first menu
1.36      matthew  1083: 
1.112     bowersj2 1084: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1085: 
1.112     bowersj2 1086: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1087: 
1.112     bowersj2 1088: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1089: 
1.609     raeburn  1090: =item * $menuorder, the order of values in the first menu
                   1091: 
1.1115    raeburn  1092: =item * $onchangefirst, additional javascript call to execute for an onchange
                   1093:         event for the first <select> tag
                   1094: 
                   1095: =item * $onchangesecond, additional javascript call to execute for an onchange
                   1096:         event for the second <select> tag
                   1097: 
1.1245    raeburn  1098: =item * $suffix, to differentiate separate uses of select2data javascript
                   1099:         objects in a page.
                   1100: 
1.41      ng       1101: =back 
                   1102: 
1.36      matthew  1103: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1104: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1105: values for the first select menu.  The text that coincides with the 
1.41      ng       1106: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1107: and text for the second menu are given in the hash pointed to by 
                   1108: $menu{$choice1}->{'select2'}.  
                   1109: 
1.112     bowersj2 1110:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1111:                        default => "B3",
                   1112:                        select2 => { 
                   1113:                            B1 => "Choice B1",
                   1114:                            B2 => "Choice B2",
                   1115:                            B3 => "Choice B3",
                   1116:                            B4 => "Choice B4"
1.609     raeburn  1117:                            },
                   1118:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1119:                    },
                   1120:                A2 => { text =>"Choice A2" ,
                   1121:                        default => "C2",
                   1122:                        select2 => { 
                   1123:                            C1 => "Choice C1",
                   1124:                            C2 => "Choice C2",
                   1125:                            C3 => "Choice C3"
1.609     raeburn  1126:                            },
                   1127:                        order => ['C2','C1','C3'],
1.112     bowersj2 1128:                    },
                   1129:                A3 => { text =>"Choice A3" ,
                   1130:                        default => "D6",
                   1131:                        select2 => { 
                   1132:                            D1 => "Choice D1",
                   1133:                            D2 => "Choice D2",
                   1134:                            D3 => "Choice D3",
                   1135:                            D4 => "Choice D4",
                   1136:                            D5 => "Choice D5",
                   1137:                            D6 => "Choice D6",
                   1138:                            D7 => "Choice D7"
1.609     raeburn  1139:                            },
                   1140:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1141:                    }
                   1142:                );
1.36      matthew  1143: 
                   1144: =cut
                   1145: 
                   1146: sub linked_select_forms {
                   1147:     my ($formname,
                   1148:         $middletext,
                   1149:         $firstdefault,
                   1150:         $firstselectname,
                   1151:         $secondselectname, 
1.609     raeburn  1152:         $hashref,
                   1153:         $menuorder,
1.1115    raeburn  1154:         $onchangefirst,
1.1245    raeburn  1155:         $onchangesecond,
                   1156:         $suffix
1.36      matthew  1157:         ) = @_;
                   1158:     my $second = "document.$formname.$secondselectname";
                   1159:     my $first = "document.$formname.$firstselectname";
                   1160:     # output the javascript to do the changing
                   1161:     my $result = '';
1.776     bisitz   1162:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1163:     $result.="// <![CDATA[\n";
1.1245    raeburn  1164:     $result.="var select2data${suffix} = new Object();\n";
1.36      matthew  1165:     $" = '","';
                   1166:     my $debug = '';
                   1167:     foreach my $s1 (sort(keys(%$hashref))) {
1.1245    raeburn  1168:         $result.="select2data${suffix}['d_$s1'] = new Object();\n";        
                   1169:         $result.="select2data${suffix}['d_$s1'].def = new String('".
1.36      matthew  1170:             $hashref->{$s1}->{'default'}."');\n";
1.1245    raeburn  1171:         $result.="select2data${suffix}['d_$s1'].values = new Array(";
1.36      matthew  1172:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1173:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1174:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1175:         }
1.36      matthew  1176:         $result.="\"@s2values\");\n";
1.1245    raeburn  1177:         $result.="select2data${suffix}['d_$s1'].texts = new Array(";        
1.36      matthew  1178:         my @s2texts;
                   1179:         foreach my $value (@s2values) {
1.1263    raeburn  1180:             push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
1.36      matthew  1181:         }
                   1182:         $result.="\"@s2texts\");\n";
                   1183:     }
                   1184:     $"=' ';
                   1185:     $result.= <<"END";
                   1186: 
1.1245    raeburn  1187: function select1${suffix}_changed() {
1.36      matthew  1188:     // Determine new choice
1.1245    raeburn  1189:     var newvalue = "d_" + $first.options[$first.selectedIndex].value;
1.36      matthew  1190:     // update select2
1.1245    raeburn  1191:     var values     = select2data${suffix}[newvalue].values;
                   1192:     var texts      = select2data${suffix}[newvalue].texts;
                   1193:     var select2def = select2data${suffix}[newvalue].def;
1.36      matthew  1194:     var i;
                   1195:     // out with the old
1.1245    raeburn  1196:     $second.options.length = 0;
                   1197:     // in with the new
1.36      matthew  1198:     for (i=0;i<values.length; i++) {
                   1199:         $second.options[i] = new Option(values[i]);
1.143     matthew  1200:         $second.options[i].value = values[i];
1.36      matthew  1201:         $second.options[i].text = texts[i];
                   1202:         if (values[i] == select2def) {
                   1203:             $second.options[i].selected = true;
                   1204:         }
                   1205:     }
                   1206: }
1.824     bisitz   1207: // ]]>
1.36      matthew  1208: </script>
                   1209: END
                   1210:     # output the initial values for the selection lists
1.1245    raeburn  1211:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1${suffix}_changed();$onchangefirst\">\n";
1.609     raeburn  1212:     my @order = sort(keys(%{$hashref}));
                   1213:     if (ref($menuorder) eq 'ARRAY') {
                   1214:         @order = @{$menuorder};
                   1215:     }
                   1216:     foreach my $value (@order) {
1.36      matthew  1217:         $result.="    <option value=\"$value\" ";
1.253     albertel 1218:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1219:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1220:     }
                   1221:     $result .= "</select>\n";
                   1222:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1223:     $result .= $middletext;
1.1115    raeburn  1224:     $result .= "<select size=\"1\" name=\"$secondselectname\"";
                   1225:     if ($onchangesecond) {
                   1226:         $result .= ' onchange="'.$onchangesecond.'"';
                   1227:     }
                   1228:     $result .= ">\n";
1.36      matthew  1229:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1230:     
                   1231:     my @secondorder = sort(keys(%select2));
                   1232:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1233:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1234:     }
                   1235:     foreach my $value (@secondorder) {
1.36      matthew  1236:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1237:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1238:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1239:     }
                   1240:     $result .= "</select>\n";
                   1241:     #    return $debug;
                   1242:     return $result;
                   1243: }   #  end of sub linked_select_forms {
                   1244: 
1.45      matthew  1245: =pod
1.44      bowersj2 1246: 
1.973     raeburn  1247: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1248: 
1.112     bowersj2 1249: Returns a string corresponding to an HTML link to the given help
                   1250: $topic, where $topic corresponds to the name of a .tex file in
                   1251: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1252: spaces. 
                   1253: 
                   1254: $text will optionally be linked to the same topic, allowing you to
                   1255: link text in addition to the graphic. If you do not want to link
                   1256: text, but wish to specify one of the later parameters, pass an
                   1257: empty string. 
                   1258: 
                   1259: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1260: the link will not open a new window. If false, the link will open
                   1261: a new window using Javascript. (Default is false.) 
                   1262: 
                   1263: $width and $height are optional numerical parameters that will
                   1264: override the width and height of the popped up window, which may
1.973     raeburn  1265: be useful for certain help topics with big pictures included.
                   1266: 
                   1267: $imgid is the id of the img tag used for the help icon. This may be
                   1268: used in a javascript call to switch the image src.  See 
                   1269: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1270: 
                   1271: =cut
                   1272: 
                   1273: sub help_open_topic {
1.973     raeburn  1274:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1275:     $text = "" if (not defined $text);
1.44      bowersj2 1276:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1277:     $width = 500 if (not defined $width);
1.44      bowersj2 1278:     $height = 400 if (not defined $height);
                   1279:     my $filename = $topic;
                   1280:     $filename =~ s/ /_/g;
                   1281: 
1.48      bowersj2 1282:     my $template = "";
                   1283:     my $link;
1.572     banghart 1284:     
1.159     www      1285:     $topic=~s/\W/\_/g;
1.44      bowersj2 1286: 
1.572     banghart 1287:     if (!$stayOnPage) {
1.1033    www      1288: 	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037    www      1289:     } elsif ($stayOnPage eq 'popup') {
                   1290:         $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 1291:     } else {
1.48      bowersj2 1292: 	$link = "/adm/help/${filename}.hlp";
                   1293:     }
                   1294: 
                   1295:     # Add the text
1.755     neumanie 1296:     if ($text ne "") {	
1.763     bisitz   1297: 	$template.='<span class="LC_help_open_topic">'
                   1298:                   .'<a target="_top" href="'.$link.'">'
                   1299:                   .$text.'</a>';
1.48      bowersj2 1300:     }
                   1301: 
1.763     bisitz   1302:     # (Always) Add the graphic
1.179     matthew  1303:     my $title = &mt('Online Help');
1.667     raeburn  1304:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1305:     if ($imgid ne '') {
                   1306:         $imgid = ' id="'.$imgid.'"';
                   1307:     }
1.763     bisitz   1308:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1309:               .'<img src="'.$helpicon.'" border="0"'
                   1310:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1311:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1312:               .' /></a>';
                   1313:     if ($text ne "") {	
                   1314:         $template.='</span>';
                   1315:     }
1.44      bowersj2 1316:     return $template;
                   1317: 
1.106     bowersj2 1318: }
                   1319: 
                   1320: # This is a quicky function for Latex cheatsheet editing, since it 
                   1321: # appears in at least four places
                   1322: sub helpLatexCheatsheet {
1.1037    www      1323:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1324:     my $out;
1.106     bowersj2 1325:     my $addOther = '';
1.732     raeburn  1326:     if ($topic) {
1.1037    www      1327: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1328:     }
                   1329:     $out = '<span>' # Start cheatsheet
                   1330: 	  .$addOther
                   1331:           .'<span>'
1.1037    www      1332: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1333: 	  .'</span> <span>'
1.1037    www      1334: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1335: 	  .'</span>';
1.732     raeburn  1336:     unless ($not_author) {
1.1186    kruse    1337:         $out .= '<span>'
                   1338:                .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
                   1339:                .'</span> <span>'
                   1340:                .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763     bisitz   1341: 	       .'</span>';
1.732     raeburn  1342:     }
1.763     bisitz   1343:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1344:     return $out;
1.172     www      1345: }
                   1346: 
1.430     albertel 1347: sub general_help {
                   1348:     my $helptopic='Student_Intro';
                   1349:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1350: 	$helptopic='Authoring_Intro';
1.907     raeburn  1351:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1352: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1353:     } elsif ($env{'request.role'}=~/^dc/) {
                   1354:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1355:     }
                   1356:     return $helptopic;
                   1357: }
                   1358: 
                   1359: sub update_help_link {
                   1360:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1361:     my $origurl = $ENV{'REQUEST_URI'};
                   1362:     $origurl=~s|^/~|/priv/|;
                   1363:     my $timestamp = time;
                   1364:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1365:         $$datum = &escape($$datum);
                   1366:     }
                   1367: 
                   1368:     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";
                   1369:     my $output .= <<"ENDOUTPUT";
                   1370: <script type="text/javascript">
1.824     bisitz   1371: // <![CDATA[
1.430     albertel 1372: banner_link = '$banner_link';
1.824     bisitz   1373: // ]]>
1.430     albertel 1374: </script>
                   1375: ENDOUTPUT
                   1376:     return $output;
                   1377: }
                   1378: 
                   1379: # now just updates the help link and generates a blue icon
1.193     raeburn  1380: sub help_open_menu {
1.430     albertel 1381:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1382: 	= @_;    
1.949     droeschl 1383:     $stayOnPage = 1;
1.430     albertel 1384:     my $output;
                   1385:     if ($component_help) {
                   1386: 	if (!$text) {
                   1387: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1388: 				       $width,$height);
                   1389: 	} else {
                   1390: 	    my $help_text;
                   1391: 	    $help_text=&unescape($topic);
                   1392: 	    $output='<table><tr><td>'.
                   1393: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1394: 				 $width,$height).'</td></tr></table>';
                   1395: 	}
                   1396:     }
                   1397:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1398:     return $output.$banner_link;
                   1399: }
                   1400: 
                   1401: sub top_nav_help {
                   1402:     my ($text) = @_;
1.436     albertel 1403:     $text = &mt($text);
1.949     droeschl 1404:     my $stay_on_page = 1;
                   1405: 
1.1168    raeburn  1406:     my ($link,$banner_link);
                   1407:     unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
                   1408:         $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                   1409: 	                         : "javascript:helpMenu('open')";
                   1410:         $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
                   1411:     }
1.201     raeburn  1412:     my $title = &mt('Get help');
1.1168    raeburn  1413:     if ($link) {
                   1414:         return <<"END";
1.436     albertel 1415: $banner_link
1.1159    raeburn  1416: <a href="$link" title="$title">$text</a>
1.436     albertel 1417: END
1.1168    raeburn  1418:     } else {
                   1419:         return '&nbsp;'.$text.'&nbsp;';
                   1420:     }
1.436     albertel 1421: }
                   1422: 
                   1423: sub help_menu_js {
1.1154    raeburn  1424:     my ($httphost) = @_;
1.949     droeschl 1425:     my $stayOnPage = 1;
1.436     albertel 1426:     my $width = 620;
                   1427:     my $height = 600;
1.430     albertel 1428:     my $helptopic=&general_help();
1.1154    raeburn  1429:     my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1430:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1431:     my $start_page =
                   1432:         &Apache::loncommon::start_page('Help Menu', undef,
                   1433: 				       {'frameset'    => 1,
                   1434: 					'js_ready'    => 1,
1.1154    raeburn  1435:                                         'use_absolute' => $httphost,
1.331     albertel 1436: 					'add_entries' => {
1.1168    raeburn  1437: 					    'border' => '0', 
1.579     raeburn  1438: 					    'rows'   => "110,*",},});
1.331     albertel 1439:     my $end_page =
                   1440:         &Apache::loncommon::end_page({'frameset' => 1,
                   1441: 				      'js_ready' => 1,});
                   1442: 
1.436     albertel 1443:     my $template .= <<"ENDTEMPLATE";
                   1444: <script type="text/javascript">
1.877     bisitz   1445: // <![CDATA[
1.253     albertel 1446: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1447: var banner_link = '';
1.243     raeburn  1448: function helpMenu(target) {
                   1449:     var caller = this;
                   1450:     if (target == 'open') {
                   1451:         var newWindow = null;
                   1452:         try {
1.262     albertel 1453:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1454:         }
                   1455:         catch(error) {
                   1456:             writeHelp(caller);
                   1457:             return;
                   1458:         }
                   1459:         if (newWindow) {
                   1460:             caller = newWindow;
                   1461:         }
1.193     raeburn  1462:     }
1.243     raeburn  1463:     writeHelp(caller);
                   1464:     return;
                   1465: }
                   1466: function writeHelp(caller) {
1.1168    raeburn  1467:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
                   1468:     caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
                   1469:     caller.document.close();
                   1470:     caller.focus();
1.193     raeburn  1471: }
1.877     bisitz   1472: // END LON-CAPA Internal -->
1.253     albertel 1473: // ]]>
1.436     albertel 1474: </script>
1.193     raeburn  1475: ENDTEMPLATE
                   1476:     return $template;
                   1477: }
                   1478: 
1.172     www      1479: sub help_open_bug {
                   1480:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1481:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1482:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1483:     $text = "" if (not defined $text);
                   1484: 	$stayOnPage=1;
1.184     albertel 1485:     $width = 600 if (not defined $width);
                   1486:     $height = 600 if (not defined $height);
1.172     www      1487: 
                   1488:     $topic=~s/\W+/\+/g;
                   1489:     my $link='';
                   1490:     my $template='';
1.379     albertel 1491:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1492: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1493:     if (!$stayOnPage)
                   1494:     {
                   1495: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1496:     }
                   1497:     else
                   1498:     {
                   1499: 	$link = $url;
                   1500:     }
                   1501:     # Add the text
                   1502:     if ($text ne "")
                   1503:     {
                   1504: 	$template .= 
                   1505:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1506:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1507:     }
                   1508: 
                   1509:     # Add the graphic
1.179     matthew  1510:     my $title = &mt('Report a Bug');
1.215     albertel 1511:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1512:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1513:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1514: ENDTEMPLATE
                   1515:     if ($text ne '') { $template.='</td></tr></table>' };
                   1516:     return $template;
                   1517: 
                   1518: }
                   1519: 
                   1520: sub help_open_faq {
                   1521:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1522:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1523:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1524:     $text = "" if (not defined $text);
                   1525: 	$stayOnPage=1;
                   1526:     $width = 350 if (not defined $width);
                   1527:     $height = 400 if (not defined $height);
                   1528: 
                   1529:     $topic=~s/\W+/\+/g;
                   1530:     my $link='';
                   1531:     my $template='';
                   1532:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1533:     if (!$stayOnPage)
                   1534:     {
                   1535: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1536:     }
                   1537:     else
                   1538:     {
                   1539: 	$link = $url;
                   1540:     }
                   1541: 
                   1542:     # Add the text
                   1543:     if ($text ne "")
                   1544:     {
                   1545: 	$template .= 
1.173     www      1546:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1547:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1548:     }
                   1549: 
                   1550:     # Add the graphic
1.179     matthew  1551:     my $title = &mt('View the FAQ');
1.215     albertel 1552:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1553:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1554:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1555: ENDTEMPLATE
                   1556:     if ($text ne '') { $template.='</td></tr></table>' };
                   1557:     return $template;
                   1558: 
1.44      bowersj2 1559: }
1.37      matthew  1560: 
1.180     matthew  1561: ###############################################################
                   1562: ###############################################################
                   1563: 
1.45      matthew  1564: =pod
                   1565: 
1.648     raeburn  1566: =item * &change_content_javascript():
1.256     matthew  1567: 
                   1568: This and the next function allow you to create small sections of an
                   1569: otherwise static HTML page that you can update on the fly with
                   1570: Javascript, even in Netscape 4.
                   1571: 
                   1572: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1573: must be written to the HTML page once. It will prove the Javascript
                   1574: function "change(name, content)". Calling the change function with the
                   1575: name of the section 
                   1576: you want to update, matching the name passed to C<changable_area>, and
                   1577: the new content you want to put in there, will put the content into
                   1578: that area.
                   1579: 
                   1580: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1581: to contain room for the original contents. You need to "make space"
                   1582: for whatever changes you wish to make, and be B<sure> to check your
                   1583: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1584: it's adequate for updating a one-line status display, but little more.
                   1585: This script will set the space to 100% width, so you only need to
                   1586: worry about height in Netscape 4.
                   1587: 
                   1588: Modern browsers are much less limiting, and if you can commit to the
                   1589: user not using Netscape 4, this feature may be used freely with
                   1590: pretty much any HTML.
                   1591: 
                   1592: =cut
                   1593: 
                   1594: sub change_content_javascript {
                   1595:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1596:     if ($env{'browser.type'} eq 'netscape' &&
                   1597: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1598: 	return (<<NETSCAPE4);
                   1599: 	function change(name, content) {
                   1600: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1601: 	    doc.open();
                   1602: 	    doc.write(content);
                   1603: 	    doc.close();
                   1604: 	}
                   1605: NETSCAPE4
                   1606:     } else {
                   1607: 	# Otherwise, we need to use semi-standards-compliant code
                   1608: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1609: 	# is really scary, and every useful browser supports it
                   1610: 	return (<<DOMBASED);
                   1611: 	function change(name, content) {
                   1612: 	    element = document.getElementById(name);
                   1613: 	    element.innerHTML = content;
                   1614: 	}
                   1615: DOMBASED
                   1616:     }
                   1617: }
                   1618: 
                   1619: =pod
                   1620: 
1.648     raeburn  1621: =item * &changable_area($name,$origContent):
1.256     matthew  1622: 
                   1623: This provides a "changable area" that can be modified on the fly via
                   1624: the Javascript code provided in C<change_content_javascript>. $name is
                   1625: the name you will use to reference the area later; do not repeat the
                   1626: same name on a given HTML page more then once. $origContent is what
                   1627: the area will originally contain, which can be left blank.
                   1628: 
                   1629: =cut
                   1630: 
                   1631: sub changable_area {
                   1632:     my ($name, $origContent) = @_;
                   1633: 
1.258     albertel 1634:     if ($env{'browser.type'} eq 'netscape' &&
                   1635: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1636: 	# If this is netscape 4, we need to use the Layer tag
                   1637: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1638:     } else {
                   1639: 	return "<span id='$name'>$origContent</span>";
                   1640:     }
                   1641: }
                   1642: 
                   1643: =pod
                   1644: 
1.648     raeburn  1645: =item * &viewport_geometry_js 
1.590     raeburn  1646: 
                   1647: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1648: 
                   1649: =cut
                   1650: 
                   1651: 
                   1652: sub viewport_geometry_js { 
                   1653:     return <<"GEOMETRY";
                   1654: var Geometry = {};
                   1655: function init_geometry() {
                   1656:     if (Geometry.init) { return };
                   1657:     Geometry.init=1;
                   1658:     if (window.innerHeight) {
                   1659:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1660:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1661:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1662:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1663:     }
                   1664:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1665:         Geometry.getViewportHeight =
                   1666:             function() { return document.documentElement.clientHeight; };
                   1667:         Geometry.getViewportWidth =
                   1668:             function() { return document.documentElement.clientWidth; };
                   1669: 
                   1670:         Geometry.getHorizontalScroll =
                   1671:             function() { return document.documentElement.scrollLeft; };
                   1672:         Geometry.getVerticalScroll =
                   1673:             function() { return document.documentElement.scrollTop; };
                   1674:     }
                   1675:     else if (document.body.clientHeight) {
                   1676:         Geometry.getViewportHeight =
                   1677:             function() { return document.body.clientHeight; };
                   1678:         Geometry.getViewportWidth =
                   1679:             function() { return document.body.clientWidth; };
                   1680:         Geometry.getHorizontalScroll =
                   1681:             function() { return document.body.scrollLeft; };
                   1682:         Geometry.getVerticalScroll =
                   1683:             function() { return document.body.scrollTop; };
                   1684:     }
                   1685: }
                   1686: 
                   1687: GEOMETRY
                   1688: }
                   1689: 
                   1690: =pod
                   1691: 
1.648     raeburn  1692: =item * &viewport_size_js()
1.590     raeburn  1693: 
                   1694: 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. 
                   1695: 
                   1696: =cut
                   1697: 
                   1698: sub viewport_size_js {
                   1699:     my $geometry = &viewport_geometry_js();
                   1700:     return <<"DIMS";
                   1701: 
                   1702: $geometry
                   1703: 
                   1704: function getViewportDims(width,height) {
                   1705:     init_geometry();
                   1706:     width.value = Geometry.getViewportWidth();
                   1707:     height.value = Geometry.getViewportHeight();
                   1708:     return;
                   1709: }
                   1710: 
                   1711: DIMS
                   1712: }
                   1713: 
                   1714: =pod
                   1715: 
1.648     raeburn  1716: =item * &resize_textarea_js()
1.565     albertel 1717: 
                   1718: emits the needed javascript to resize a textarea to be as big as possible
                   1719: 
                   1720: creates a function resize_textrea that takes two IDs first should be
                   1721: the id of the element to resize, second should be the id of a div that
                   1722: surrounds everything that comes after the textarea, this routine needs
                   1723: to be attached to the <body> for the onload and onresize events.
                   1724: 
1.648     raeburn  1725: =back
1.565     albertel 1726: 
                   1727: =cut
                   1728: 
                   1729: sub resize_textarea_js {
1.590     raeburn  1730:     my $geometry = &viewport_geometry_js();
1.565     albertel 1731:     return <<"RESIZE";
                   1732:     <script type="text/javascript">
1.824     bisitz   1733: // <![CDATA[
1.590     raeburn  1734: $geometry
1.565     albertel 1735: 
1.588     albertel 1736: function getX(element) {
                   1737:     var x = 0;
                   1738:     while (element) {
                   1739: 	x += element.offsetLeft;
                   1740: 	element = element.offsetParent;
                   1741:     }
                   1742:     return x;
                   1743: }
                   1744: function getY(element) {
                   1745:     var y = 0;
                   1746:     while (element) {
                   1747: 	y += element.offsetTop;
                   1748: 	element = element.offsetParent;
                   1749:     }
                   1750:     return y;
                   1751: }
                   1752: 
                   1753: 
1.565     albertel 1754: function resize_textarea(textarea_id,bottom_id) {
                   1755:     init_geometry();
                   1756:     var textarea        = document.getElementById(textarea_id);
                   1757:     //alert(textarea);
                   1758: 
1.588     albertel 1759:     var textarea_top    = getY(textarea);
1.565     albertel 1760:     var textarea_height = textarea.offsetHeight;
                   1761:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1762:     var bottom_top      = getY(bottom);
1.565     albertel 1763:     var bottom_height   = bottom.offsetHeight;
                   1764:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1765:     var fudge           = 23;
1.565     albertel 1766:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1767:     if (new_height < 300) {
                   1768: 	new_height = 300;
                   1769:     }
                   1770:     textarea.style.height=new_height+'px';
                   1771: }
1.824     bisitz   1772: // ]]>
1.565     albertel 1773: </script>
                   1774: RESIZE
                   1775: 
                   1776: }
                   1777: 
1.1205    golterma 1778: sub colorfuleditor_js {
1.1248    raeburn  1779:     my $browse_or_search;
                   1780:     my $respath;
                   1781:     my ($cnum,$cdom) = &crsauthor_url();
                   1782:     if ($cnum) {
                   1783:         $respath = "/res/$cdom/$cnum/";
                   1784:         my %js_lt = &Apache::lonlocal::texthash(
                   1785:             sunm => 'Sub-directory name',
                   1786:             save => 'Save page to make this permanent',
                   1787:         );
                   1788:         &js_escape(\%js_lt);
                   1789:         $browse_or_search = <<"END";
                   1790: 
                   1791:     function toggleChooser(form,element,titleid,only,search) {
                   1792:         var disp = 'none';
                   1793:         if (document.getElementById('chooser_'+element)) {
                   1794:             var curr = document.getElementById('chooser_'+element).style.display;
                   1795:             if (curr == 'none') {
                   1796:                 disp='inline';
                   1797:                 if (form.elements['chooser_'+element].length) {
                   1798:                     for (var i=0; i<form.elements['chooser_'+element].length; i++) {
                   1799:                         form.elements['chooser_'+element][i].checked = false;
                   1800:                     }
                   1801:                 }
                   1802:                 toggleResImport(form,element);
                   1803:             }
                   1804:             document.getElementById('chooser_'+element).style.display = disp;
                   1805:         }
                   1806:     }
                   1807: 
                   1808:     function toggleCrsFile(form,element,numdirs) {
                   1809:         if (document.getElementById('chooser_'+element+'_crsres')) {
                   1810:             var curr = document.getElementById('chooser_'+element+'_crsres').style.display;
                   1811:             if (curr == 'none') {
                   1812:                 if (numdirs) {
                   1813:                     form.elements['coursepath_'+element].selectedIndex = 0;
                   1814:                     if (numdirs > 1) {
                   1815:                         window['select1'+element+'_changed']();
                   1816:                     }
                   1817:                 }
                   1818:             } 
                   1819:             document.getElementById('chooser_'+element+'_crsres').style.display = 'block';
                   1820:             
                   1821:         }
                   1822:         if (document.getElementById('chooser_'+element+'_upload')) {
                   1823:             document.getElementById('chooser_'+element+'_upload').style.display = 'none';
                   1824:             if (document.getElementById('uploadcrsres_'+element)) {
                   1825:                 document.getElementById('uploadcrsres_'+element).value = '';
                   1826:             }
                   1827:         }
                   1828:         return;
                   1829:     }
                   1830: 
                   1831:     function toggleCrsUpload(form,element,numcrsdirs) {
                   1832:         if (document.getElementById('chooser_'+element+'_crsres')) {
                   1833:             document.getElementById('chooser_'+element+'_crsres').style.display = 'none';
                   1834:         }
                   1835:         if (document.getElementById('chooser_'+element+'_upload')) {
                   1836:             var curr = document.getElementById('chooser_'+element+'_upload').style.display;
                   1837:             if (curr == 'none') {
                   1838:                 if (numcrsdirs) {
                   1839:                    form.elements['crsauthorpath_'+element].selectedIndex = 0;
                   1840:                    form.elements['newsubdir_'+element][0].checked = true;
                   1841:                    toggleNewsubdir(form,element);
                   1842:                 }
                   1843:             }
                   1844:             document.getElementById('chooser_'+element+'_upload').style.display = 'block';
                   1845:         }
                   1846:         return;
                   1847:     }
                   1848: 
                   1849:     function toggleResImport(form,element) {
                   1850:         var choices = new Array('crsres','upload');
                   1851:         for (var i=0; i<choices.length; i++) {
                   1852:             if (document.getElementById('chooser_'+element+'_'+choices[i])) {
                   1853:                 document.getElementById('chooser_'+element+'_'+choices[i]).style.display = 'none';
                   1854:             }
                   1855:         }
                   1856:     }
                   1857: 
                   1858:     function toggleNewsubdir(form,element) {
                   1859:         var newsub = form.elements['newsubdir_'+element];
                   1860:         if (newsub) {
                   1861:             if (newsub.length) {
                   1862:                 for (var j=0; j<newsub.length; j++) {
                   1863:                     if (newsub[j].checked) {
                   1864:                         if (document.getElementById('newsubdirname_'+element)) {
                   1865:                             if (newsub[j].value == '1') {
                   1866:                                 document.getElementById('newsubdirname_'+element).type = "text";
                   1867:                                 if (document.getElementById('newsubdir_'+element)) {
                   1868:                                     document.getElementById('newsubdir_'+element).innerHTML = '<br />$js_lt{sunm}';
                   1869:                                 }
                   1870:                             } else {
                   1871:                                 document.getElementById('newsubdirname_'+element).type = "hidden";
                   1872:                                 document.getElementById('newsubdirname_'+element).value = "";
                   1873:                                 document.getElementById('newsubdir_'+element).innerHTML = "";
                   1874:                             }
                   1875:                         }
                   1876:                         break; 
                   1877:                     }
                   1878:                 }
                   1879:             }
                   1880:         }
                   1881:     }
                   1882: 
                   1883:     function updateCrsFile(form,element) {
                   1884:         var directory = form.elements['coursepath_'+element];
                   1885:         var filename = form.elements['coursefile_'+element];
                   1886:         var path = directory.options[directory.selectedIndex].value;
                   1887:         var file = filename.options[filename.selectedIndex].value;
                   1888:         form.elements[element].value = '$respath';
                   1889:         if (path == '/') {
                   1890:             form.elements[element].value += file;
                   1891:         } else {
                   1892:             form.elements[element].value += path+'/'+file;
                   1893:         }
                   1894:         unClean();
                   1895:         if (document.getElementById('previewimg_'+element)) {
                   1896:             document.getElementById('previewimg_'+element).src = form.elements[element].value;
                   1897:             var newsrc = document.getElementById('previewimg_'+element).src; 
                   1898:         }
                   1899:         if (document.getElementById('showimg_'+element)) {
                   1900:             document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';
                   1901:         }
                   1902:         toggleChooser(form,element);
                   1903:         return;
                   1904:     }
                   1905: 
                   1906:     function uploadDone(suffix,name) {
                   1907:         if (name) {
                   1908: 	    document.forms["lonhomework"].elements[suffix].value = name;
                   1909:             unClean();
                   1910:             toggleChooser(document.forms["lonhomework"],suffix);
                   1911:         }
                   1912:     }
                   1913: 
                   1914: \$(document).ready(function(){
                   1915: 
                   1916:     \$(document).delegate('form :submit', 'click', function( event ) {
                   1917:         if ( \$( this ).hasClass( "LC_uploadcrsres" ) ) {
                   1918:             var buttonId = this.id;
                   1919:             var suffix = buttonId.toString();
                   1920:             suffix = suffix.replace(/^crsupload_/,'');
                   1921:             event.preventDefault();
                   1922:             document.lonhomework.target = 'crsupload_target_'+suffix;
                   1923:             document.lonhomework.action = '/adm/coursepub?LC_uploadcrsres='+suffix;
                   1924:             \$(this.form).submit();
                   1925:             document.lonhomework.target = '';
                   1926:             if (document.getElementById('crsuploadto_'+suffix)) {
                   1927:                 document.lonhomework.action = document.getElementById('crsuploadto_'+suffix).value;
                   1928:             }
                   1929:             return false;
                   1930:         }
                   1931:     });
                   1932: });
                   1933: END
                   1934:     }
1.1205    golterma 1935:     return <<"COLORFULEDIT"
                   1936: <script type="text/javascript">
                   1937: // <![CDATA[>
                   1938:     function fold_box(curDepth, lastresource){
                   1939: 
                   1940:     // we need a list because there can be several blocks you need to fold in one tag
                   1941:         var block = document.getElementsByName('foldblock_'+curDepth);
                   1942:     // but there is only one folding button per tag
                   1943:         var foldbutton = document.getElementById('folding_btn_'+curDepth);
                   1944: 
                   1945:         if(block.item(0).style.display == 'none'){
                   1946: 
                   1947:             foldbutton.value = '@{[&mt("Hide")]}';
                   1948:             for (i = 0; i < block.length; i++){
                   1949:                 block.item(i).style.display = '';
                   1950:             }
                   1951:         }else{
                   1952: 
                   1953:             foldbutton.value = '@{[&mt("Show")]}';
                   1954:             for (i = 0; i < block.length; i++){
                   1955:                 // block.item(i).style.visibility = 'collapse';
                   1956:                 block.item(i).style.display = 'none';
                   1957:             }
                   1958:         };
                   1959:         saveState(lastresource);
                   1960:     }
                   1961: 
                   1962:     function saveState (lastresource) {
                   1963: 
                   1964:         var tag_list = getTagList();
                   1965:         if(tag_list != null){
                   1966:             var timestamp = new Date().getTime();
                   1967:             var key = lastresource;
                   1968: 
                   1969:             // the value pattern is: 'time;key1,value1;key2,value2; ... '
                   1970:             // starting with timestamp
                   1971:             var value = timestamp+';';
                   1972: 
                   1973:             // building the list of key-value pairs
                   1974:             for(var i = 0; i < tag_list.length; i++){
                   1975:                 value += tag_list[i]+',';
                   1976:                 value += document.getElementsByName(tag_list[i])[0].style.display+';';
                   1977:             }
                   1978: 
                   1979:             // only iterate whole storage if nothing to override
                   1980:             if(localStorage.getItem(key) == null){        
                   1981: 
                   1982:                 // prevent storage from growing large
                   1983:                 if(localStorage.length > 50){
                   1984:                     var regex_getTimestamp = /^(?:\d)+;/;
                   1985:                     var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
                   1986:                     var oldest_key;
                   1987:                     
                   1988:                     for(var i = 1; i < localStorage.length; i++){
                   1989:                         if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
                   1990:                             oldest_key = localStorage.key(i);
                   1991:                             oldest_timestamp = regex_getTimestamp.exec(oldest_key);
                   1992:                         }
                   1993:                     }
                   1994:                     localStorage.removeItem(oldest_key);
                   1995:                 }
                   1996:             }
                   1997:             localStorage.setItem(key,value);
                   1998:         }
                   1999:     }
                   2000: 
                   2001:     // restore folding status of blocks (on page load)
                   2002:     function restoreState (lastresource) {
                   2003:         if(localStorage.getItem(lastresource) != null){
                   2004:             var key = lastresource;
                   2005:             var value = localStorage.getItem(key);
                   2006:             var regex_delTimestamp = /^\d+;/;
                   2007: 
                   2008:             value.replace(regex_delTimestamp, '');
                   2009: 
                   2010:             var valueArr = value.split(';');
                   2011:             var pairs;
                   2012:             var elements;
                   2013:             for (var i = 0; i < valueArr.length; i++){
                   2014:                 pairs = valueArr[i].split(',');
                   2015:                 elements = document.getElementsByName(pairs[0]);
                   2016: 
                   2017:                 for (var j = 0; j < elements.length; j++){  
                   2018:                     elements[j].style.display = pairs[1];
                   2019:                     if (pairs[1] == "none"){
                   2020:                         var regex_id = /([_\\d]+)\$/;
                   2021:                         regex_id.exec(pairs[0]);
                   2022:                         document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
                   2023:                     }
                   2024:                 }
                   2025:             }
                   2026:         }
                   2027:     }
                   2028: 
                   2029:     function getTagList () {
                   2030:         
                   2031:         var stringToSearch = document.lonhomework.innerHTML;
                   2032: 
                   2033:         var ret = new Array();
                   2034:         var regex_findBlock = /(foldblock_.*?)"/g;
                   2035:         var tag_list = stringToSearch.match(regex_findBlock);
                   2036: 
                   2037:         if(tag_list != null){
                   2038:             for(var i = 0; i < tag_list.length; i++){            
                   2039:                 ret.push(tag_list[i].replace(/"/, ''));
                   2040:             }
                   2041:         }
                   2042:         return ret;
                   2043:     }
                   2044: 
                   2045:     function saveScrollPosition (resource) {
                   2046:         var tag_list = getTagList();
                   2047: 
                   2048:         // we dont always want to jump to the first block
                   2049:         // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
                   2050:         if(\$(window).scrollTop() > 170){
                   2051:             if(tag_list != null){
                   2052:                 var result;
                   2053:                 for(var i = 0; i < tag_list.length; i++){
                   2054:                     if(isElementInViewport(tag_list[i])){
                   2055:                         result += tag_list[i]+';';
                   2056:                     }
                   2057:                 }
                   2058:                 sessionStorage.setItem('anchor_'+resource, result);
                   2059:             }
                   2060:         } else {
                   2061:             // we dont need to save zero, just delete the item to leave everything tidy
                   2062:             sessionStorage.removeItem('anchor_'+resource);
                   2063:         }
                   2064:     }
                   2065: 
                   2066:     function restoreScrollPosition(resource){
                   2067: 
                   2068:         var elem = sessionStorage.getItem('anchor_'+resource);
                   2069:         if(elem != null){
                   2070:             var tag_list = elem.split(';');
                   2071:             var elem_list;
                   2072: 
                   2073:             for(var i = 0; i < tag_list.length; i++){
                   2074:                 elem_list = document.getElementsByName(tag_list[i]);
                   2075:                 
                   2076:                 if(elem_list.length > 0){
                   2077:                     elem = elem_list[0];
                   2078:                     break;
                   2079:                 }
                   2080:             }
                   2081:             elem.scrollIntoView();
                   2082:         }
                   2083:     }
                   2084: 
                   2085:     function isElementInViewport(el) {
                   2086: 
                   2087:         // change to last element instead of first
                   2088:         var elem = document.getElementsByName(el);
                   2089:         var rect = elem[0].getBoundingClientRect();
                   2090: 
                   2091:         return (
                   2092:             rect.top >= 0 &&
                   2093:             rect.left >= 0 &&
                   2094:             rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
                   2095:             rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
                   2096:         );
                   2097:     }
                   2098:     
                   2099:     function autosize(depth){
                   2100:         var cmInst = window['cm'+depth];
                   2101:         var fitsizeButton = document.getElementById('fitsize'+depth);
                   2102: 
                   2103:         // is fixed size, switching to dynamic
                   2104:         if (sessionStorage.getItem("autosized_"+depth) == null) {
                   2105:             cmInst.setSize("","auto");
                   2106:             fitsizeButton.value = "@{[&mt('Fixed size')]}";
                   2107:             sessionStorage.setItem("autosized_"+depth, "yes");
                   2108: 
                   2109:         // is dynamic size, switching to fixed
                   2110:         } else {
                   2111:             cmInst.setSize("","300px");
                   2112:             fitsizeButton.value = "@{[&mt('Dynamic size')]}";
                   2113:             sessionStorage.removeItem("autosized_"+depth);
                   2114:         }
                   2115:     }
                   2116: 
1.1248    raeburn  2117: $browse_or_search
1.1205    golterma 2118: 
                   2119: // ]]>
                   2120: </script>
                   2121: COLORFULEDIT
                   2122: }
                   2123: 
                   2124: sub xmleditor_js {
                   2125:     return <<XMLEDIT
                   2126: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
                   2127: <script type="text/javascript">
                   2128: // <![CDATA[>
                   2129: 
                   2130:     function saveScrollPosition (resource) {
                   2131: 
                   2132:         var scrollPos = \$(window).scrollTop();
                   2133:         sessionStorage.setItem(resource,scrollPos);
                   2134:     }
                   2135: 
                   2136:     function restoreScrollPosition(resource){
                   2137: 
                   2138:         var scrollPos = sessionStorage.getItem(resource);
                   2139:         \$(window).scrollTop(scrollPos);
                   2140:     }
                   2141: 
                   2142:     // unless internet explorer
                   2143:     if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
                   2144: 
                   2145:         \$(document).ready(function() {
                   2146:              \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
                   2147:         });
                   2148:     }
                   2149: 
                   2150:     // inserts text at cursor position into codemirror (xml editor only)
                   2151:     function insertText(text){
                   2152:         cm.focus();
                   2153:         var curPos = cm.getCursor();
                   2154:         cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
                   2155:     }
                   2156: // ]]>
                   2157: </script>
                   2158: XMLEDIT
                   2159: }
                   2160: 
                   2161: sub insert_folding_button {
                   2162:     my $curDepth = $Apache::lonxml::curdepth;
                   2163:     my $lastresource = $env{'request.ambiguous'};
                   2164: 
                   2165:     return "<input type=\"button\" id=\"folding_btn_$curDepth\" 
                   2166:             value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
                   2167: }
                   2168: 
1.1248    raeburn  2169: sub crsauthor_url {
                   2170:     my ($url) = @_;
                   2171:     if ($url eq '') {
                   2172:         $url = $ENV{'REQUEST_URI'};
                   2173:     }
                   2174:     my ($cnum,$cdom);
                   2175:     if ($env{'request.course.id'}) {
                   2176:         my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/});
                   2177:         if ($audom ne '' && $auname ne '') {
                   2178:             if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) &&
                   2179:                 ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) {
                   2180:                 $cnum = $auname;
                   2181:                 $cdom = $audom;
                   2182:             }
                   2183:         }
                   2184:     }
                   2185:     return ($cnum,$cdom);
                   2186: }
                   2187: 
                   2188: sub import_crsauthor_form {
1.1265    raeburn  2189:     my ($form,$firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_;
1.1248    raeburn  2190:     return (0) unless ($env{'request.course.id'});
                   2191:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2192:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2193:     my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   2194:     return (0) unless (($cnum ne '') && ($cdom ne ''));
                   2195:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
                   2196:     my @ids=&Apache::lonnet::current_machine_ids();
                   2197:     my ($output,$is_home,$relpath,%subdirs,%files,%selimport_menus);
                   2198:     
                   2199:     if (grep(/^\Q$crshome\E$/,@ids)) {
                   2200:         $is_home = 1;
                   2201:     }
                   2202:     $relpath = "/priv/$cdom/$cnum";
                   2203:     &Apache::lonnet::recursedirs($is_home,'priv',$londocroot,$relpath,'',\%subdirs,\%files);
                   2204:     my %lt = &Apache::lonlocal::texthash (
                   2205:         fnam => 'Filename',
                   2206:         dire => 'Directory',
                   2207:     );
                   2208:     my $numdirs = scalar(keys(%files));
                   2209:     my (%possexts,$singledir,@singledirfiles);
                   2210:     if ($only) {
                   2211:         map { $possexts{$_} = 1; } split(/\s*,\s*/,$only);
                   2212:     }
                   2213:     my (%nonemptydirs,$possdirs);
                   2214:     if ($numdirs > 1) {
                   2215:         my @order;
                   2216:         foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {
                   2217:             if (ref($files{$key}) eq 'HASH') {
                   2218:                 my $shown = $key;
                   2219:                 if ($key eq '') {
                   2220:                     $shown = '/';
                   2221:                 }
                   2222:                 my @ordered = ();
                   2223:                 foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {
                   2224:                     if ($only) {
                   2225:                         my ($ext) = ($file =~ /\.([^.]+)$/);
                   2226:                         unless ($possexts{lc($ext)}) {
                   2227:                             next;
                   2228:                         }
                   2229:                     }
                   2230:                     $selimport_menus{$key}->{'select2'}->{$file} = $file;
                   2231:                     push(@ordered,$file);
                   2232:                 }
                   2233:                 if (@ordered) {
                   2234:                     push(@order,$key);
                   2235:                     $nonemptydirs{$key} = 1;
                   2236:                     $selimport_menus{$key}->{'text'} = $shown;
                   2237:                     $selimport_menus{$key}->{'default'} = '';
                   2238:                     $selimport_menus{$key}->{'select2'}->{''} = '';
                   2239:                     $selimport_menus{$key}->{'order'} = \@ordered;
                   2240:                 }
                   2241:             }
                   2242:         }
                   2243:         $possdirs = scalar(keys(%nonemptydirs));
                   2244:         if ($possdirs > 1) {
                   2245:             my @order = sort { lc($a) cmp lc($b) } (keys(%nonemptydirs));
                   2246:             $output = $lt{'dire'}.
                   2247:                       &linked_select_forms($form,'<br />'.
                   2248:                                            $lt{'fnam'},'',
                   2249:                                            $firstselectname,$secondselectname,
                   2250:                                            \%selimport_menus,\@order,
                   2251:                                            $onchangefirst,'',$suffix).'<br />';
                   2252:         } elsif ($possdirs == 1) {
                   2253:             $singledir = (keys(%nonemptydirs))[0];
                   2254:             if (ref($selimport_menus{$singledir}->{'order'}) eq 'ARRAY') {
                   2255:                 @singledirfiles = @{$selimport_menus{$singledir}->{'order'}};
                   2256:             }
                   2257:             delete($selimport_menus{$singledir});
                   2258:         }
                   2259:     } elsif ($numdirs == 1) {
                   2260:         $singledir = (keys(%files))[0];
                   2261:         foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$singledir}}))) {
                   2262:             if ($only) {
                   2263:                 my ($ext) = ($file =~ /\.([^.]+)$/);
                   2264:                 unless ($possexts{lc($ext)}) {
                   2265:                     next;
                   2266:                 }
                   2267:             }
                   2268:             push(@singledirfiles,$file);
                   2269:         }
                   2270:         if (@singledirfiles) {
                   2271:             $possdirs == 1;
                   2272:         }
                   2273:     }
                   2274:     if (($possdirs == 1) && (@singledirfiles)) {
                   2275:         my $showdir = $singledir;
                   2276:         if ($singledir eq '') {
                   2277:             $showdir = '/';
                   2278:         }
                   2279:         $output = $lt{'dire'}.
                   2280:                   '<select name="'.$firstselectname.'">'.
                   2281:                   '<option value="'.$singledir.'">'.$showdir.'</option>'."\n".
                   2282:                   '</select><br />'.
                   2283:                   $lt{'fnam'}.'<select name="'.$secondselectname.'">'."\n".
                   2284:                   '<option value="" selected="selected">'.$lt{'se'}.'</option>'."\n";
                   2285:         foreach my $file (@singledirfiles) {
                   2286:             $output .= '<option value="'.$file.'">'.$file.'</option>'."\n";
                   2287:         }
                   2288:         $output .= '</select><br />'."\n";
                   2289:     }
                   2290:     return ($possdirs,$output);
                   2291: }
                   2292: 
1.565     albertel 2293: =pod
                   2294: 
1.256     matthew  2295: =head1 Excel and CSV file utility routines
                   2296: 
                   2297: =cut
                   2298: 
                   2299: ###############################################################
                   2300: ###############################################################
                   2301: 
                   2302: =pod
                   2303: 
1.1162    raeburn  2304: =over 4
                   2305: 
1.648     raeburn  2306: =item * &csv_translate($text) 
1.37      matthew  2307: 
1.185     www      2308: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  2309: format.
                   2310: 
                   2311: =cut
                   2312: 
1.180     matthew  2313: ###############################################################
                   2314: ###############################################################
1.37      matthew  2315: sub csv_translate {
                   2316:     my $text = shift;
                   2317:     $text =~ s/\"/\"\"/g;
1.209     albertel 2318:     $text =~ s/\n/ /g;
1.37      matthew  2319:     return $text;
                   2320: }
1.180     matthew  2321: 
                   2322: ###############################################################
                   2323: ###############################################################
                   2324: 
                   2325: =pod
                   2326: 
1.648     raeburn  2327: =item * &define_excel_formats()
1.180     matthew  2328: 
                   2329: Define some commonly used Excel cell formats.
                   2330: 
                   2331: Currently supported formats:
                   2332: 
                   2333: =over 4
                   2334: 
                   2335: =item header
                   2336: 
                   2337: =item bold
                   2338: 
                   2339: =item h1
                   2340: 
                   2341: =item h2
                   2342: 
                   2343: =item h3
                   2344: 
1.256     matthew  2345: =item h4
                   2346: 
                   2347: =item i
                   2348: 
1.180     matthew  2349: =item date
                   2350: 
                   2351: =back
                   2352: 
                   2353: Inputs: $workbook
                   2354: 
                   2355: Returns: $format, a hash reference.
                   2356: 
1.1057    foxr     2357: 
1.180     matthew  2358: =cut
                   2359: 
                   2360: ###############################################################
                   2361: ###############################################################
                   2362: sub define_excel_formats {
                   2363:     my ($workbook) = @_;
                   2364:     my $format;
                   2365:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   2366:                                                 bottom    => 1,
                   2367:                                                 align     => 'center');
                   2368:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   2369:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   2370:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   2371:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  2372:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  2373:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  2374:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  2375:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  2376:     return $format;
                   2377: }
                   2378: 
                   2379: ###############################################################
                   2380: ###############################################################
1.113     bowersj2 2381: 
                   2382: =pod
                   2383: 
1.648     raeburn  2384: =item * &create_workbook()
1.255     matthew  2385: 
                   2386: Create an Excel worksheet.  If it fails, output message on the
                   2387: request object and return undefs.
                   2388: 
                   2389: Inputs: Apache request object
                   2390: 
                   2391: Returns (undef) on failure, 
                   2392:     Excel worksheet object, scalar with filename, and formats 
                   2393:     from &Apache::loncommon::define_excel_formats on success
                   2394: 
                   2395: =cut
                   2396: 
                   2397: ###############################################################
                   2398: ###############################################################
                   2399: sub create_workbook {
                   2400:     my ($r) = @_;
                   2401:         #
                   2402:     # Create the excel spreadsheet
                   2403:     my $filename = '/prtspool/'.
1.258     albertel 2404:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  2405:         time.'_'.rand(1000000000).'.xls';
                   2406:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   2407:     if (! defined($workbook)) {
                   2408:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   2409:         $r->print(
                   2410:             '<p class="LC_error">'
                   2411:            .&mt('Problems occurred in creating the new Excel file.')
                   2412:            .' '.&mt('This error has been logged.')
                   2413:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2414:            .'</p>'
                   2415:         );
1.255     matthew  2416:         return (undef);
                   2417:     }
                   2418:     #
1.1014    foxr     2419:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  2420:     #
                   2421:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   2422:     return ($workbook,$filename,$format);
                   2423: }
                   2424: 
                   2425: ###############################################################
                   2426: ###############################################################
                   2427: 
                   2428: =pod
                   2429: 
1.648     raeburn  2430: =item * &create_text_file()
1.113     bowersj2 2431: 
1.542     raeburn  2432: Create a file to write to and eventually make available to the user.
1.256     matthew  2433: If file creation fails, outputs an error message on the request object and 
                   2434: return undefs.
1.113     bowersj2 2435: 
1.256     matthew  2436: Inputs: Apache request object, and file suffix
1.113     bowersj2 2437: 
1.256     matthew  2438: Returns (undef) on failure, 
                   2439:     Filehandle and filename on success.
1.113     bowersj2 2440: 
                   2441: =cut
                   2442: 
1.256     matthew  2443: ###############################################################
                   2444: ###############################################################
                   2445: sub create_text_file {
                   2446:     my ($r,$suffix) = @_;
                   2447:     if (! defined($suffix)) { $suffix = 'txt'; };
                   2448:     my $fh;
                   2449:     my $filename = '/prtspool/'.
1.258     albertel 2450:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  2451:         time.'_'.rand(1000000000).'.'.$suffix;
                   2452:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   2453:     if (! defined($fh)) {
                   2454:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   2455:         $r->print(
                   2456:             '<p class="LC_error">'
                   2457:            .&mt('Problems occurred in creating the output file.')
                   2458:            .' '.&mt('This error has been logged.')
                   2459:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   2460:            .'</p>'
                   2461:         );
1.113     bowersj2 2462:     }
1.256     matthew  2463:     return ($fh,$filename)
1.113     bowersj2 2464: }
                   2465: 
                   2466: 
1.256     matthew  2467: =pod 
1.113     bowersj2 2468: 
                   2469: =back
                   2470: 
                   2471: =cut
1.37      matthew  2472: 
                   2473: ###############################################################
1.33      matthew  2474: ##        Home server <option> list generating code          ##
                   2475: ###############################################################
1.35      matthew  2476: 
1.169     www      2477: # ------------------------------------------
                   2478: 
                   2479: sub domain_select {
1.1289    raeburn  2480:     my ($name,$value,$multiple,$incdoms,$excdoms)=@_;
                   2481:     my @possdoms;
                   2482:     if (ref($incdoms) eq 'ARRAY') {
                   2483:         @possdoms = @{$incdoms};
                   2484:     } else {
                   2485:         @possdoms = &Apache::lonnet::all_domains();
                   2486:     }
                   2487: 
1.169     www      2488:     my %domains=map { 
1.514     albertel 2489: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.1289    raeburn  2490:     } @possdoms;
                   2491: 
                   2492:     if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) {
                   2493:         foreach my $dom (@{$excdoms}) {
                   2494:             delete($domains{$dom});
                   2495:         }
                   2496:     }
                   2497: 
1.169     www      2498:     if ($multiple) {
                   2499: 	$domains{''}=&mt('Any domain');
1.550     albertel 2500: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 2501: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      2502:     } else {
1.550     albertel 2503: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  2504: 	return &select_form($name,$value,\%domains);
1.169     www      2505:     }
                   2506: }
                   2507: 
1.282     albertel 2508: #-------------------------------------------
                   2509: 
                   2510: =pod
                   2511: 
1.519     raeburn  2512: =head1 Routines for form select boxes
                   2513: 
                   2514: =over 4
                   2515: 
1.648     raeburn  2516: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 2517: 
                   2518: Returns a string containing a <select> element int multiple mode
                   2519: 
                   2520: 
                   2521: Args:
                   2522:   $name - name of the <select> element
1.506     raeburn  2523:   $value - scalar or array ref of values that should already be selected
1.282     albertel 2524:   $size - number of rows long the select element is
1.283     albertel 2525:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 2526:           (shown text should already have been &mt())
1.506     raeburn  2527:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 2528: 
1.282     albertel 2529: =cut
                   2530: 
                   2531: #-------------------------------------------
1.169     www      2532: sub multiple_select_form {
1.284     albertel 2533:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      2534:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   2535:     my $output='';
1.191     matthew  2536:     if (! defined($size)) {
                   2537:         $size = 4;
1.283     albertel 2538:         if (scalar(keys(%$hash))<4) {
                   2539:             $size = scalar(keys(%$hash));
1.191     matthew  2540:         }
                   2541:     }
1.734     bisitz   2542:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 2543:     my @order;
1.506     raeburn  2544:     if (ref($order) eq 'ARRAY')  {
                   2545:         @order = @{$order};
                   2546:     } else {
                   2547:         @order = sort(keys(%$hash));
1.501     banghart 2548:     }
                   2549:     if (exists($$hash{'select_form_order'})) {
                   2550:         @order = @{$$hash{'select_form_order'}};
                   2551:     }
                   2552:         
1.284     albertel 2553:     foreach my $key (@order) {
1.356     albertel 2554:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 2555:         $output.='selected="selected" ' if ($selected{$key});
                   2556:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      2557:     }
                   2558:     $output.="</select>\n";
                   2559:     return $output;
                   2560: }
                   2561: 
1.88      www      2562: #-------------------------------------------
                   2563: 
                   2564: =pod
                   2565: 
1.1254    raeburn  2566: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88      www      2567: 
                   2568: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  2569: allow a user to select options from a ref to a hash containing:
                   2570: option_name => displayed text. An optional $onchange can include
1.1254    raeburn  2571: a javascript onchange item, e.g., onchange="this.form.submit();".
                   2572: An optional arg -- $readonly -- if true will cause the select form
                   2573: to be disabled, e.g., for the case where an instructor has a section-
                   2574: specific role, and is viewing/modifying parameters. 
1.970     raeburn  2575: 
1.88      www      2576: See lonrights.pm for an example invocation and use.
                   2577: 
                   2578: =cut
                   2579: 
                   2580: #-------------------------------------------
                   2581: sub select_form {
1.1228    raeburn  2582:     my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970     raeburn  2583:     return unless (ref($hashref) eq 'HASH');
                   2584:     if ($onchange) {
                   2585:         $onchange = ' onchange="'.$onchange.'"';
                   2586:     }
1.1228    raeburn  2587:     my $disabled;
                   2588:     if ($readonly) {
                   2589:         $disabled = ' disabled="disabled"';
                   2590:     }
                   2591:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128     albertel 2592:     my @keys;
1.970     raeburn  2593:     if (exists($hashref->{'select_form_order'})) {
                   2594: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2595:     } else {
1.970     raeburn  2596: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2597:     }
1.356     albertel 2598:     foreach my $key (@keys) {
                   2599:         $selectform.=
                   2600: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2601:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2602:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2603:     }
                   2604:     $selectform.="</select>";
                   2605:     return $selectform;
                   2606: }
                   2607: 
1.475     www      2608: # For display filters
                   2609: 
                   2610: sub display_filter {
1.1074    raeburn  2611:     my ($context) = @_;
1.475     www      2612:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2613:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2614:     my $phraseinput = 'hidden';
                   2615:     my $includeinput = 'hidden';
                   2616:     my ($checked,$includetypestext);
                   2617:     if ($env{'form.displayfilter'} eq 'containing') {
                   2618:         $phraseinput = 'text'; 
                   2619:         if ($context eq 'parmslog') {
                   2620:             $includeinput = 'checkbox';
                   2621:             if ($env{'form.includetypes'}) {
                   2622:                 $checked = ' checked="checked"';
                   2623:             }
                   2624:             $includetypestext = &mt('Include parameter types');
                   2625:         }
                   2626:     } else {
                   2627:         $includetypestext = '&nbsp;';
                   2628:     }
                   2629:     my ($additional,$secondid,$thirdid);
                   2630:     if ($context eq 'parmslog') {
                   2631:         $additional = 
                   2632:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2633:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2634:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2635:             '</label>';
                   2636:         $secondid = 'includetypes';
                   2637:         $thirdid = 'includetypestext';
                   2638:     }
                   2639:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2640:                                                     '$secondid','$thirdid')";
                   2641:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2642: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2643: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2644: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2645:            &mt('Filter: [_1]',
1.477     www      2646: 	   &select_form($env{'form.displayfilter'},
                   2647: 			'displayfilter',
1.970     raeburn  2648: 			{'currentfolder' => 'Current folder/page',
1.477     www      2649: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2650: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2651: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2652:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2653:                          '" />'.$additional;
                   2654: }
                   2655: 
                   2656: sub display_filter_js {
                   2657:     my $includetext = &mt('Include parameter types');
                   2658:     return <<"ENDJS";
                   2659:   
                   2660: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2661:     var firstType = 'hidden';
                   2662:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2663:         firstType = 'text';
                   2664:     }
                   2665:     firstObject = document.getElementById(firstid);
                   2666:     if (typeof(firstObject) == 'object') {
                   2667:         if (firstObject.type != firstType) {
                   2668:             changeInputType(firstObject,firstType);
                   2669:         }
                   2670:     }
                   2671:     if (context == 'parmslog') {
                   2672:         var secondType = 'hidden';
                   2673:         if (firstType == 'text') {
                   2674:             secondType = 'checkbox';
                   2675:         }
                   2676:         secondObject = document.getElementById(secondid);  
                   2677:         if (typeof(secondObject) == 'object') {
                   2678:             if (secondObject.type != secondType) {
                   2679:                 changeInputType(secondObject,secondType);
                   2680:             }
                   2681:         }
                   2682:         var textItem = document.getElementById(thirdid);
                   2683:         var currtext = textItem.innerHTML;
                   2684:         var newtext;
                   2685:         if (firstType == 'text') {
                   2686:             newtext = '$includetext';
                   2687:         } else {
                   2688:             newtext = '&nbsp;';
                   2689:         }
                   2690:         if (currtext != newtext) {
                   2691:             textItem.innerHTML = newtext;
                   2692:         }
                   2693:     }
                   2694:     return;
                   2695: }
                   2696: 
                   2697: function changeInputType(oldObject,newType) {
                   2698:     var newObject = document.createElement('input');
                   2699:     newObject.type = newType;
                   2700:     if (oldObject.size) {
                   2701:         newObject.size = oldObject.size;
                   2702:     }
                   2703:     if (oldObject.value) {
                   2704:         newObject.value = oldObject.value;
                   2705:     }
                   2706:     if (oldObject.name) {
                   2707:         newObject.name = oldObject.name;
                   2708:     }
                   2709:     if (oldObject.id) {
                   2710:         newObject.id = oldObject.id;
                   2711:     }
                   2712:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2713:     return;
                   2714: }
                   2715: 
                   2716: ENDJS
1.475     www      2717: }
                   2718: 
1.167     www      2719: sub gradeleveldescription {
                   2720:     my $gradelevel=shift;
                   2721:     my %gradelevels=(0 => 'Not specified',
                   2722: 		     1 => 'Grade 1',
                   2723: 		     2 => 'Grade 2',
                   2724: 		     3 => 'Grade 3',
                   2725: 		     4 => 'Grade 4',
                   2726: 		     5 => 'Grade 5',
                   2727: 		     6 => 'Grade 6',
                   2728: 		     7 => 'Grade 7',
                   2729: 		     8 => 'Grade 8',
                   2730: 		     9 => 'Grade 9',
                   2731: 		     10 => 'Grade 10',
                   2732: 		     11 => 'Grade 11',
                   2733: 		     12 => 'Grade 12',
                   2734: 		     13 => 'Grade 13',
                   2735: 		     14 => '100 Level',
                   2736: 		     15 => '200 Level',
                   2737: 		     16 => '300 Level',
                   2738: 		     17 => '400 Level',
                   2739: 		     18 => 'Graduate Level');
                   2740:     return &mt($gradelevels{$gradelevel});
                   2741: }
                   2742: 
1.163     www      2743: sub select_level_form {
                   2744:     my ($deflevel,$name)=@_;
                   2745:     unless ($deflevel) { $deflevel=0; }
1.167     www      2746:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2747:     for (my $i=0; $i<=18; $i++) {
                   2748:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2749:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2750:                 ">".&gradeleveldescription($i)."</option>\n";
                   2751:     }
                   2752:     $selectform.="</select>";
                   2753:     return $selectform;
1.163     www      2754: }
1.167     www      2755: 
1.35      matthew  2756: #-------------------------------------------
                   2757: 
1.45      matthew  2758: =pod
                   2759: 
1.1256    raeburn  2760: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35      matthew  2761: 
                   2762: Returns a string containing a <select name='$name' size='1'> form to 
                   2763: allow a user to select the domain to preform an operation in.  
                   2764: See loncreateuser.pm for an example invocation and use.
                   2765: 
1.90      www      2766: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2767: selected");
                   2768: 
1.743     raeburn  2769: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2770: 
1.910     raeburn  2771: 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.
                   2772: 
1.1121    raeburn  2773: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2774: 
                   2775: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563     raeburn  2776: 
1.1256    raeburn  2777: The optional $disabled argument, if true, adds the disabled attribute to the select tag.
                   2778: 
1.35      matthew  2779: =cut
                   2780: 
                   2781: #-------------------------------------------
1.34      matthew  2782: sub select_dom_form {
1.1256    raeburn  2783:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872     raeburn  2784:     if ($onchange) {
1.874     raeburn  2785:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2786:     }
1.1256    raeburn  2787:     if ($disabled) {
                   2788:         $disabled = ' disabled="disabled"';
                   2789:     }
1.1121    raeburn  2790:     my (@domains,%exclude);
1.910     raeburn  2791:     if (ref($incdoms) eq 'ARRAY') {
                   2792:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2793:     } else {
                   2794:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2795:     }
1.90      www      2796:     if ($includeempty) { @domains=('',@domains); }
1.1121    raeburn  2797:     if (ref($excdoms) eq 'ARRAY') {
                   2798:         map { $exclude{$_} = 1; } @{$excdoms}; 
                   2799:     }
1.1256    raeburn  2800:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356     albertel 2801:     foreach my $dom (@domains) {
1.1121    raeburn  2802:         next if ($exclude{$dom});
1.356     albertel 2803:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2804:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2805:         if ($showdomdesc) {
                   2806:             if ($dom ne '') {
                   2807:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2808:                 if ($domdesc ne '') {
                   2809:                     $selectdomain .= ' ('.$domdesc.')';
                   2810:                 }
                   2811:             } 
                   2812:         }
                   2813:         $selectdomain .= "</option>\n";
1.34      matthew  2814:     }
                   2815:     $selectdomain.="</select>";
                   2816:     return $selectdomain;
                   2817: }
                   2818: 
1.35      matthew  2819: #-------------------------------------------
                   2820: 
1.45      matthew  2821: =pod
                   2822: 
1.648     raeburn  2823: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2824: 
1.586     raeburn  2825: input: 4 arguments (two required, two optional) - 
                   2826:     $domain - domain of new user
                   2827:     $name - name of form element
                   2828:     $default - Value of 'default' causes a default item to be first 
                   2829:                             option, and selected by default. 
                   2830:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2831:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2832: output: returns 2 items: 
1.586     raeburn  2833: (a) form element which contains either:
                   2834:    (i) <select name="$name">
                   2835:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2836:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2837:        </select>
                   2838:        form item if there are multiple library servers in $domain, or
                   2839:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2840:        if there is only one library server in $domain.
                   2841: 
                   2842: (b) number of library servers found.
                   2843: 
                   2844: See loncreateuser.pm for example of use.
1.35      matthew  2845: 
                   2846: =cut
                   2847: 
                   2848: #-------------------------------------------
1.586     raeburn  2849: sub home_server_form_item {
                   2850:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2851:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2852:     my $result;
                   2853:     my $numlib = keys(%servers);
                   2854:     if ($numlib > 1) {
                   2855:         $result .= '<select name="'.$name.'" />'."\n";
                   2856:         if ($default) {
1.804     bisitz   2857:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2858:                        '</option>'."\n";
                   2859:         }
                   2860:         foreach my $hostid (sort(keys(%servers))) {
                   2861:             $result.= '<option value="'.$hostid.'">'.
                   2862: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2863:         }
                   2864:         $result .= '</select>'."\n";
                   2865:     } elsif ($numlib == 1) {
                   2866:         my $hostid;
                   2867:         foreach my $item (keys(%servers)) {
                   2868:             $hostid = $item;
                   2869:         }
                   2870:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2871:                    $hostid.'" />';
                   2872:                    if (!$hide) {
                   2873:                        $result .= $hostid.' '.$servers{$hostid};
                   2874:                    }
                   2875:                    $result .= "\n";
                   2876:     } elsif ($default) {
                   2877:         $result .= '<input type="hidden" name="'.$name.
                   2878:                    '" value="default" />';
                   2879:                    if (!$hide) {
                   2880:                        $result .= &mt('default');
                   2881:                    }
                   2882:                    $result .= "\n";
1.33      matthew  2883:     }
1.586     raeburn  2884:     return ($result,$numlib);
1.33      matthew  2885: }
1.112     bowersj2 2886: 
                   2887: =pod
                   2888: 
1.534     albertel 2889: =back 
                   2890: 
1.112     bowersj2 2891: =cut
1.87      matthew  2892: 
                   2893: ###############################################################
1.112     bowersj2 2894: ##                  Decoding User Agent                      ##
1.87      matthew  2895: ###############################################################
                   2896: 
                   2897: =pod
                   2898: 
1.112     bowersj2 2899: =head1 Decoding the User Agent
                   2900: 
                   2901: =over 4
                   2902: 
                   2903: =item * &decode_user_agent()
1.87      matthew  2904: 
                   2905: Inputs: $r
                   2906: 
                   2907: Outputs:
                   2908: 
                   2909: =over 4
                   2910: 
1.112     bowersj2 2911: =item * $httpbrowser
1.87      matthew  2912: 
1.112     bowersj2 2913: =item * $clientbrowser
1.87      matthew  2914: 
1.112     bowersj2 2915: =item * $clientversion
1.87      matthew  2916: 
1.112     bowersj2 2917: =item * $clientmathml
1.87      matthew  2918: 
1.112     bowersj2 2919: =item * $clientunicode
1.87      matthew  2920: 
1.112     bowersj2 2921: =item * $clientos
1.87      matthew  2922: 
1.1137    raeburn  2923: =item * $clientmobile
                   2924: 
1.1141    raeburn  2925: =item * $clientinfo
                   2926: 
1.1194    raeburn  2927: =item * $clientosversion
                   2928: 
1.87      matthew  2929: =back
                   2930: 
1.157     matthew  2931: =back 
                   2932: 
1.87      matthew  2933: =cut
                   2934: 
                   2935: ###############################################################
                   2936: ###############################################################
                   2937: sub decode_user_agent {
1.247     albertel 2938:     my ($r)=@_;
1.87      matthew  2939:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2940:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2941:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2942:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2943:     my $clientbrowser='unknown';
                   2944:     my $clientversion='0';
                   2945:     my $clientmathml='';
                   2946:     my $clientunicode='0';
1.1137    raeburn  2947:     my $clientmobile=0;
1.1194    raeburn  2948:     my $clientosversion='';
1.87      matthew  2949:     for (my $i=0;$i<=$#browsertype;$i++) {
1.1193    raeburn  2950:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87      matthew  2951: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2952: 	    $clientbrowser=$bname;
                   2953:             $httpbrowser=~/$vreg/i;
                   2954: 	    $clientversion=$1;
                   2955:             $clientmathml=($clientversion>=$minv);
                   2956:             $clientunicode=($clientversion>=$univ);
                   2957: 	}
                   2958:     }
                   2959:     my $clientos='unknown';
1.1141    raeburn  2960:     my $clientinfo;
1.87      matthew  2961:     if (($httpbrowser=~/linux/i) ||
                   2962:         ($httpbrowser=~/unix/i) ||
                   2963:         ($httpbrowser=~/ux/i) ||
                   2964:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2965:     if (($httpbrowser=~/vax/i) ||
                   2966:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2967:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2968:     if (($httpbrowser=~/mac/i) ||
                   2969:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194    raeburn  2970:     if ($httpbrowser=~/win/i) {
                   2971:         $clientos='win';
                   2972:         if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
                   2973:             $clientosversion = $1;
                   2974:         }
                   2975:     }
1.87      matthew  2976:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137    raeburn  2977:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2978:         $clientmobile=lc($1);
                   2979:     }
1.1141    raeburn  2980:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2981:         $clientinfo = 'firefox-'.$1;
                   2982:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2983:         $clientinfo = 'chromeframe-'.$1;
                   2984:     }
1.87      matthew  2985:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194    raeburn  2986:             $clientunicode,$clientos,$clientmobile,$clientinfo,
                   2987:             $clientosversion);
1.87      matthew  2988: }
                   2989: 
1.32      matthew  2990: ###############################################################
                   2991: ##    Authentication changing form generation subroutines    ##
                   2992: ###############################################################
                   2993: ##
                   2994: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2995: ## hash, and have reasonable default values.
                   2996: ##
                   2997: ##    formname = the name given in the <form> tag.
1.35      matthew  2998: #-------------------------------------------
                   2999: 
1.45      matthew  3000: =pod
                   3001: 
1.112     bowersj2 3002: =head1 Authentication Routines
                   3003: 
                   3004: =over 4
                   3005: 
1.648     raeburn  3006: =item * &authform_xxxxxx()
1.35      matthew  3007: 
                   3008: The authform_xxxxxx subroutines provide javascript and html forms which 
                   3009: handle some of the conveniences required for authentication forms.  
                   3010: This is not an optimal method, but it works.  
                   3011: 
                   3012: =over 4
                   3013: 
1.112     bowersj2 3014: =item * authform_header
1.35      matthew  3015: 
1.112     bowersj2 3016: =item * authform_authorwarning
1.35      matthew  3017: 
1.112     bowersj2 3018: =item * authform_nochange
1.35      matthew  3019: 
1.112     bowersj2 3020: =item * authform_kerberos
1.35      matthew  3021: 
1.112     bowersj2 3022: =item * authform_internal
1.35      matthew  3023: 
1.112     bowersj2 3024: =item * authform_filesystem
1.35      matthew  3025: 
                   3026: =back
                   3027: 
1.648     raeburn  3028: See loncreateuser.pm for invocation and use examples.
1.157     matthew  3029: 
1.35      matthew  3030: =cut
                   3031: 
                   3032: #-------------------------------------------
1.32      matthew  3033: sub authform_header{  
                   3034:     my %in = (
                   3035:         formname => 'cu',
1.80      albertel 3036:         kerb_def_dom => '',
1.32      matthew  3037:         @_,
                   3038:     );
                   3039:     $in{'formname'} = 'document.' . $in{'formname'};
                   3040:     my $result='';
1.80      albertel 3041: 
                   3042: #---------------------------------------------- Code for upper case translation
                   3043:     my $Javascript_toUpperCase;
                   3044:     unless ($in{kerb_def_dom}) {
                   3045:         $Javascript_toUpperCase =<<"END";
                   3046:         switch (choice) {
                   3047:            case 'krb': currentform.elements[choicearg].value =
                   3048:                currentform.elements[choicearg].value.toUpperCase();
                   3049:                break;
                   3050:            default:
                   3051:         }
                   3052: END
                   3053:     } else {
                   3054:         $Javascript_toUpperCase = "";
                   3055:     }
                   3056: 
1.165     raeburn  3057:     my $radioval = "'nochange'";
1.591     raeburn  3058:     if (defined($in{'curr_authtype'})) {
                   3059:         if ($in{'curr_authtype'} ne '') {
                   3060:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   3061:         }
1.174     matthew  3062:     }
1.165     raeburn  3063:     my $argfield = 'null';
1.591     raeburn  3064:     if (defined($in{'mode'})) {
1.165     raeburn  3065:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  3066:             if (defined($in{'curr_autharg'})) {
                   3067:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  3068:                     $argfield = "'$in{'curr_autharg'}'";
                   3069:                 }
                   3070:             }
                   3071:         }
                   3072:     }
                   3073: 
1.32      matthew  3074:     $result.=<<"END";
                   3075: var current = new Object();
1.165     raeburn  3076: current.radiovalue = $radioval;
                   3077: current.argfield = $argfield;
1.32      matthew  3078: 
                   3079: function changed_radio(choice,currentform) {
                   3080:     var choicearg = choice + 'arg';
                   3081:     // If a radio button in changed, we need to change the argfield
                   3082:     if (current.radiovalue != choice) {
                   3083:         current.radiovalue = choice;
                   3084:         if (current.argfield != null) {
                   3085:             currentform.elements[current.argfield].value = '';
                   3086:         }
                   3087:         if (choice == 'nochange') {
                   3088:             current.argfield = null;
                   3089:         } else {
                   3090:             current.argfield = choicearg;
                   3091:             switch(choice) {
                   3092:                 case 'krb': 
                   3093:                     currentform.elements[current.argfield].value = 
                   3094:                         "$in{'kerb_def_dom'}";
                   3095:                 break;
                   3096:               default:
                   3097:                 break;
                   3098:             }
                   3099:         }
                   3100:     }
                   3101:     return;
                   3102: }
1.22      www      3103: 
1.32      matthew  3104: function changed_text(choice,currentform) {
                   3105:     var choicearg = choice + 'arg';
                   3106:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 3107:         $Javascript_toUpperCase
1.32      matthew  3108:         // clear old field
                   3109:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   3110:             currentform.elements[current.argfield].value = '';
                   3111:         }
                   3112:         current.argfield = choicearg;
                   3113:     }
                   3114:     set_auth_radio_buttons(choice,currentform);
                   3115:     return;
1.20      www      3116: }
1.32      matthew  3117: 
                   3118: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  3119:     var numauthchoices = currentform.login.length;
                   3120:     if (typeof numauthchoices  == "undefined") {
                   3121:         return;
                   3122:     } 
1.32      matthew  3123:     var i=0;
1.986     raeburn  3124:     while (i < numauthchoices) {
1.32      matthew  3125:         if (currentform.login[i].value == newvalue) { break; }
                   3126:         i++;
                   3127:     }
1.986     raeburn  3128:     if (i == numauthchoices) {
1.32      matthew  3129:         return;
                   3130:     }
                   3131:     current.radiovalue = newvalue;
                   3132:     currentform.login[i].checked = true;
                   3133:     return;
                   3134: }
                   3135: END
                   3136:     return $result;
                   3137: }
                   3138: 
1.1106    raeburn  3139: sub authform_authorwarning {
1.32      matthew  3140:     my $result='';
1.144     matthew  3141:     $result='<i>'.
                   3142:         &mt('As a general rule, only authors or co-authors should be '.
                   3143:             'filesystem authenticated '.
                   3144:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  3145:     return $result;
                   3146: }
                   3147: 
1.1106    raeburn  3148: sub authform_nochange {
1.32      matthew  3149:     my %in = (
                   3150:               formname => 'document.cu',
                   3151:               kerb_def_dom => 'MSU.EDU',
                   3152:               @_,
                   3153:           );
1.1106    raeburn  3154:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586     raeburn  3155:     my $result;
1.1104    raeburn  3156:     if (!$authnum) {
1.1105    raeburn  3157:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  3158:     } else {
                   3159:         $result = '<label>'.&mt('[_1] Do not change login data',
                   3160:                   '<input type="radio" name="login" value="nochange" '.
                   3161:                   'checked="checked" onclick="'.
1.281     albertel 3162:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   3163: 	    '</label>';
1.586     raeburn  3164:     }
1.32      matthew  3165:     return $result;
                   3166: }
                   3167: 
1.591     raeburn  3168: sub authform_kerberos {
1.32      matthew  3169:     my %in = (
                   3170:               formname => 'document.cu',
                   3171:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 3172:               kerb_def_auth => 'krb4',
1.32      matthew  3173:               @_,
                   3174:               );
1.586     raeburn  3175:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1259    raeburn  3176:         $autharg,$jscall,$disabled);
1.1106    raeburn  3177:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 3178:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   3179:        $check5 = ' checked="checked"';
1.80      albertel 3180:     } else {
1.772     bisitz   3181:        $check4 = ' checked="checked"';
1.80      albertel 3182:     }
1.1259    raeburn  3183:     if ($in{'readonly'}) {
                   3184:         $disabled = ' disabled="disabled"';
                   3185:     }
1.165     raeburn  3186:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  3187:     if (defined($in{'curr_authtype'})) {
                   3188:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   3189:             $krbcheck = ' checked="checked"';
1.623     raeburn  3190:             if (defined($in{'mode'})) {
                   3191:                 if ($in{'mode'} eq 'modifyuser') {
                   3192:                     $krbcheck = '';
                   3193:                 }
                   3194:             }
1.591     raeburn  3195:             if (defined($in{'curr_kerb_ver'})) {
                   3196:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   3197:                     $check5 = ' checked="checked"';
1.591     raeburn  3198:                     $check4 = '';
                   3199:                 } else {
1.772     bisitz   3200:                     $check4 = ' checked="checked"';
1.591     raeburn  3201:                     $check5 = '';
                   3202:                 }
1.586     raeburn  3203:             }
1.591     raeburn  3204:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  3205:                 $krbarg = $in{'curr_autharg'};
                   3206:             }
1.586     raeburn  3207:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  3208:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3209:                     $result = 
                   3210:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   3211:         $in{'curr_autharg'},$krbver);
                   3212:                 } else {
                   3213:                     $result =
                   3214:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   3215:                 }
                   3216:                 return $result; 
                   3217:             }
                   3218:         }
                   3219:     } else {
                   3220:         if ($authnum == 1) {
1.784     bisitz   3221:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  3222:         }
                   3223:     }
1.586     raeburn  3224:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   3225:         return;
1.587     raeburn  3226:     } elsif ($authtype eq '') {
1.591     raeburn  3227:         if (defined($in{'mode'})) {
1.587     raeburn  3228:             if ($in{'mode'} eq 'modifycourse') {
                   3229:                 if ($authnum == 1) {
1.1259    raeburn  3230:                     $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587     raeburn  3231:                 }
                   3232:             }
                   3233:         }
1.586     raeburn  3234:     }
                   3235:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   3236:     if ($authtype eq '') {
                   3237:         $authtype = '<input type="radio" name="login" value="krb" '.
                   3238:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1259    raeburn  3239:                     $krbcheck.$disabled.' />';
1.586     raeburn  3240:     }
                   3241:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106    raeburn  3242:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  3243:          $in{'curr_authtype'} eq 'krb5') ||
1.1106    raeburn  3244:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  3245:          $in{'curr_authtype'} eq 'krb4')) {
                   3246:         $result .= &mt
1.144     matthew  3247:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 3248:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  3249:          '<label>'.$authtype,
1.281     albertel 3250:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  3251:              'value="'.$krbarg.'" '.
1.1259    raeburn  3252:              'onchange="'.$jscall.'"'.$disabled.' />',
                   3253:          '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
                   3254:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281     albertel 3255: 	 '</label>');
1.586     raeburn  3256:     } elsif ($can_assign{'krb4'}) {
                   3257:         $result .= &mt
                   3258:         ('[_1] Kerberos authenticated with domain [_2] '.
                   3259:          '[_3] Version 4 [_4]',
                   3260:          '<label>'.$authtype,
                   3261:          '</label><input type="text" size="10" name="krbarg" '.
                   3262:              'value="'.$krbarg.'" '.
1.1259    raeburn  3263:              'onchange="'.$jscall.'"'.$disabled.' />',
1.586     raeburn  3264:          '<label><input type="hidden" name="krbver" value="4" />',
                   3265:          '</label>');
                   3266:     } elsif ($can_assign{'krb5'}) {
                   3267:         $result .= &mt
                   3268:         ('[_1] Kerberos authenticated with domain [_2] '.
                   3269:          '[_3] Version 5 [_4]',
                   3270:          '<label>'.$authtype,
                   3271:          '</label><input type="text" size="10" name="krbarg" '.
                   3272:              'value="'.$krbarg.'" '.
1.1259    raeburn  3273:              'onchange="'.$jscall.'"'.$disabled.' />',
1.586     raeburn  3274:          '<label><input type="hidden" name="krbver" value="5" />',
                   3275:          '</label>');
                   3276:     }
1.32      matthew  3277:     return $result;
                   3278: }
                   3279: 
1.1106    raeburn  3280: sub authform_internal {
1.586     raeburn  3281:     my %in = (
1.32      matthew  3282:                 formname => 'document.cu',
                   3283:                 kerb_def_dom => 'MSU.EDU',
                   3284:                 @_,
                   3285:                 );
1.1259    raeburn  3286:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106    raeburn  3287:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259    raeburn  3288:     if ($in{'readonly'}) {
                   3289:         $disabled = ' disabled="disabled"';
                   3290:     }
1.591     raeburn  3291:     if (defined($in{'curr_authtype'})) {
                   3292:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  3293:             if ($can_assign{'int'}) {
1.772     bisitz   3294:                 $intcheck = 'checked="checked" ';
1.623     raeburn  3295:                 if (defined($in{'mode'})) {
                   3296:                     if ($in{'mode'} eq 'modifyuser') {
                   3297:                         $intcheck = '';
                   3298:                     }
                   3299:                 }
1.591     raeburn  3300:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3301:                     $intarg = $in{'curr_autharg'};
                   3302:                 }
                   3303:             } else {
                   3304:                 $result = &mt('Currently internally authenticated.');
                   3305:                 return $result;
1.165     raeburn  3306:             }
                   3307:         }
1.586     raeburn  3308:     } else {
                   3309:         if ($authnum == 1) {
1.784     bisitz   3310:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  3311:         }
                   3312:     }
                   3313:     if (!$can_assign{'int'}) {
                   3314:         return;
1.587     raeburn  3315:     } elsif ($authtype eq '') {
1.591     raeburn  3316:         if (defined($in{'mode'})) {
1.587     raeburn  3317:             if ($in{'mode'} eq 'modifycourse') {
                   3318:                 if ($authnum == 1) {
1.1259    raeburn  3319:                     $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587     raeburn  3320:                 }
                   3321:             }
                   3322:         }
1.165     raeburn  3323:     }
1.586     raeburn  3324:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   3325:     if ($authtype eq '') {
                   3326:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1259    raeburn  3327:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3328:     }
1.605     bisitz   3329:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1259    raeburn  3330:                $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3331:     $result = &mt
1.144     matthew  3332:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  3333:          '<label>'.$authtype,'</label>'.$autharg);
1.1259    raeburn  3334:     $result.='<label><input type="checkbox" name="visible" onclick="if (this.checked) { this.form.intarg.type='."'text'".' } else { this.form.intarg.type='."'password'".' }"'.$disabled.' />'.&mt('Visible input').'</label>';
1.32      matthew  3335:     return $result;
                   3336: }
                   3337: 
1.1104    raeburn  3338: sub authform_local {
1.32      matthew  3339:     my %in = (
                   3340:               formname => 'document.cu',
                   3341:               kerb_def_dom => 'MSU.EDU',
                   3342:               @_,
                   3343:               );
1.1259    raeburn  3344:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106    raeburn  3345:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259    raeburn  3346:     if ($in{'readonly'}) {
                   3347:         $disabled = ' disabled="disabled"';
                   3348:     } 
1.591     raeburn  3349:     if (defined($in{'curr_authtype'})) {
                   3350:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  3351:             if ($can_assign{'loc'}) {
1.772     bisitz   3352:                 $loccheck = 'checked="checked" ';
1.623     raeburn  3353:                 if (defined($in{'mode'})) {
                   3354:                     if ($in{'mode'} eq 'modifyuser') {
                   3355:                         $loccheck = '';
                   3356:                     }
                   3357:                 }
1.591     raeburn  3358:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  3359:                     $locarg = $in{'curr_autharg'};
                   3360:                 }
                   3361:             } else {
                   3362:                 $result = &mt('Currently using local (institutional) authentication.');
                   3363:                 return $result;
1.165     raeburn  3364:             }
                   3365:         }
1.586     raeburn  3366:     } else {
                   3367:         if ($authnum == 1) {
1.784     bisitz   3368:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  3369:         }
                   3370:     }
                   3371:     if (!$can_assign{'loc'}) {
                   3372:         return;
1.587     raeburn  3373:     } elsif ($authtype eq '') {
1.591     raeburn  3374:         if (defined($in{'mode'})) {
1.587     raeburn  3375:             if ($in{'mode'} eq 'modifycourse') {
                   3376:                 if ($authnum == 1) {
1.1259    raeburn  3377:                     $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587     raeburn  3378:                 }
                   3379:             }
                   3380:         }
1.165     raeburn  3381:     }
1.586     raeburn  3382:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   3383:     if ($authtype eq '') {
                   3384:         $authtype = '<input type="radio" name="login" value="loc" '.
                   3385:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1259    raeburn  3386:                     $jscall.'"'.$disabled.' />';
1.586     raeburn  3387:     }
                   3388:     $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1259    raeburn  3389:                $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3390:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   3391:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  3392:     return $result;
                   3393: }
                   3394: 
1.1106    raeburn  3395: sub authform_filesystem {
1.32      matthew  3396:     my %in = (
                   3397:               formname => 'document.cu',
                   3398:               kerb_def_dom => 'MSU.EDU',
                   3399:               @_,
                   3400:               );
1.1259    raeburn  3401:     my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1106    raeburn  3402:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259    raeburn  3403:     if ($in{'readonly'}) {
                   3404:         $disabled = ' disabled="disabled"';
                   3405:     }
1.591     raeburn  3406:     if (defined($in{'curr_authtype'})) {
                   3407:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  3408:             if ($can_assign{'fsys'}) {
1.772     bisitz   3409:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  3410:                 if (defined($in{'mode'})) {
                   3411:                     if ($in{'mode'} eq 'modifyuser') {
                   3412:                         $fsyscheck = '';
                   3413:                     }
                   3414:                 }
1.586     raeburn  3415:             } else {
                   3416:                 $result = &mt('Currently Filesystem Authenticated.');
                   3417:                 return $result;
1.1259    raeburn  3418:             }
1.586     raeburn  3419:         }
                   3420:     } else {
                   3421:         if ($authnum == 1) {
1.784     bisitz   3422:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  3423:         }
                   3424:     }
                   3425:     if (!$can_assign{'fsys'}) {
                   3426:         return;
1.587     raeburn  3427:     } elsif ($authtype eq '') {
1.591     raeburn  3428:         if (defined($in{'mode'})) {
1.587     raeburn  3429:             if ($in{'mode'} eq 'modifycourse') {
                   3430:                 if ($authnum == 1) {
1.1259    raeburn  3431:                     $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587     raeburn  3432:                 }
                   3433:             }
                   3434:         }
1.586     raeburn  3435:     }
                   3436:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   3437:     if ($authtype eq '') {
                   3438:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   3439:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1259    raeburn  3440:                     $jscall.'"'.$disabled.' />';
1.586     raeburn  3441:     }
                   3442:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
1.1259    raeburn  3443:                ' onchange="'.$jscall.'"'.$disabled.' />';
1.586     raeburn  3444:     $result = &mt
1.144     matthew  3445:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 3446:          '<label><input type="radio" name="login" value="fsys" '.
1.1259    raeburn  3447:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />',
1.605     bisitz   3448:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.1259    raeburn  3449:                   'onchange="'.$jscall.'"'.$disabled.' />');
1.32      matthew  3450:     return $result;
                   3451: }
                   3452: 
1.586     raeburn  3453: sub get_assignable_auth {
                   3454:     my ($dom) = @_;
                   3455:     if ($dom eq '') {
                   3456:         $dom = $env{'request.role.domain'};
                   3457:     }
                   3458:     my %can_assign = (
                   3459:                           krb4 => 1,
                   3460:                           krb5 => 1,
                   3461:                           int  => 1,
                   3462:                           loc  => 1,
                   3463:                      );
                   3464:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   3465:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   3466:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   3467:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   3468:             my $context;
                   3469:             if ($env{'request.role'} =~ /^au/) {
                   3470:                 $context = 'author';
1.1259    raeburn  3471:             } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586     raeburn  3472:                 $context = 'domain';
                   3473:             } elsif ($env{'request.course.id'}) {
                   3474:                 $context = 'course';
                   3475:             }
                   3476:             if ($context) {
                   3477:                 if (ref($authhash->{$context}) eq 'HASH') {
                   3478:                    %can_assign = %{$authhash->{$context}}; 
                   3479:                 }
                   3480:             }
                   3481:         }
                   3482:     }
                   3483:     my $authnum = 0;
                   3484:     foreach my $key (keys(%can_assign)) {
                   3485:         if ($can_assign{$key}) {
                   3486:             $authnum ++;
                   3487:         }
                   3488:     }
                   3489:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   3490:         $authnum --;
                   3491:     }
                   3492:     return ($authnum,%can_assign);
                   3493: }
                   3494: 
1.80      albertel 3495: ###############################################################
                   3496: ##    Get Kerberos Defaults for Domain                 ##
                   3497: ###############################################################
                   3498: ##
                   3499: ## Returns default kerberos version and an associated argument
                   3500: ## as listed in file domain.tab. If not listed, provides
                   3501: ## appropriate default domain and kerberos version.
                   3502: ##
                   3503: #-------------------------------------------
                   3504: 
                   3505: =pod
                   3506: 
1.648     raeburn  3507: =item * &get_kerberos_defaults()
1.80      albertel 3508: 
                   3509: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  3510: version and domain. If not found, it defaults to version 4 and the 
                   3511: domain of the server.
1.80      albertel 3512: 
1.648     raeburn  3513: =over 4
                   3514: 
1.80      albertel 3515: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   3516: 
1.648     raeburn  3517: =back
                   3518: 
                   3519: =back
                   3520: 
1.80      albertel 3521: =cut
                   3522: 
                   3523: #-------------------------------------------
                   3524: sub get_kerberos_defaults {
                   3525:     my $domain=shift;
1.641     raeburn  3526:     my ($krbdef,$krbdefdom);
                   3527:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   3528:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   3529:         $krbdef = $domdefaults{'auth_def'};
                   3530:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   3531:     } else {
1.80      albertel 3532:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   3533:         my $krbdefdom=$1;
                   3534:         $krbdefdom=~tr/a-z/A-Z/;
                   3535:         $krbdef = "krb4";
                   3536:     }
                   3537:     return ($krbdef,$krbdefdom);
                   3538: }
1.112     bowersj2 3539: 
1.32      matthew  3540: 
1.46      matthew  3541: ###############################################################
                   3542: ##                Thesaurus Functions                        ##
                   3543: ###############################################################
1.20      www      3544: 
1.46      matthew  3545: =pod
1.20      www      3546: 
1.112     bowersj2 3547: =head1 Thesaurus Functions
                   3548: 
                   3549: =over 4
                   3550: 
1.648     raeburn  3551: =item * &initialize_keywords()
1.46      matthew  3552: 
                   3553: Initializes the package variable %Keywords if it is empty.  Uses the
                   3554: package variable $thesaurus_db_file.
                   3555: 
                   3556: =cut
                   3557: 
                   3558: ###################################################
                   3559: 
                   3560: sub initialize_keywords {
                   3561:     return 1 if (scalar keys(%Keywords));
                   3562:     # If we are here, %Keywords is empty, so fill it up
                   3563:     #   Make sure the file we need exists...
                   3564:     if (! -e $thesaurus_db_file) {
                   3565:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   3566:                                  " failed because it does not exist");
                   3567:         return 0;
                   3568:     }
                   3569:     #   Set up the hash as a database
                   3570:     my %thesaurus_db;
                   3571:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3572:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3573:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   3574:                                  $thesaurus_db_file);
                   3575:         return 0;
                   3576:     } 
                   3577:     #  Get the average number of appearances of a word.
                   3578:     my $avecount = $thesaurus_db{'average.count'};
                   3579:     #  Put keywords (those that appear > average) into %Keywords
                   3580:     while (my ($word,$data)=each (%thesaurus_db)) {
                   3581:         my ($count,undef) = split /:/,$data;
                   3582:         $Keywords{$word}++ if ($count > $avecount);
                   3583:     }
                   3584:     untie %thesaurus_db;
                   3585:     # Remove special values from %Keywords.
1.356     albertel 3586:     foreach my $value ('total.count','average.count') {
                   3587:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  3588:   }
1.46      matthew  3589:     return 1;
                   3590: }
                   3591: 
                   3592: ###################################################
                   3593: 
                   3594: =pod
                   3595: 
1.648     raeburn  3596: =item * &keyword($word)
1.46      matthew  3597: 
                   3598: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   3599: than the average number of times in the thesaurus database.  Calls 
                   3600: &initialize_keywords
                   3601: 
                   3602: =cut
                   3603: 
                   3604: ###################################################
1.20      www      3605: 
                   3606: sub keyword {
1.46      matthew  3607:     return if (!&initialize_keywords());
                   3608:     my $word=lc(shift());
                   3609:     $word=~s/\W//g;
                   3610:     return exists($Keywords{$word});
1.20      www      3611: }
1.46      matthew  3612: 
                   3613: ###############################################################
                   3614: 
                   3615: =pod 
1.20      www      3616: 
1.648     raeburn  3617: =item * &get_related_words()
1.46      matthew  3618: 
1.160     matthew  3619: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  3620: an array of words.  If the keyword is not in the thesaurus, an empty array
                   3621: will be returned.  The order of the words returned is determined by the
                   3622: database which holds them.
                   3623: 
                   3624: Uses global $thesaurus_db_file.
                   3625: 
1.1057    foxr     3626: 
1.46      matthew  3627: =cut
                   3628: 
                   3629: ###############################################################
                   3630: sub get_related_words {
                   3631:     my $keyword = shift;
                   3632:     my %thesaurus_db;
                   3633:     if (! -e $thesaurus_db_file) {
                   3634:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3635:                                  "failed because the file does not exist");
                   3636:         return ();
                   3637:     }
                   3638:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3639:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3640:         return ();
                   3641:     } 
                   3642:     my @Words=();
1.429     www      3643:     my $count=0;
1.46      matthew  3644:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3645: 	# The first element is the number of times
                   3646: 	# the word appears.  We do not need it now.
1.429     www      3647: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3648: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3649: 	my $threshold=$mostfrequentcount/10;
                   3650:         foreach my $possibleword (@RelatedWords) {
                   3651:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3652:             if ($wordcount>$threshold) {
                   3653: 		push(@Words,$word);
                   3654:                 $count++;
                   3655:                 if ($count>10) { last; }
                   3656: 	    }
1.20      www      3657:         }
                   3658:     }
1.46      matthew  3659:     untie %thesaurus_db;
                   3660:     return @Words;
1.14      harris41 3661: }
1.1090    foxr     3662: ###############################################################
                   3663: #
                   3664: #  Spell checking
                   3665: #
                   3666: 
                   3667: =pod
                   3668: 
1.1142    raeburn  3669: =back
                   3670: 
1.1090    foxr     3671: =head1 Spell checking
                   3672: 
                   3673: =over 4
                   3674: 
                   3675: =item * &check_spelling($wordlist $language)
                   3676: 
                   3677: Takes a string containing words and feeds it to an external
                   3678: spellcheck program via a pipeline. Returns a string containing
                   3679: them mis-spelled words.
                   3680: 
                   3681: Parameters:
                   3682: 
                   3683: =over 4
                   3684: 
                   3685: =item - $wordlist
                   3686: 
                   3687: String that will be fed into the spellcheck program.
                   3688: 
                   3689: =item - $language
                   3690: 
                   3691: Language string that specifies the language for which the spell
                   3692: check will be performed.
                   3693: 
                   3694: =back
                   3695: 
                   3696: =back
                   3697: 
                   3698: Note: This sub assumes that aspell is installed.
                   3699: 
                   3700: 
                   3701: =cut
                   3702: 
1.46      matthew  3703: 
1.1090    foxr     3704: sub check_spelling {
                   3705:     my ($wordlist, $language) = @_;
1.1091    foxr     3706:     my @misspellings;
                   3707:     
                   3708:     # Generate the speller and set the langauge.
                   3709:     # if explicitly selected:
1.1090    foxr     3710: 
1.1091    foxr     3711:     my $speller = Text::Aspell->new;
1.1090    foxr     3712:     if ($language) {
1.1091    foxr     3713: 	$speller->set_option('lang', $language);
1.1090    foxr     3714:     }
                   3715: 
1.1091    foxr     3716:     # Turn the word list into an array of words by splittingon whitespace
1.1090    foxr     3717: 
1.1091    foxr     3718:     my @words = split(/\s+/, $wordlist);
1.1090    foxr     3719: 
1.1091    foxr     3720:     foreach my $word (@words) {
                   3721: 	if(! $speller->check($word)) {
                   3722: 	    push(@misspellings, $word);
1.1090    foxr     3723: 	}
                   3724:     }
1.1091    foxr     3725:     return join(' ', @misspellings);
                   3726:     
1.1090    foxr     3727: }
                   3728: 
1.61      www      3729: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3730: =pod
                   3731: 
1.112     bowersj2 3732: =head1 User Name Functions
                   3733: 
                   3734: =over 4
                   3735: 
1.648     raeburn  3736: =item * &plainname($uname,$udom,$first)
1.81      albertel 3737: 
1.112     bowersj2 3738: Takes a users logon name and returns it as a string in
1.226     albertel 3739: "first middle last generation" form 
                   3740: if $first is set to 'lastname' then it returns it as
                   3741: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3742: 
                   3743: =cut
1.61      www      3744: 
1.295     www      3745: 
1.81      albertel 3746: ###############################################################
1.61      www      3747: sub plainname {
1.226     albertel 3748:     my ($uname,$udom,$first)=@_;
1.537     albertel 3749:     return if (!defined($uname) || !defined($udom));
1.295     www      3750:     my %names=&getnames($uname,$udom);
1.226     albertel 3751:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3752: 					  $names{'middlename'},
                   3753: 					  $names{'lastname'},
                   3754: 					  $names{'generation'},$first);
                   3755:     $name=~s/^\s+//;
1.62      www      3756:     $name=~s/\s+$//;
                   3757:     $name=~s/\s+/ /g;
1.353     albertel 3758:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3759:     return $name;
1.61      www      3760: }
1.66      www      3761: 
                   3762: # -------------------------------------------------------------------- Nickname
1.81      albertel 3763: =pod
                   3764: 
1.648     raeburn  3765: =item * &nickname($uname,$udom)
1.81      albertel 3766: 
                   3767: Gets a users name and returns it as a string as
                   3768: 
                   3769: "&quot;nickname&quot;"
1.66      www      3770: 
1.81      albertel 3771: if the user has a nickname or
                   3772: 
                   3773: "first middle last generation"
                   3774: 
                   3775: if the user does not
                   3776: 
                   3777: =cut
1.66      www      3778: 
                   3779: sub nickname {
                   3780:     my ($uname,$udom)=@_;
1.537     albertel 3781:     return if (!defined($uname) || !defined($udom));
1.295     www      3782:     my %names=&getnames($uname,$udom);
1.68      albertel 3783:     my $name=$names{'nickname'};
1.66      www      3784:     if ($name) {
                   3785:        $name='&quot;'.$name.'&quot;'; 
                   3786:     } else {
                   3787:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3788: 	     $names{'lastname'}.' '.$names{'generation'};
                   3789:        $name=~s/\s+$//;
                   3790:        $name=~s/\s+/ /g;
                   3791:     }
                   3792:     return $name;
                   3793: }
                   3794: 
1.295     www      3795: sub getnames {
                   3796:     my ($uname,$udom)=@_;
1.537     albertel 3797:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3798:     if ($udom eq 'public' && $uname eq 'public') {
                   3799: 	return ('lastname' => &mt('Public'));
                   3800:     }
1.295     www      3801:     my $id=$uname.':'.$udom;
                   3802:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3803:     if ($cached) {
                   3804: 	return %{$names};
                   3805:     } else {
                   3806: 	my %loadnames=&Apache::lonnet::get('environment',
                   3807:                     ['firstname','middlename','lastname','generation','nickname'],
                   3808: 					 $udom,$uname);
                   3809: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3810: 	return %loadnames;
                   3811:     }
                   3812: }
1.61      www      3813: 
1.542     raeburn  3814: # -------------------------------------------------------------------- getemails
1.648     raeburn  3815: 
1.542     raeburn  3816: =pod
                   3817: 
1.648     raeburn  3818: =item * &getemails($uname,$udom)
1.542     raeburn  3819: 
                   3820: Gets a user's email information and returns it as a hash with keys:
                   3821: notification, critnotification, permanentemail
                   3822: 
                   3823: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3824: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3825:  
1.648     raeburn  3826: 
1.542     raeburn  3827: =cut
                   3828: 
1.648     raeburn  3829: 
1.466     albertel 3830: sub getemails {
                   3831:     my ($uname,$udom)=@_;
                   3832:     if ($udom eq 'public' && $uname eq 'public') {
                   3833: 	return;
                   3834:     }
1.467     www      3835:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3836:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3837:     my $id=$uname.':'.$udom;
                   3838:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3839:     if ($cached) {
                   3840: 	return %{$names};
                   3841:     } else {
                   3842: 	my %loadnames=&Apache::lonnet::get('environment',
                   3843:                     			   ['notification','critnotification',
                   3844: 					    'permanentemail'],
                   3845: 					   $udom,$uname);
                   3846: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3847: 	return %loadnames;
                   3848:     }
                   3849: }
                   3850: 
1.551     albertel 3851: sub flush_email_cache {
                   3852:     my ($uname,$udom)=@_;
                   3853:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3854:     if (!$uname) { $uname=$env{'user.name'};   }
                   3855:     return if ($udom eq 'public' && $uname eq 'public');
                   3856:     my $id=$uname.':'.$udom;
                   3857:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3858: }
                   3859: 
1.728     raeburn  3860: # -------------------------------------------------------------------- getlangs
                   3861: 
                   3862: =pod
                   3863: 
                   3864: =item * &getlangs($uname,$udom)
                   3865: 
                   3866: Gets a user's language preference and returns it as a hash with key:
                   3867: language.
                   3868: 
                   3869: =cut
                   3870: 
                   3871: 
                   3872: sub getlangs {
                   3873:     my ($uname,$udom) = @_;
                   3874:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3875:     if (!$uname) { $uname=$env{'user.name'};   }
                   3876:     my $id=$uname.':'.$udom;
                   3877:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3878:     if ($cached) {
                   3879:         return %{$langs};
                   3880:     } else {
                   3881:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3882:                                            $udom,$uname);
                   3883:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3884:         return %loadlangs;
                   3885:     }
                   3886: }
                   3887: 
                   3888: sub flush_langs_cache {
                   3889:     my ($uname,$udom)=@_;
                   3890:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3891:     if (!$uname) { $uname=$env{'user.name'};   }
                   3892:     return if ($udom eq 'public' && $uname eq 'public');
                   3893:     my $id=$uname.':'.$udom;
                   3894:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3895: }
                   3896: 
1.61      www      3897: # ------------------------------------------------------------------ Screenname
1.81      albertel 3898: 
                   3899: =pod
                   3900: 
1.648     raeburn  3901: =item * &screenname($uname,$udom)
1.81      albertel 3902: 
                   3903: Gets a users screenname and returns it as a string
                   3904: 
                   3905: =cut
1.61      www      3906: 
                   3907: sub screenname {
                   3908:     my ($uname,$udom)=@_;
1.258     albertel 3909:     if ($uname eq $env{'user.name'} &&
                   3910: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3911:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3912:     return $names{'screenname'};
1.62      www      3913: }
                   3914: 
1.212     albertel 3915: 
1.802     bisitz   3916: # ------------------------------------------------------------- Confirm Wrapper
                   3917: =pod
                   3918: 
1.1142    raeburn  3919: =item * &confirmwrapper($message)
1.802     bisitz   3920: 
                   3921: Wrap messages about completion of operation in box
                   3922: 
                   3923: =cut
                   3924: 
                   3925: sub confirmwrapper {
                   3926:     my ($message)=@_;
                   3927:     if ($message) {
                   3928:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3929:                .$message."\n"
                   3930:                .'</div>'."\n";
                   3931:     } else {
                   3932:         return $message;
                   3933:     }
                   3934: }
                   3935: 
1.62      www      3936: # ------------------------------------------------------------- Message Wrapper
                   3937: 
                   3938: sub messagewrapper {
1.369     www      3939:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3940:     return 
1.441     albertel 3941:         '<a href="/adm/email?compose=individual&amp;'.
                   3942:         'recname='.$username.'&amp;recdom='.$domain.
                   3943: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3944:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3945: }
1.802     bisitz   3946: 
1.74      www      3947: # --------------------------------------------------------------- Notes Wrapper
                   3948: 
                   3949: sub noteswrapper {
                   3950:     my ($link,$un,$do)=@_;
                   3951:     return 
1.896     amueller 3952: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3953: }
1.802     bisitz   3954: 
1.62      www      3955: # ------------------------------------------------------------- Aboutme Wrapper
                   3956: 
                   3957: sub aboutmewrapper {
1.1070    raeburn  3958:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3959:     if (!defined($username)  && !defined($domain)) {
                   3960:         return;
                   3961:     }
1.1096    raeburn  3962:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3963: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3964: }
                   3965: 
                   3966: # ------------------------------------------------------------ Syllabus Wrapper
                   3967: 
                   3968: sub syllabuswrapper {
1.707     bisitz   3969:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3970:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3971: }
1.14      harris41 3972: 
1.802     bisitz   3973: # -----------------------------------------------------------------------------
                   3974: 
1.208     matthew  3975: sub track_student_link {
1.887     raeburn  3976:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3977:     my $link ="/adm/trackstudent?";
1.208     matthew  3978:     my $title = 'View recent activity';
                   3979:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3980:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3981:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3982:         $title .= ' of this student';
1.268     albertel 3983:     } 
1.208     matthew  3984:     if (defined($target) && $target !~ /^\s*$/) {
                   3985:         $target = qq{target="$target"};
                   3986:     } else {
                   3987:         $target = '';
                   3988:     }
1.268     albertel 3989:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3990:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3991:     $title = &mt($title);
                   3992:     $linktext = &mt($linktext);
1.448     albertel 3993:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3994: 	&help_open_topic('View_recent_activity');
1.208     matthew  3995: }
                   3996: 
1.781     raeburn  3997: sub slot_reservations_link {
                   3998:     my ($linktext,$sname,$sdom,$target) = @_;
                   3999:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   4000:     my $title = 'View slot reservation history';
                   4001:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   4002:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   4003:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   4004:         $title .= ' of this student';
                   4005:     }
                   4006:     if (defined($target) && $target !~ /^\s*$/) {
                   4007:         $target = qq{target="$target"};
                   4008:     } else {
                   4009:         $target = '';
                   4010:     }
                   4011:     $title = &mt($title);
                   4012:     $linktext = &mt($linktext);
                   4013:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   4014: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   4015: 
                   4016: }
                   4017: 
1.508     www      4018: # ===================================================== Display a student photo
                   4019: 
                   4020: 
1.509     albertel 4021: sub student_image_tag {
1.508     www      4022:     my ($domain,$user)=@_;
                   4023:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   4024:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   4025: 	return '<img src="'.$imgsrc.'" align="right" />';
                   4026:     } else {
                   4027: 	return '';
                   4028:     }
                   4029: }
                   4030: 
1.112     bowersj2 4031: =pod
                   4032: 
                   4033: =back
                   4034: 
                   4035: =head1 Access .tab File Data
                   4036: 
                   4037: =over 4
                   4038: 
1.648     raeburn  4039: =item * &languageids() 
1.112     bowersj2 4040: 
                   4041: returns list of all language ids
                   4042: 
                   4043: =cut
                   4044: 
1.14      harris41 4045: sub languageids {
1.16      harris41 4046:     return sort(keys(%language));
1.14      harris41 4047: }
                   4048: 
1.112     bowersj2 4049: =pod
                   4050: 
1.648     raeburn  4051: =item * &languagedescription() 
1.112     bowersj2 4052: 
                   4053: returns description of a specified language id
                   4054: 
                   4055: =cut
                   4056: 
1.14      harris41 4057: sub languagedescription {
1.125     www      4058:     my $code=shift;
                   4059:     return  ($supported_language{$code}?'* ':'').
                   4060:             $language{$code}.
1.126     www      4061: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      4062: }
                   4063: 
1.1048    foxr     4064: =pod
                   4065: 
                   4066: =item * &plainlanguagedescription
                   4067: 
                   4068: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   4069: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   4070: 
                   4071: =cut
                   4072: 
1.145     www      4073: sub plainlanguagedescription {
                   4074:     my $code=shift;
                   4075:     return $language{$code};
                   4076: }
                   4077: 
1.1048    foxr     4078: =pod
                   4079: 
                   4080: =item * &supportedlanguagecode
                   4081: 
                   4082: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   4083: code.
                   4084: 
                   4085: =cut
                   4086: 
1.145     www      4087: sub supportedlanguagecode {
                   4088:     my $code=shift;
                   4089:     return $supported_language{$code};
1.97      www      4090: }
                   4091: 
1.112     bowersj2 4092: =pod
                   4093: 
1.1048    foxr     4094: =item * &latexlanguage()
                   4095: 
                   4096: Given a language key code returns the correspondnig language to use
                   4097: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   4098: is no supported hyphenation for the language code.
                   4099: 
                   4100: =cut
                   4101: 
                   4102: sub latexlanguage {
                   4103:     my $code = shift;
                   4104:     return $latex_language{$code};
                   4105: }
                   4106: 
                   4107: =pod
                   4108: 
                   4109: =item * &latexhyphenation()
                   4110: 
                   4111: Same as above but what's supplied is the language as it might be stored
                   4112: in the metadata.
                   4113: 
                   4114: =cut
                   4115: 
                   4116: sub latexhyphenation {
                   4117:     my $key = shift;
                   4118:     return $latex_language_bykey{$key};
                   4119: }
                   4120: 
                   4121: =pod
                   4122: 
1.648     raeburn  4123: =item * &copyrightids() 
1.112     bowersj2 4124: 
                   4125: returns list of all copyrights
                   4126: 
                   4127: =cut
                   4128: 
                   4129: sub copyrightids {
                   4130:     return sort(keys(%cprtag));
                   4131: }
                   4132: 
                   4133: =pod
                   4134: 
1.648     raeburn  4135: =item * &copyrightdescription() 
1.112     bowersj2 4136: 
                   4137: returns description of a specified copyright id
                   4138: 
                   4139: =cut
                   4140: 
                   4141: sub copyrightdescription {
1.166     www      4142:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 4143: }
1.197     matthew  4144: 
                   4145: =pod
                   4146: 
1.648     raeburn  4147: =item * &source_copyrightids() 
1.192     taceyjo1 4148: 
                   4149: returns list of all source copyrights
                   4150: 
                   4151: =cut
                   4152: 
                   4153: sub source_copyrightids {
                   4154:     return sort(keys(%scprtag));
                   4155: }
                   4156: 
                   4157: =pod
                   4158: 
1.648     raeburn  4159: =item * &source_copyrightdescription() 
1.192     taceyjo1 4160: 
                   4161: returns description of a specified source copyright id
                   4162: 
                   4163: =cut
                   4164: 
                   4165: sub source_copyrightdescription {
                   4166:     return &mt($scprtag{shift(@_)});
                   4167: }
1.112     bowersj2 4168: 
                   4169: =pod
                   4170: 
1.648     raeburn  4171: =item * &filecategories() 
1.112     bowersj2 4172: 
                   4173: returns list of all file categories
                   4174: 
                   4175: =cut
                   4176: 
                   4177: sub filecategories {
                   4178:     return sort(keys(%category_extensions));
                   4179: }
                   4180: 
                   4181: =pod
                   4182: 
1.648     raeburn  4183: =item * &filecategorytypes() 
1.112     bowersj2 4184: 
                   4185: returns list of file types belonging to a given file
                   4186: category
                   4187: 
                   4188: =cut
                   4189: 
                   4190: sub filecategorytypes {
1.356     albertel 4191:     my ($cat) = @_;
1.1248    raeburn  4192:     if (ref($category_extensions{lc($cat)}) eq 'ARRAY') { 
                   4193:         return @{$category_extensions{lc($cat)}};
                   4194:     } else {
                   4195:         return ();
                   4196:     }
1.112     bowersj2 4197: }
                   4198: 
                   4199: =pod
                   4200: 
1.648     raeburn  4201: =item * &fileembstyle() 
1.112     bowersj2 4202: 
                   4203: returns embedding style for a specified file type
                   4204: 
                   4205: =cut
                   4206: 
                   4207: sub fileembstyle {
                   4208:     return $fe{lc(shift(@_))};
1.169     www      4209: }
                   4210: 
1.351     www      4211: sub filemimetype {
                   4212:     return $fm{lc(shift(@_))};
                   4213: }
                   4214: 
1.169     www      4215: 
                   4216: sub filecategoryselect {
                   4217:     my ($name,$value)=@_;
1.189     matthew  4218:     return &select_form($value,$name,
1.970     raeburn  4219:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 4220: }
                   4221: 
                   4222: =pod
                   4223: 
1.648     raeburn  4224: =item * &filedescription() 
1.112     bowersj2 4225: 
                   4226: returns description for a specified file type
                   4227: 
                   4228: =cut
                   4229: 
                   4230: sub filedescription {
1.188     matthew  4231:     my $file_description = $fd{lc(shift())};
                   4232:     $file_description =~ s:([\[\]]):~$1:g;
                   4233:     return &mt($file_description);
1.112     bowersj2 4234: }
                   4235: 
                   4236: =pod
                   4237: 
1.648     raeburn  4238: =item * &filedescriptionex() 
1.112     bowersj2 4239: 
                   4240: returns description for a specified file type with
                   4241: extra formatting
                   4242: 
                   4243: =cut
                   4244: 
                   4245: sub filedescriptionex {
                   4246:     my $ex=shift;
1.188     matthew  4247:     my $file_description = $fd{lc($ex)};
                   4248:     $file_description =~ s:([\[\]]):~$1:g;
                   4249:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 4250: }
                   4251: 
                   4252: # End of .tab access
                   4253: =pod
                   4254: 
                   4255: =back
                   4256: 
                   4257: =cut
                   4258: 
                   4259: # ------------------------------------------------------------------ File Types
                   4260: sub fileextensions {
                   4261:     return sort(keys(%fe));
                   4262: }
                   4263: 
1.97      www      4264: # ----------------------------------------------------------- Display Languages
                   4265: # returns a hash with all desired display languages
                   4266: #
                   4267: 
                   4268: sub display_languages {
                   4269:     my %languages=();
1.695     raeburn  4270:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 4271: 	$languages{$lang}=1;
1.97      www      4272:     }
                   4273:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 4274:     if ($env{'form.displaylanguage'}) {
1.356     albertel 4275: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   4276: 	    $languages{$lang}=1;
1.97      www      4277:         }
                   4278:     }
                   4279:     return %languages;
1.14      harris41 4280: }
                   4281: 
1.582     albertel 4282: sub languages {
                   4283:     my ($possible_langs) = @_;
1.695     raeburn  4284:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 4285:     if (!ref($possible_langs)) {
                   4286: 	if( wantarray ) {
                   4287: 	    return @preferred_langs;
                   4288: 	} else {
                   4289: 	    return $preferred_langs[0];
                   4290: 	}
                   4291:     }
                   4292:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   4293:     my @preferred_possibilities;
                   4294:     foreach my $preferred_lang (@preferred_langs) {
                   4295: 	if (exists($possibilities{$preferred_lang})) {
                   4296: 	    push(@preferred_possibilities, $preferred_lang);
                   4297: 	}
                   4298:     }
                   4299:     if( wantarray ) {
                   4300: 	return @preferred_possibilities;
                   4301:     }
                   4302:     return $preferred_possibilities[0];
                   4303: }
                   4304: 
1.742     raeburn  4305: sub user_lang {
                   4306:     my ($touname,$toudom,$fromcid) = @_;
                   4307:     my @userlangs;
                   4308:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   4309:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   4310:                     $env{'course.'.$fromcid.'.languages'}));
                   4311:     } else {
                   4312:         my %langhash = &getlangs($touname,$toudom);
                   4313:         if ($langhash{'languages'} ne '') {
                   4314:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   4315:         } else {
                   4316:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   4317:             if ($domdefs{'lang_def'} ne '') {
                   4318:                 @userlangs = ($domdefs{'lang_def'});
                   4319:             }
                   4320:         }
                   4321:     }
                   4322:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   4323:     my $user_lh = Apache::localize->get_handle(@languages);
                   4324:     return $user_lh;
                   4325: }
                   4326: 
                   4327: 
1.112     bowersj2 4328: ###############################################################
                   4329: ##               Student Answer Attempts                     ##
                   4330: ###############################################################
                   4331: 
                   4332: =pod
                   4333: 
                   4334: =head1 Alternate Problem Views
                   4335: 
                   4336: =over 4
                   4337: 
1.648     raeburn  4338: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199    raeburn  4339:     $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112     bowersj2 4340: 
                   4341: Return string with previous attempt on problem. Arguments:
                   4342: 
                   4343: =over 4
                   4344: 
                   4345: =item * $symb: Problem, including path
                   4346: 
                   4347: =item * $username: username of the desired student
                   4348: 
                   4349: =item * $domain: domain of the desired student
1.14      harris41 4350: 
1.112     bowersj2 4351: =item * $course: Course ID
1.14      harris41 4352: 
1.112     bowersj2 4353: =item * $getattempt: Leave blank for all attempts, otherwise put
                   4354:     something
1.14      harris41 4355: 
1.112     bowersj2 4356: =item * $regexp: if string matches this regexp, the string will be
                   4357:     sent to $gradesub
1.14      harris41 4358: 
1.112     bowersj2 4359: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 4360: 
1.1199    raeburn  4361: =item * $usec: section of the desired student
                   4362: 
                   4363: =item * $identifier: counter for student (multiple students one problem) or 
                   4364:     problem (one student; whole sequence).
                   4365: 
1.112     bowersj2 4366: =back
1.14      harris41 4367: 
1.112     bowersj2 4368: The output string is a table containing all desired attempts, if any.
1.16      harris41 4369: 
1.112     bowersj2 4370: =cut
1.1       albertel 4371: 
                   4372: sub get_previous_attempt {
1.1199    raeburn  4373:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1       albertel 4374:   my $prevattempts='';
1.43      ng       4375:   no strict 'refs';
1.1       albertel 4376:   if ($symb) {
1.3       albertel 4377:     my (%returnhash)=
                   4378:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 4379:     if ($returnhash{'version'}) {
                   4380:       my %lasthash=();
                   4381:       my $version;
                   4382:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212    raeburn  4383:         foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
                   4384:             if ($key =~ /\.rawrndseed$/) {
                   4385:                 my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
                   4386:                 $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
                   4387:             } else {
                   4388:                 $lasthash{$key}=$returnhash{$version.':'.$key};
                   4389:             }
1.19      harris41 4390:         }
1.1       albertel 4391:       }
1.596     albertel 4392:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   4393:       $prevattempts.='<th>'.&mt('History').'</th>';
1.1199    raeburn  4394:       my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945     raeburn  4395:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 4396:       foreach my $key (sort(keys(%lasthash))) {
                   4397: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       4398: 	if ($#parts > 0) {
1.31      albertel 4399: 	  my $data=$parts[-1];
1.989     raeburn  4400:           next if ($data eq 'foilorder');
1.31      albertel 4401: 	  pop(@parts);
1.1010    www      4402:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  4403:           if ($data eq 'type') {
                   4404:               unless ($showsurv) {
                   4405:                   my $id = join(',',@parts);
                   4406:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  4407:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   4408:                       $lasthidden{$ign.'.'.$id} = 1;
                   4409:                   }
1.945     raeburn  4410:               }
1.1199    raeburn  4411:               if ($identifier ne '') {
                   4412:                   my $id = join(',',@parts);
                   4413:                   if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
                   4414:                                                $domain,$username,$usec,undef,$course) =~ /^no/) {
                   4415:                       $hidestatus{$ign.'.'.$id} = 1;
                   4416:                   }
                   4417:               }
                   4418:           } elsif ($data eq 'regrader') {
                   4419:               if (($identifier ne '') && (@parts)) {
1.1200    raeburn  4420:                   my $id = join(',',@parts);
                   4421:                   $regraded{$ign.'.'.$id} = 1;
1.1199    raeburn  4422:               }
1.1010    www      4423:           } 
1.31      albertel 4424: 	} else {
1.41      ng       4425: 	  if ($#parts == 0) {
                   4426: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   4427: 	  } else {
                   4428: 	    $prevattempts.='<th>'.$ign.'</th>';
                   4429: 	  }
1.31      albertel 4430: 	}
1.16      harris41 4431:       }
1.596     albertel 4432:       $prevattempts.=&end_data_table_header_row();
1.40      ng       4433:       if ($getattempt eq '') {
1.1199    raeburn  4434:         my (%solved,%resets,%probstatus);
1.1200    raeburn  4435:         if (($identifier ne '') && (keys(%regraded) > 0)) {
                   4436:             for ($version=1;$version<=$returnhash{'version'};$version++) {
                   4437:                 foreach my $id (keys(%regraded)) {
                   4438:                     if (($returnhash{$version.':'.$id.'.regrader'}) &&
                   4439:                         ($returnhash{$version.':'.$id.'.tries'} eq '') &&
                   4440:                         ($returnhash{$version.':'.$id.'.award'} eq '')) {
                   4441:                         push(@{$resets{$id}},$version);
1.1199    raeburn  4442:                     }
                   4443:                 }
                   4444:             }
1.1200    raeburn  4445:         }
                   4446: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199    raeburn  4447:             my (@hidden,@unsolved);
1.945     raeburn  4448:             if (%typeparts) {
                   4449:                 foreach my $id (keys(%typeparts)) {
1.1199    raeburn  4450:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || 
                   4451:                         ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945     raeburn  4452:                         push(@hidden,$id);
1.1199    raeburn  4453:                     } elsif ($identifier ne '') {
                   4454:                         unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
                   4455:                                 ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
                   4456:                                 ($hidestatus{$id})) {
1.1200    raeburn  4457:                             next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199    raeburn  4458:                             if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
                   4459:                                 push(@{$solved{$id}},$version);
                   4460:                             } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
                   4461:                                      (ref($solved{$id}) eq 'ARRAY')) {
                   4462:                                 my $skip;
                   4463:                                 if (ref($resets{$id}) eq 'ARRAY') {
                   4464:                                     foreach my $reset (@{$resets{$id}}) {
                   4465:                                         if ($reset > $solved{$id}[-1]) {
                   4466:                                             $skip=1;
                   4467:                                             last;
                   4468:                                         }
                   4469:                                     }
                   4470:                                 }
                   4471:                                 unless ($skip) {
                   4472:                                     my ($ign,$partslist) = split(/\./,$id,2);
                   4473:                                     push(@unsolved,$partslist);
                   4474:                                 }
                   4475:                             }
                   4476:                         }
1.945     raeburn  4477:                     }
                   4478:                 }
                   4479:             }
                   4480:             $prevattempts.=&start_data_table_row().
1.1199    raeburn  4481:                            '<td>'.&mt('Transaction [_1]',$version);
                   4482:             if (@unsolved) {
                   4483:                 $prevattempts .= '<span class="LC_nobreak"><label>'.
                   4484:                                  '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
                   4485:                                  &mt('Hide').'</label></span>';
                   4486:             }
                   4487:             $prevattempts .= '</td>';
1.945     raeburn  4488:             if (@hidden) {
                   4489:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4490:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  4491:                     my $hide;
                   4492:                     foreach my $id (@hidden) {
                   4493:                         if ($key =~ /^\Q$id\E/) {
                   4494:                             $hide = 1;
                   4495:                             last;
                   4496:                         }
                   4497:                     }
                   4498:                     if ($hide) {
                   4499:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   4500:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   4501:                             my $value = &format_previous_attempt_value($key,
                   4502:                                              $returnhash{$version.':'.$key});
1.1173    kruse    4503:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  4504:                         } else {
                   4505:                             $prevattempts.='<td>&nbsp;</td>';
                   4506:                         }
                   4507:                     } else {
                   4508:                         if ($key =~ /\./) {
1.1212    raeburn  4509:                             my $value = $returnhash{$version.':'.$key};
                   4510:                             if ($key =~ /\.rndseed$/) {
                   4511:                                 my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                   4512:                                 if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4513:                                     $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4514:                                 }
                   4515:                             }
                   4516:                             $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4517:                                            '&nbsp;</td>';
1.945     raeburn  4518:                         } else {
                   4519:                             $prevattempts.='<td>&nbsp;</td>';
                   4520:                         }
                   4521:                     }
                   4522:                 }
                   4523:             } else {
                   4524: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4525:                     next if ($key =~ /\.foilorder$/);
1.1212    raeburn  4526:                     my $value = $returnhash{$version.':'.$key};
                   4527:                     if ($key =~ /\.rndseed$/) {
                   4528:                         my ($id) = ($key =~ /^(.+)\.[^.]+$/);
                   4529:                         if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
                   4530:                             $value = $returnhash{$version.':'.$id.'.rawrndseed'};
                   4531:                         }
                   4532:                     }
                   4533:                     $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
                   4534:                                    '&nbsp;</td>';
1.945     raeburn  4535: 	        }
                   4536:             }
                   4537: 	    $prevattempts.=&end_data_table_row();
1.40      ng       4538: 	 }
1.1       albertel 4539:       }
1.945     raeburn  4540:       my @currhidden = keys(%lasthidden);
1.596     albertel 4541:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 4542:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  4543:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  4544:           if (%typeparts) {
                   4545:               my $hidden;
                   4546:               foreach my $id (@currhidden) {
                   4547:                   if ($key =~ /^\Q$id\E/) {
                   4548:                       $hidden = 1;
                   4549:                       last;
                   4550:                   }
                   4551:               }
                   4552:               if ($hidden) {
                   4553:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   4554:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   4555:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4556:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4557:                           $value = &$gradesub($value);
                   4558:                       }
1.1173    kruse    4559:                       $prevattempts.='<td>'. $value.'&nbsp;</td>';
1.945     raeburn  4560:                   } else {
                   4561:                       $prevattempts.='<td>&nbsp;</td>';
                   4562:                   }
                   4563:               } else {
                   4564:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4565:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4566:                       $value = &$gradesub($value);
                   4567:                   }
1.1173    kruse    4568:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  4569:               }
                   4570:           } else {
                   4571: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   4572: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   4573:                   $value = &$gradesub($value);
                   4574:               }
1.1173    kruse    4575: 	     $prevattempts.='<td>'.$value.'&nbsp;</td>';
1.945     raeburn  4576:           }
1.16      harris41 4577:       }
1.596     albertel 4578:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 4579:     } else {
1.596     albertel 4580:       $prevattempts=
                   4581: 	  &start_data_table().&start_data_table_row().
                   4582: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   4583: 	  &end_data_table_row().&end_data_table();
1.1       albertel 4584:     }
                   4585:   } else {
1.596     albertel 4586:     $prevattempts=
                   4587: 	  &start_data_table().&start_data_table_row().
                   4588: 	  '<td>'.&mt('No data.').'</td>'.
                   4589: 	  &end_data_table_row().&end_data_table();
1.1       albertel 4590:   }
1.10      albertel 4591: }
                   4592: 
1.581     albertel 4593: sub format_previous_attempt_value {
                   4594:     my ($key,$value) = @_;
1.1011    www      4595:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173    kruse    4596:         $value = &Apache::lonlocal::locallocaltime($value);
1.581     albertel 4597:     } elsif (ref($value) eq 'ARRAY') {
1.1173    kruse    4598:         $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988     raeburn  4599:     } elsif ($key =~ /answerstring$/) {
                   4600:         my %answers = &Apache::lonnet::str2hash($value);
1.1173    kruse    4601:         my @answer = %answers;
                   4602:         %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988     raeburn  4603:         my @anskeys = sort(keys(%answers));
                   4604:         if (@anskeys == 1) {
                   4605:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  4606:             if ($answer =~ m{\0}) {
                   4607:                 $answer =~ s{\0}{,}g;
1.988     raeburn  4608:             }
                   4609:             my $tag_internal_answer_name = 'INTERNAL';
                   4610:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   4611:                 $value = $answer; 
                   4612:             } else {
                   4613:                 $value = $anskeys[0].'='.$answer;
                   4614:             }
                   4615:         } else {
                   4616:             foreach my $ans (@anskeys) {
                   4617:                 my $answer = $answers{$ans};
1.1001    raeburn  4618:                 if ($answer =~ m{\0}) {
                   4619:                     $answer =~ s{\0}{,}g;
1.988     raeburn  4620:                 }
                   4621:                 $value .=  $ans.'='.$answer.'<br />';;
                   4622:             } 
                   4623:         }
1.581     albertel 4624:     } else {
1.1173    kruse    4625:         $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581     albertel 4626:     }
                   4627:     return $value;
                   4628: }
                   4629: 
                   4630: 
1.107     albertel 4631: sub relative_to_absolute {
                   4632:     my ($url,$output)=@_;
                   4633:     my $parser=HTML::TokeParser->new(\$output);
                   4634:     my $token;
                   4635:     my $thisdir=$url;
                   4636:     my @rlinks=();
                   4637:     while ($token=$parser->get_token) {
                   4638: 	if ($token->[0] eq 'S') {
                   4639: 	    if ($token->[1] eq 'a') {
                   4640: 		if ($token->[2]->{'href'}) {
                   4641: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   4642: 		}
                   4643: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   4644: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   4645: 	    } elsif ($token->[1] eq 'base') {
                   4646: 		$thisdir=$token->[2]->{'href'};
                   4647: 	    }
                   4648: 	}
                   4649:     }
                   4650:     $thisdir=~s-/[^/]*$--;
1.356     albertel 4651:     foreach my $link (@rlinks) {
1.726     raeburn  4652: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 4653: 		($link=~/^\//) ||
                   4654: 		($link=~/^javascript:/i) ||
                   4655: 		($link=~/^mailto:/i) ||
                   4656: 		($link=~/^\#/)) {
                   4657: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   4658: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 4659: 	}
                   4660:     }
                   4661: # -------------------------------------------------- Deal with Applet codebases
                   4662:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   4663:     return $output;
                   4664: }
                   4665: 
1.112     bowersj2 4666: =pod
                   4667: 
1.648     raeburn  4668: =item * &get_student_view()
1.112     bowersj2 4669: 
                   4670: show a snapshot of what student was looking at
                   4671: 
                   4672: =cut
                   4673: 
1.10      albertel 4674: sub get_student_view {
1.186     albertel 4675:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      4676:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4677:   my (%form);
1.10      albertel 4678:   my @elements=('symb','courseid','domain','username');
                   4679:   foreach my $element (@elements) {
1.186     albertel 4680:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4681:   }
1.186     albertel 4682:   if (defined($moreenv)) {
                   4683:       %form=(%form,%{$moreenv});
                   4684:   }
1.236     albertel 4685:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 4686:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      4687:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 4688:   $userview=~s/\<body[^\>]*\>//gi;
                   4689:   $userview=~s/\<\/body\>//gi;
                   4690:   $userview=~s/\<html\>//gi;
                   4691:   $userview=~s/\<\/html\>//gi;
                   4692:   $userview=~s/\<head\>//gi;
                   4693:   $userview=~s/\<\/head\>//gi;
                   4694:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 4695:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      4696:   if (wantarray) {
                   4697:      return ($userview,$response);
                   4698:   } else {
                   4699:      return $userview;
                   4700:   }
                   4701: }
                   4702: 
                   4703: sub get_student_view_with_retries {
                   4704:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   4705: 
                   4706:     my $ok = 0;                 # True if we got a good response.
                   4707:     my $content;
                   4708:     my $response;
                   4709: 
                   4710:     # Try to get the student_view done. within the retries count:
                   4711:     
                   4712:     do {
                   4713:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   4714:          $ok      = $response->is_success;
                   4715:          if (!$ok) {
                   4716:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   4717:          }
                   4718:          $retries--;
                   4719:     } while (!$ok && ($retries > 0));
                   4720:     
                   4721:     if (!$ok) {
                   4722:        $content = '';          # On error return an empty content.
                   4723:     }
1.651     www      4724:     if (wantarray) {
                   4725:        return ($content, $response);
                   4726:     } else {
                   4727:        return $content;
                   4728:     }
1.11      albertel 4729: }
                   4730: 
1.112     bowersj2 4731: =pod
                   4732: 
1.648     raeburn  4733: =item * &get_student_answers() 
1.112     bowersj2 4734: 
                   4735: show a snapshot of how student was answering problem
                   4736: 
                   4737: =cut
                   4738: 
1.11      albertel 4739: sub get_student_answers {
1.100     sakharuk 4740:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      4741:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4742:   my (%moreenv);
1.11      albertel 4743:   my @elements=('symb','courseid','domain','username');
                   4744:   foreach my $element (@elements) {
1.186     albertel 4745:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4746:   }
1.186     albertel 4747:   $moreenv{'grade_target'}='answer';
                   4748:   %moreenv=(%form,%moreenv);
1.497     raeburn  4749:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4750:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4751:   return $userview;
1.1       albertel 4752: }
1.116     albertel 4753: 
                   4754: =pod
                   4755: 
                   4756: =item * &submlink()
                   4757: 
1.242     albertel 4758: Inputs: $text $uname $udom $symb $target
1.116     albertel 4759: 
                   4760: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4761: 
                   4762: =cut
                   4763: 
                   4764: ###############################################
                   4765: sub submlink {
1.242     albertel 4766:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4767:     if (!($uname && $udom)) {
                   4768: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4769: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4770: 	if (!$symb) { $symb=$cursymb; }
                   4771:     }
1.254     matthew  4772:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4773:     $symb=&escape($symb);
1.960     bisitz   4774:     if ($target) { $target=" target=\"$target\""; }
                   4775:     return
                   4776:         '<a href="/adm/grades?command=submission'.
                   4777:         '&amp;symb='.$symb.
                   4778:         '&amp;student='.$uname.
                   4779:         '&amp;userdom='.$udom.'"'.
                   4780:         $target.'>'.$text.'</a>';
1.242     albertel 4781: }
                   4782: ##############################################
                   4783: 
                   4784: =pod
                   4785: 
                   4786: =item * &pgrdlink()
                   4787: 
                   4788: Inputs: $text $uname $udom $symb $target
                   4789: 
                   4790: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4791: 
                   4792: =cut
                   4793: 
                   4794: ###############################################
                   4795: sub pgrdlink {
                   4796:     my $link=&submlink(@_);
                   4797:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4798:     return $link;
                   4799: }
                   4800: ##############################################
                   4801: 
                   4802: =pod
                   4803: 
                   4804: =item * &pprmlink()
                   4805: 
                   4806: Inputs: $text $uname $udom $symb $target
                   4807: 
                   4808: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4809: student and a specific resource
1.242     albertel 4810: 
                   4811: =cut
                   4812: 
                   4813: ###############################################
                   4814: sub pprmlink {
                   4815:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4816:     if (!($uname && $udom)) {
                   4817: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4818: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4819: 	if (!$symb) { $symb=$cursymb; }
                   4820:     }
1.254     matthew  4821:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4822:     $symb=&escape($symb);
1.242     albertel 4823:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4824:     return '<a href="/adm/parmset?command=set&amp;'.
                   4825: 	'symb='.$symb.'&amp;uname='.$uname.
                   4826: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4827: }
                   4828: ##############################################
1.37      matthew  4829: 
1.112     bowersj2 4830: =pod
                   4831: 
                   4832: =back
                   4833: 
                   4834: =cut
                   4835: 
1.37      matthew  4836: ###############################################
1.51      www      4837: 
                   4838: 
                   4839: sub timehash {
1.687     raeburn  4840:     my ($thistime) = @_;
                   4841:     my $timezone = &Apache::lonlocal::gettimezone();
                   4842:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4843:                      ->set_time_zone($timezone);
                   4844:     my $wday = $dt->day_of_week();
                   4845:     if ($wday == 7) { $wday = 0; }
                   4846:     return ( 'second' => $dt->second(),
                   4847:              'minute' => $dt->minute(),
                   4848:              'hour'   => $dt->hour(),
                   4849:              'day'     => $dt->day_of_month(),
                   4850:              'month'   => $dt->month(),
                   4851:              'year'    => $dt->year(),
                   4852:              'weekday' => $wday,
                   4853:              'dayyear' => $dt->day_of_year(),
                   4854:              'dlsav'   => $dt->is_dst() );
1.51      www      4855: }
                   4856: 
1.370     www      4857: sub utc_string {
                   4858:     my ($date)=@_;
1.371     www      4859:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4860: }
                   4861: 
1.51      www      4862: sub maketime {
                   4863:     my %th=@_;
1.687     raeburn  4864:     my ($epoch_time,$timezone,$dt);
                   4865:     $timezone = &Apache::lonlocal::gettimezone();
                   4866:     eval {
                   4867:         $dt = DateTime->new( year   => $th{'year'},
                   4868:                              month  => $th{'month'},
                   4869:                              day    => $th{'day'},
                   4870:                              hour   => $th{'hour'},
                   4871:                              minute => $th{'minute'},
                   4872:                              second => $th{'second'},
                   4873:                              time_zone => $timezone,
                   4874:                          );
                   4875:     };
                   4876:     if (!$@) {
                   4877:         $epoch_time = $dt->epoch;
                   4878:         if ($epoch_time) {
                   4879:             return $epoch_time;
                   4880:         }
                   4881:     }
1.51      www      4882:     return POSIX::mktime(
                   4883:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4884:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4885: }
                   4886: 
                   4887: #########################################
1.51      www      4888: 
                   4889: sub findallcourses {
1.482     raeburn  4890:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4891:     my %roles;
                   4892:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4893:     my %courses;
1.51      www      4894:     my $now=time;
1.482     raeburn  4895:     if (!defined($uname)) {
                   4896:         $uname = $env{'user.name'};
                   4897:     }
                   4898:     if (!defined($udom)) {
                   4899:         $udom = $env{'user.domain'};
                   4900:     }
                   4901:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4902:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4903:         if (!%roles) {
                   4904:             %roles = (
                   4905:                        cc => 1,
1.907     raeburn  4906:                        co => 1,
1.482     raeburn  4907:                        in => 1,
                   4908:                        ep => 1,
                   4909:                        ta => 1,
                   4910:                        cr => 1,
                   4911:                        st => 1,
                   4912:              );
                   4913:         }
                   4914:         foreach my $entry (keys(%roleshash)) {
                   4915:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4916:             if ($trole =~ /^cr/) { 
                   4917:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4918:             } else {
                   4919:                 next if (!exists($roles{$trole}));
                   4920:             }
                   4921:             if ($tend) {
                   4922:                 next if ($tend < $now);
                   4923:             }
                   4924:             if ($tstart) {
                   4925:                 next if ($tstart > $now);
                   4926:             }
1.1058    raeburn  4927:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4928:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4929:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4930:             if ($secpart eq '') {
                   4931:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4932:                 $sec = 'none';
1.1058    raeburn  4933:                 $value .= $cnum.'/';
1.482     raeburn  4934:             } else {
                   4935:                 $cnum = $cnumpart;
                   4936:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4937:                 $value .= $cnum.'/'.$sec;
                   4938:             }
                   4939:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4940:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4941:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4942:                 }
                   4943:             } else {
                   4944:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4945:             }
1.482     raeburn  4946:         }
                   4947:     } else {
                   4948:         foreach my $key (keys(%env)) {
1.483     albertel 4949: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4950:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4951: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4952: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4953: 	        next if (%roles && !exists($roles{$role}));
                   4954: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4955:                 my $active=1;
                   4956:                 if ($starttime) {
                   4957: 		    if ($now<$starttime) { $active=0; }
                   4958:                 }
                   4959:                 if ($endtime) {
                   4960:                     if ($now>$endtime) { $active=0; }
                   4961:                 }
                   4962:                 if ($active) {
1.1058    raeburn  4963:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4964:                     if ($sec eq '') {
                   4965:                         $sec = 'none';
1.1058    raeburn  4966:                     } else {
                   4967:                         $value .= $sec;
                   4968:                     }
                   4969:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4970:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4971:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4972:                         }
                   4973:                     } else {
                   4974:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4975:                     }
1.474     raeburn  4976:                 }
                   4977:             }
1.51      www      4978:         }
                   4979:     }
1.474     raeburn  4980:     return %courses;
1.51      www      4981: }
1.37      matthew  4982: 
1.54      www      4983: ###############################################
1.474     raeburn  4984: 
                   4985: sub blockcheck {
1.1189    raeburn  4986:     my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490     raeburn  4987: 
1.1189    raeburn  4988:     if (defined($udom) && defined($uname)) {
                   4989:         # If uname and udom are for a course, check for blocks in the course.
                   4990:         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
                   4991:             my ($startblock,$endblock,$triggerblock) =
                   4992:                 &get_blocks($setters,$activity,$udom,$uname,$url);
                   4993:             return ($startblock,$endblock,$triggerblock);
                   4994:         }
                   4995:     } else {
1.490     raeburn  4996:         $udom = $env{'user.domain'};
                   4997:         $uname = $env{'user.name'};
                   4998:     }
                   4999: 
1.502     raeburn  5000:     my $startblock = 0;
                   5001:     my $endblock = 0;
1.1062    raeburn  5002:     my $triggerblock = '';
1.482     raeburn  5003:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  5004: 
1.490     raeburn  5005:     # If uname is for a user, and activity is course-specific, i.e.,
                   5006:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  5007: 
1.490     raeburn  5008:     if (($activity eq 'boards' || $activity eq 'chat' ||
1.1282    raeburn  5009:          $activity eq 'groups' || $activity eq 'printout' ||
                   5010:          $activity eq 'reinit' || $activity eq 'alert') &&
1.1189    raeburn  5011:         ($env{'request.course.id'})) {
1.490     raeburn  5012:         foreach my $key (keys(%live_courses)) {
                   5013:             if ($key ne $env{'request.course.id'}) {
                   5014:                 delete($live_courses{$key});
                   5015:             }
                   5016:         }
                   5017:     }
                   5018: 
                   5019:     my $otheruser = 0;
                   5020:     my %own_courses;
                   5021:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   5022:         # Resource belongs to user other than current user.
                   5023:         $otheruser = 1;
                   5024:         # Gather courses for current user
                   5025:         %own_courses = 
                   5026:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   5027:     }
                   5028: 
                   5029:     # Gather active course roles - course coordinator, instructor, 
                   5030:     # exam proctor, ta, student, or custom role.
1.474     raeburn  5031: 
                   5032:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  5033:         my ($cdom,$cnum);
                   5034:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   5035:             $cdom = $env{'course.'.$course.'.domain'};
                   5036:             $cnum = $env{'course.'.$course.'.num'};
                   5037:         } else {
1.490     raeburn  5038:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  5039:         }
                   5040:         my $no_ownblock = 0;
                   5041:         my $no_userblock = 0;
1.533     raeburn  5042:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  5043:             # Check if current user has 'evb' priv for this
                   5044:             if (defined($own_courses{$course})) {
                   5045:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   5046:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   5047:                     if ($sec ne 'none') {
                   5048:                         $checkrole .= '/'.$sec;
                   5049:                     }
                   5050:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   5051:                         $no_ownblock = 1;
                   5052:                         last;
                   5053:                     }
                   5054:                 }
                   5055:             }
                   5056:             # if they have 'evb' priv and are currently not playing student
                   5057:             next if (($no_ownblock) &&
                   5058:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   5059:         }
1.474     raeburn  5060:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  5061:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  5062:             if ($sec ne 'none') {
1.482     raeburn  5063:                 $checkrole .= '/'.$sec;
1.474     raeburn  5064:             }
1.490     raeburn  5065:             if ($otheruser) {
                   5066:                 # Resource belongs to user other than current user.
                   5067:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  5068:                 my (%allroles,%userroles);
                   5069:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   5070:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   5071:                         my ($trole,$tdom,$tnum,$tsec);
                   5072:                         if ($entry =~ /^cr/) {
                   5073:                             ($trole,$tdom,$tnum,$tsec) = 
                   5074:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   5075:                         } else {
                   5076:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   5077:                         }
                   5078:                         my ($spec,$area,$trest);
                   5079:                         $area = '/'.$tdom.'/'.$tnum;
                   5080:                         $trest = $tnum;
                   5081:                         if ($tsec ne '') {
                   5082:                             $area .= '/'.$tsec;
                   5083:                             $trest .= '/'.$tsec;
                   5084:                         }
                   5085:                         $spec = $trole.'.'.$area;
                   5086:                         if ($trole =~ /^cr/) {
                   5087:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   5088:                                                               $tdom,$spec,$trest,$area);
                   5089:                         } else {
                   5090:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   5091:                                                                 $tdom,$spec,$trest,$area);
                   5092:                         }
                   5093:                     }
1.1276    raeburn  5094:                     my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058    raeburn  5095:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   5096:                         if ($1) {
                   5097:                             $no_userblock = 1;
                   5098:                             last;
                   5099:                         }
1.486     raeburn  5100:                     }
                   5101:                 }
1.490     raeburn  5102:             } else {
                   5103:                 # Resource belongs to current user
                   5104:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  5105:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   5106:                     $no_ownblock = 1;
                   5107:                     last;
                   5108:                 }
1.474     raeburn  5109:             }
                   5110:         }
                   5111:         # if they have the evb priv and are currently not playing student
1.482     raeburn  5112:         next if (($no_ownblock) &&
1.491     albertel 5113:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  5114:         next if ($no_userblock);
1.474     raeburn  5115: 
1.866     kalberla 5116:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  5117:         # of specified user, unless user has 'evb' privilege.
1.1284    raeburn  5118: 
1.1062    raeburn  5119:         my ($start,$end,$trigger) = 
                   5120:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  5121:         if (($start != 0) && 
                   5122:             (($startblock == 0) || ($startblock > $start))) {
                   5123:             $startblock = $start;
1.1062    raeburn  5124:             if ($trigger ne '') {
                   5125:                 $triggerblock = $trigger;
                   5126:             }
1.502     raeburn  5127:         }
                   5128:         if (($end != 0)  &&
                   5129:             (($endblock == 0) || ($endblock < $end))) {
                   5130:             $endblock = $end;
1.1062    raeburn  5131:             if ($trigger ne '') {
                   5132:                 $triggerblock = $trigger;
                   5133:             }
1.502     raeburn  5134:         }
1.490     raeburn  5135:     }
1.1062    raeburn  5136:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  5137: }
                   5138: 
                   5139: sub get_blocks {
1.1062    raeburn  5140:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  5141:     my $startblock = 0;
                   5142:     my $endblock = 0;
1.1062    raeburn  5143:     my $triggerblock = '';
1.490     raeburn  5144:     my $course = $cdom.'_'.$cnum;
                   5145:     $setters->{$course} = {};
                   5146:     $setters->{$course}{'staff'} = [];
                   5147:     $setters->{$course}{'times'} = [];
1.1062    raeburn  5148:     $setters->{$course}{'triggers'} = [];
                   5149:     my (@blockers,%triggered);
                   5150:     my $now = time;
                   5151:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   5152:     if ($activity eq 'docs') {
                   5153:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   5154:         foreach my $block (@blockers) {
                   5155:             if ($block =~ /^firstaccess____(.+)$/) {
                   5156:                 my $item = $1;
                   5157:                 my $type = 'map';
                   5158:                 my $timersymb = $item;
                   5159:                 if ($item eq 'course') {
                   5160:                     $type = 'course';
                   5161:                 } elsif ($item =~ /___\d+___/) {
                   5162:                     $type = 'resource';
                   5163:                 } else {
                   5164:                     $timersymb = &Apache::lonnet::symbread($item);
                   5165:                 }
                   5166:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   5167:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   5168:                 $triggered{$block} = {
                   5169:                                        start => $start,
                   5170:                                        end   => $end,
                   5171:                                        type  => $type,
                   5172:                                      };
                   5173:             }
                   5174:         }
                   5175:     } else {
                   5176:         foreach my $block (keys(%commblocks)) {
                   5177:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   5178:                 my ($start,$end) = ($1,$2);
                   5179:                 if ($start <= time && $end >= time) {
                   5180:                     if (ref($commblocks{$block}) eq 'HASH') {
                   5181:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   5182:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   5183:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   5184:                                     push(@blockers,$block);
                   5185:                                 }
                   5186:                             }
                   5187:                         }
                   5188:                     }
                   5189:                 }
                   5190:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   5191:                 my $item = $1;
                   5192:                 my $timersymb = $item; 
                   5193:                 my $type = 'map';
                   5194:                 if ($item eq 'course') {
                   5195:                     $type = 'course';
                   5196:                 } elsif ($item =~ /___\d+___/) {
                   5197:                     $type = 'resource';
                   5198:                 } else {
                   5199:                     $timersymb = &Apache::lonnet::symbread($item);
                   5200:                 }
                   5201:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   5202:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   5203:                 if ($start && $end) {
                   5204:                     if (($start <= time) && ($end >= time)) {
1.1281    raeburn  5205:                         if (ref($commblocks{$block}) eq 'HASH') {
                   5206:                             if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   5207:                                 if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   5208:                                     unless(grep(/^\Q$block\E$/,@blockers)) {
                   5209:                                         push(@blockers,$block);
                   5210:                                         $triggered{$block} = {
                   5211:                                                                start => $start,
                   5212:                                                                end   => $end,
                   5213:                                                                type  => $type,
                   5214:                                                              };
                   5215:                                     }
                   5216:                                 }
                   5217:                             }
1.1062    raeburn  5218:                         }
                   5219:                     }
1.490     raeburn  5220:                 }
1.1062    raeburn  5221:             }
                   5222:         }
                   5223:     }
                   5224:     foreach my $blocker (@blockers) {
                   5225:         my ($staff_name,$staff_dom,$title,$blocks) =
                   5226:             &parse_block_record($commblocks{$blocker});
                   5227:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   5228:         my ($start,$end,$triggertype);
                   5229:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   5230:             ($start,$end) = ($1,$2);
                   5231:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   5232:             $start = $triggered{$blocker}{'start'};
                   5233:             $end = $triggered{$blocker}{'end'};
                   5234:             $triggertype = $triggered{$blocker}{'type'};
                   5235:         }
                   5236:         if ($start) {
                   5237:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   5238:             if ($triggertype) {
                   5239:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   5240:             } else {
                   5241:                 push(@{$$setters{$course}{'triggers'}},0);
                   5242:             }
                   5243:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   5244:                 $startblock = $start;
                   5245:                 if ($triggertype) {
                   5246:                     $triggerblock = $blocker;
1.474     raeburn  5247:                 }
                   5248:             }
1.1062    raeburn  5249:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   5250:                $endblock = $end;
                   5251:                if ($triggertype) {
                   5252:                    $triggerblock = $blocker;
                   5253:                }
                   5254:             }
1.474     raeburn  5255:         }
                   5256:     }
1.1062    raeburn  5257:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  5258: }
                   5259: 
                   5260: sub parse_block_record {
                   5261:     my ($record) = @_;
                   5262:     my ($setuname,$setudom,$title,$blocks);
                   5263:     if (ref($record) eq 'HASH') {
                   5264:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   5265:         $title = &unescape($record->{'event'});
                   5266:         $blocks = $record->{'blocks'};
                   5267:     } else {
                   5268:         my @data = split(/:/,$record,3);
                   5269:         if (scalar(@data) eq 2) {
                   5270:             $title = $data[1];
                   5271:             ($setuname,$setudom) = split(/@/,$data[0]);
                   5272:         } else {
                   5273:             ($setuname,$setudom,$title) = @data;
                   5274:         }
                   5275:         $blocks = { 'com' => 'on' };
                   5276:     }
                   5277:     return ($setuname,$setudom,$title,$blocks);
                   5278: }
                   5279: 
1.854     kalberla 5280: sub blocking_status {
1.1189    raeburn  5281:     my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061    raeburn  5282:     my %setters;
1.890     droeschl 5283: 
1.1061    raeburn  5284: # check for active blocking
1.1062    raeburn  5285:     my ($startblock,$endblock,$triggerblock) = 
1.1189    raeburn  5286:         &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062    raeburn  5287:     my $blocked = 0;
                   5288:     if ($startblock && $endblock) {
                   5289:         $blocked = 1;
                   5290:     }
1.890     droeschl 5291: 
1.1061    raeburn  5292: # caller just wants to know whether a block is active
                   5293:     if (!wantarray) { return $blocked; }
                   5294: 
                   5295: # build a link to a popup window containing the details
                   5296:     my $querystring  = "?activity=$activity";
                   5297: # $uname and $udom decide whose portfolio the user is trying to look at
1.1232    raeburn  5298:     if (($activity eq 'port') || ($activity eq 'passwd')) {
                   5299:         $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/); 
                   5300:         $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);
1.1062    raeburn  5301:     } elsif ($activity eq 'docs') {
                   5302:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   5303:     }
1.1061    raeburn  5304: 
                   5305:     my $output .= <<'END_MYBLOCK';
                   5306: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   5307:     var options = "width=" + w + ",height=" + h + ",";
                   5308:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   5309:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   5310:     var newWin = window.open(url, wdwName, options);
                   5311:     newWin.focus();
                   5312: }
1.890     droeschl 5313: END_MYBLOCK
1.854     kalberla 5314: 
1.1061    raeburn  5315:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 5316:   
1.1061    raeburn  5317:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  5318:     my $text = &mt('Communication Blocked');
1.1217    raeburn  5319:     my $class = 'LC_comblock';
1.1062    raeburn  5320:     if ($activity eq 'docs') {
                   5321:         $text = &mt('Content Access Blocked');
1.1217    raeburn  5322:         $class = '';
1.1063    raeburn  5323:     } elsif ($activity eq 'printout') {
                   5324:         $text = &mt('Printing Blocked');
1.1232    raeburn  5325:     } elsif ($activity eq 'passwd') {
                   5326:         $text = &mt('Password Changing Blocked');
1.1282    raeburn  5327:     } elsif ($activity eq 'alert') {
                   5328:         $text = &mt('Checking Critical Messages Blocked');
                   5329:     } elsif ($activity eq 'reinit') {
                   5330:         $text = &mt('Checking Course Update Blocked');
1.1062    raeburn  5331:     }
1.1061    raeburn  5332:     $output .= <<"END_BLOCK";
1.1217    raeburn  5333: <div class='$class'>
1.869     kalberla 5334:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 5335:   title='$text'>
                   5336:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 5337:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 5338:   title='$text'>$text</a>
1.867     kalberla 5339: </div>
                   5340: 
                   5341: END_BLOCK
1.474     raeburn  5342: 
1.1061    raeburn  5343:     return ($blocked, $output);
1.854     kalberla 5344: }
1.490     raeburn  5345: 
1.60      matthew  5346: ###############################################
                   5347: 
1.682     raeburn  5348: sub check_ip_acc {
1.1201    raeburn  5349:     my ($acc,$clientip)=@_;
1.682     raeburn  5350:     &Apache::lonxml::debug("acc is $acc");
                   5351:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   5352:         return 1;
                   5353:     }
1.1219    raeburn  5354:     my $allowed;
1.1252    raeburn  5355:     my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};
1.682     raeburn  5356: 
                   5357:     my $name;
1.1219    raeburn  5358:     my %access = (
                   5359:                      allowfrom => 1,
                   5360:                      denyfrom  => 0,
                   5361:                  );
                   5362:     my @allows;
                   5363:     my @denies;
                   5364:     foreach my $item (split(',',$acc)) {
                   5365:         $item =~ s/^\s*//;
                   5366:         $item =~ s/\s*$//;
                   5367:         my $pattern;
                   5368:         if ($item =~ /^\!(.+)$/) {
                   5369:             push(@denies,$1);
                   5370:         } else {
                   5371:             push(@allows,$item);
                   5372:         }
                   5373:    }
                   5374:    my $numdenies = scalar(@denies);
                   5375:    my $numallows = scalar(@allows);
                   5376:    my $count = 0;
                   5377:    foreach my $pattern (@denies,@allows) {
                   5378:         $count ++; 
                   5379:         my $acctype = 'allowfrom';
                   5380:         if ($count <= $numdenies) {
                   5381:             $acctype = 'denyfrom';
                   5382:         }
1.682     raeburn  5383:         if ($pattern =~ /\*$/) {
                   5384:             #35.8.*
                   5385:             $pattern=~s/\*//;
1.1219    raeburn  5386:             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682     raeburn  5387:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   5388:             #35.8.3.[34-56]
                   5389:             my $low=$2;
                   5390:             my $high=$3;
                   5391:             $pattern=$1;
                   5392:             if ($ip =~ /^\Q$pattern\E/) {
                   5393:                 my $last=(split(/\./,$ip))[3];
1.1219    raeburn  5394:                 if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682     raeburn  5395:             }
                   5396:         } elsif ($pattern =~ /^\*/) {
                   5397:             #*.msu.edu
                   5398:             $pattern=~s/\*//;
                   5399:             if (!defined($name)) {
                   5400:                 use Socket;
                   5401:                 my $netaddr=inet_aton($ip);
                   5402:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   5403:             }
1.1219    raeburn  5404:             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682     raeburn  5405:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   5406:             #127.0.0.1
1.1219    raeburn  5407:             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682     raeburn  5408:         } else {
                   5409:             #some.name.com
                   5410:             if (!defined($name)) {
                   5411:                 use Socket;
                   5412:                 my $netaddr=inet_aton($ip);
                   5413:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   5414:             }
1.1219    raeburn  5415:             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
                   5416:         }
                   5417:         if ($allowed =~ /^(0|1)$/) { last; }
                   5418:     }
                   5419:     if ($allowed eq '') {
                   5420:         if ($numdenies && !$numallows) {
                   5421:             $allowed = 1;
                   5422:         } else {
                   5423:             $allowed = 0;
1.682     raeburn  5424:         }
                   5425:     }
                   5426:     return $allowed;
                   5427: }
                   5428: 
                   5429: ###############################################
                   5430: 
1.60      matthew  5431: =pod
                   5432: 
1.112     bowersj2 5433: =head1 Domain Template Functions
                   5434: 
                   5435: =over 4
                   5436: 
                   5437: =item * &determinedomain()
1.60      matthew  5438: 
                   5439: Inputs: $domain (usually will be undef)
                   5440: 
1.63      www      5441: Returns: Determines which domain should be used for designs
1.60      matthew  5442: 
                   5443: =cut
1.54      www      5444: 
1.60      matthew  5445: ###############################################
1.63      www      5446: sub determinedomain {
                   5447:     my $domain=shift;
1.531     albertel 5448:     if (! $domain) {
1.60      matthew  5449:         # Determine domain if we have not been given one
1.893     raeburn  5450:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 5451:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   5452:         if ($env{'request.role.domain'}) { 
                   5453:             $domain=$env{'request.role.domain'}; 
1.60      matthew  5454:         }
                   5455:     }
1.63      www      5456:     return $domain;
                   5457: }
                   5458: ###############################################
1.517     raeburn  5459: 
1.518     albertel 5460: sub devalidate_domconfig_cache {
                   5461:     my ($udom)=@_;
                   5462:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   5463: }
                   5464: 
                   5465: # ---------------------- Get domain configuration for a domain
                   5466: sub get_domainconf {
                   5467:     my ($udom) = @_;
                   5468:     my $cachetime=1800;
                   5469:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   5470:     if (defined($cached)) { return %{$result}; }
                   5471: 
                   5472:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  5473: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  5474:     my (%designhash,%legacy);
1.518     albertel 5475:     if (keys(%domconfig) > 0) {
                   5476:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  5477:             if (keys(%{$domconfig{'login'}})) {
                   5478:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  5479:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208    raeburn  5480:                         if (($key eq 'loginvia') || ($key eq 'headtag')) {
                   5481:                             if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                   5482:                                 foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
                   5483:                                     if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
                   5484:                                         if ($key eq 'loginvia') {
                   5485:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   5486:                                                 my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   5487:                                                 $designhash{$udom.'.login.loginvia'} = $server;
                   5488:                                                 if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   5489: 
                   5490:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   5491:                                                 } else {
                   5492:                                                     $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
                   5493:                                                 }
1.948     raeburn  5494:                                             }
1.1208    raeburn  5495:                                         } elsif ($key eq 'headtag') {
                   5496:                                             if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
                   5497:                                                 $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948     raeburn  5498:                                             }
1.946     raeburn  5499:                                         }
1.1208    raeburn  5500:                                         if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
                   5501:                                             $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
                   5502:                                         }
1.946     raeburn  5503:                                     }
                   5504:                                 }
                   5505:                             }
                   5506:                         } else {
                   5507:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   5508:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   5509:                                     $domconfig{'login'}{$key}{$img};
                   5510:                             }
1.699     raeburn  5511:                         }
                   5512:                     } else {
                   5513:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   5514:                     }
1.632     raeburn  5515:                 }
                   5516:             } else {
                   5517:                 $legacy{'login'} = 1;
1.518     albertel 5518:             }
1.632     raeburn  5519:         } else {
                   5520:             $legacy{'login'} = 1;
1.518     albertel 5521:         }
                   5522:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  5523:             if (keys(%{$domconfig{'rolecolors'}})) {
                   5524:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   5525:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   5526:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   5527:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   5528:                         }
1.518     albertel 5529:                     }
                   5530:                 }
1.632     raeburn  5531:             } else {
                   5532:                 $legacy{'rolecolors'} = 1;
1.518     albertel 5533:             }
1.632     raeburn  5534:         } else {
                   5535:             $legacy{'rolecolors'} = 1;
1.518     albertel 5536:         }
1.948     raeburn  5537:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   5538:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   5539:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   5540:             }
                   5541:         }
1.632     raeburn  5542:         if (keys(%legacy) > 0) {
                   5543:             my %legacyhash = &get_legacy_domconf($udom);
                   5544:             foreach my $item (keys(%legacyhash)) {
                   5545:                 if ($item =~ /^\Q$udom\E\.login/) {
                   5546:                     if ($legacy{'login'}) { 
                   5547:                         $designhash{$item} = $legacyhash{$item};
                   5548:                     }
                   5549:                 } else {
                   5550:                     if ($legacy{'rolecolors'}) {
                   5551:                         $designhash{$item} = $legacyhash{$item};
                   5552:                     }
1.518     albertel 5553:                 }
                   5554:             }
                   5555:         }
1.632     raeburn  5556:     } else {
                   5557:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 5558:     }
                   5559:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   5560: 				  $cachetime);
                   5561:     return %designhash;
                   5562: }
                   5563: 
1.632     raeburn  5564: sub get_legacy_domconf {
                   5565:     my ($udom) = @_;
                   5566:     my %legacyhash;
                   5567:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   5568:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   5569:     if (-e $designfile) {
                   5570:         if ( open (my $fh,"<$designfile") ) {
                   5571:             while (my $line = <$fh>) {
                   5572:                 next if ($line =~ /^\#/);
                   5573:                 chomp($line);
                   5574:                 my ($key,$val)=(split(/\=/,$line));
                   5575:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   5576:             }
                   5577:             close($fh);
                   5578:         }
                   5579:     }
1.1026    raeburn  5580:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  5581:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   5582:     }
                   5583:     return %legacyhash;
                   5584: }
                   5585: 
1.63      www      5586: =pod
                   5587: 
1.112     bowersj2 5588: =item * &domainlogo()
1.63      www      5589: 
                   5590: Inputs: $domain (usually will be undef)
                   5591: 
                   5592: Returns: A link to a domain logo, if the domain logo exists.
                   5593: If the domain logo does not exist, a description of the domain.
                   5594: 
                   5595: =cut
1.112     bowersj2 5596: 
1.63      www      5597: ###############################################
                   5598: sub domainlogo {
1.517     raeburn  5599:     my $domain = &determinedomain(shift);
1.518     albertel 5600:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  5601:     # See if there is a logo
                   5602:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  5603:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 5604:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   5605: 	    if ($imgsrc =~ m{^/res/}) {
                   5606: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   5607: 		&Apache::lonnet::repcopy($local_name);
                   5608: 	    }
                   5609: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  5610:         } 
                   5611:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 5612:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   5613:         return &Apache::lonnet::domain($domain,'description');
1.59      www      5614:     } else {
1.60      matthew  5615:         return '';
1.59      www      5616:     }
                   5617: }
1.63      www      5618: ##############################################
                   5619: 
                   5620: =pod
                   5621: 
1.112     bowersj2 5622: =item * &designparm()
1.63      www      5623: 
                   5624: Inputs: $which parameter; $domain (usually will be undef)
                   5625: 
                   5626: Returns: value of designparamter $which
                   5627: 
                   5628: =cut
1.112     bowersj2 5629: 
1.397     albertel 5630: 
1.400     albertel 5631: ##############################################
1.397     albertel 5632: sub designparm {
                   5633:     my ($which,$domain)=@_;
                   5634:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   5635:         return $env{'environment.color.'.$which};
1.96      www      5636:     }
1.63      www      5637:     $domain=&determinedomain($domain);
1.1016    raeburn  5638:     my %domdesign;
                   5639:     unless ($domain eq 'public') {
                   5640:         %domdesign = &get_domainconf($domain);
                   5641:     }
1.520     raeburn  5642:     my $output;
1.517     raeburn  5643:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   5644:         $output = $domdesign{$domain.'.'.$which};
1.63      www      5645:     } else {
1.520     raeburn  5646:         $output = $defaultdesign{$which};
                   5647:     }
                   5648:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  5649:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 5650:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   5651:             if ($output =~ m{^/res/}) {
                   5652:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   5653:                 &Apache::lonnet::repcopy($local_name);
                   5654:             }
1.520     raeburn  5655:             $output = &lonhttpdurl($output);
                   5656:         }
1.63      www      5657:     }
1.520     raeburn  5658:     return $output;
1.63      www      5659: }
1.59      www      5660: 
1.822     bisitz   5661: ##############################################
                   5662: =pod
                   5663: 
1.832     bisitz   5664: =item * &authorspace()
                   5665: 
1.1028    raeburn  5666: Inputs: $url (usually will be undef).
1.832     bisitz   5667: 
1.1132    raeburn  5668: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  5669:          directory being viewed (or for which action is being taken). 
                   5670:          If $url is provided, and begins /priv/<domain>/<uname>
                   5671:          the path will be that portion of the $context argument.
                   5672:          Otherwise the path will be for the author space of the current
                   5673:          user when the current role is author, or for that of the 
                   5674:          co-author/assistant co-author space when the current role 
                   5675:          is co-author or assistant co-author.
1.832     bisitz   5676: 
                   5677: =cut
                   5678: 
                   5679: sub authorspace {
1.1028    raeburn  5680:     my ($url) = @_;
                   5681:     if ($url ne '') {
                   5682:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   5683:            return $1;
                   5684:         }
                   5685:     }
1.832     bisitz   5686:     my $caname = '';
1.1024    www      5687:     my $cadom = '';
1.1028    raeburn  5688:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      5689:         ($cadom,$caname) =
1.832     bisitz   5690:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  5691:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   5692:         $caname = $env{'user.name'};
1.1024    www      5693:         $cadom = $env{'user.domain'};
1.832     bisitz   5694:     }
1.1028    raeburn  5695:     if (($caname ne '') && ($cadom ne '')) {
                   5696:         return "/priv/$cadom/$caname/";
                   5697:     }
                   5698:     return;
1.832     bisitz   5699: }
                   5700: 
                   5701: ##############################################
                   5702: =pod
                   5703: 
1.822     bisitz   5704: =item * &head_subbox()
                   5705: 
                   5706: Inputs: $content (contains HTML code with page functions, etc.)
                   5707: 
                   5708: Returns: HTML div with $content
                   5709:          To be included in page header
                   5710: 
                   5711: =cut
                   5712: 
                   5713: sub head_subbox {
                   5714:     my ($content)=@_;
                   5715:     my $output =
1.993     raeburn  5716:         '<div class="LC_head_subbox">'
1.822     bisitz   5717:        .$content
                   5718:        .'</div>'
                   5719: }
                   5720: 
                   5721: ##############################################
                   5722: =pod
                   5723: 
                   5724: =item * &CSTR_pageheader()
                   5725: 
1.1026    raeburn  5726: Input: (optional) filename from which breadcrumb trail is built.
                   5727:        In most cases no input as needed, as $env{'request.filename'}
                   5728:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   5729: 
                   5730: Returns: HTML div with CSTR path and recent box
1.1132    raeburn  5731:          To be included on Authoring Space pages
1.822     bisitz   5732: 
                   5733: =cut
                   5734: 
                   5735: sub CSTR_pageheader {
1.1026    raeburn  5736:     my ($trailfile) = @_;
                   5737:     if ($trailfile eq '') {
                   5738:         $trailfile = $env{'request.filename'};
                   5739:     }
                   5740: 
                   5741: # this is for resources; directories have customtitle, and crumbs
                   5742: # and select recent are created in lonpubdir.pm
                   5743: 
                   5744:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      5745:     my ($udom,$uname,$thisdisfn)=
1.1113    raeburn  5746:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  5747:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   5748:     $formaction =~ s{/+}{/}g;
1.822     bisitz   5749: 
                   5750:     my $parentpath = '';
                   5751:     my $lastitem = '';
                   5752:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   5753:         $parentpath = $1;
                   5754:         $lastitem = $2;
                   5755:     } else {
                   5756:         $lastitem = $thisdisfn;
                   5757:     }
1.921     bisitz   5758: 
1.1246    raeburn  5759:     my ($crsauthor,$title);
                   5760:     if (($env{'request.course.id'}) &&
                   5761:         ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
1.1247    raeburn  5762:         ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
1.1246    raeburn  5763:         $crsauthor = 1;
                   5764:         $title = &mt('Course Authoring Space');
                   5765:     } else {
                   5766:         $title = &mt('Authoring Space');
                   5767:     }
                   5768: 
1.921     bisitz   5769:     my $output =
1.822     bisitz   5770:          '<div>'
                   5771:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1246    raeburn  5772:         .'<b>'.$title.'</b> '
1.822     bisitz   5773:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   5774:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      5775:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   5776: 
                   5777:     if ($lastitem) {
                   5778:         $output .=
                   5779:              '<span class="LC_filename">'
                   5780:             .$lastitem
                   5781:             .'</span>';
                   5782:     }
1.1245    raeburn  5783: 
1.1246    raeburn  5784:     if ($crsauthor) {
                   5785:         $output .= '</form>'.&Apache::lonmenu::constspaceform();
                   5786:     } else {
                   5787:         $output .=
                   5788:              '<br />'
                   5789:             #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   5790:             .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   5791:             .'</form>'
                   5792:             .&Apache::lonmenu::constspaceform();
                   5793:     }
                   5794:     $output .= '</div>';
1.921     bisitz   5795: 
                   5796:     return $output;
1.822     bisitz   5797: }
                   5798: 
1.60      matthew  5799: ###############################################
                   5800: ###############################################
                   5801: 
                   5802: =pod
                   5803: 
1.112     bowersj2 5804: =back
                   5805: 
1.549     albertel 5806: =head1 HTML Helpers
1.112     bowersj2 5807: 
                   5808: =over 4
                   5809: 
                   5810: =item * &bodytag()
1.60      matthew  5811: 
                   5812: Returns a uniform header for LON-CAPA web pages.
                   5813: 
                   5814: Inputs: 
                   5815: 
1.112     bowersj2 5816: =over 4
                   5817: 
                   5818: =item * $title, A title to be displayed on the page.
                   5819: 
                   5820: =item * $function, the current role (can be undef).
                   5821: 
                   5822: =item * $addentries, extra parameters for the <body> tag.
                   5823: 
                   5824: =item * $bodyonly, if defined, only return the <body> tag.
                   5825: 
                   5826: =item * $domain, if defined, force a given domain.
                   5827: 
                   5828: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5829:             text interface only)
1.60      matthew  5830: 
1.814     bisitz   5831: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5832:                      navigational links
1.317     albertel 5833: 
1.338     albertel 5834: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5835: 
1.460     albertel 5836: =item * $args, optional argument valid values are
                   5837:             no_auto_mt_title -> prevents &mt()ing the title arg
1.1274    raeburn  5838:             use_absolute     -> for external resource or syllabus, this will
                   5839:                                 contain https://<hostname> if server uses
                   5840:                                 https (as per hosts.tab), but request is for http
                   5841:             hostname         -> hostname, from $r->hostname().
1.460     albertel 5842: 
1.1096    raeburn  5843: =item * $advtoolsref, optional argument, ref to an array containing
                   5844:             inlineremote items to be added in "Functions" menu below
                   5845:             breadcrumbs.
                   5846: 
1.112     bowersj2 5847: =back
                   5848: 
1.60      matthew  5849: Returns: A uniform header for LON-CAPA web pages.  
                   5850: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5851: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5852: other decorations will be returned.
                   5853: 
                   5854: =cut
                   5855: 
1.54      www      5856: sub bodytag {
1.831     bisitz   5857:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096    raeburn  5858:         $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339     albertel 5859: 
1.954     raeburn  5860:     my $public;
                   5861:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5862:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5863:         $public = 1;
                   5864:     }
1.460     albertel 5865:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154    raeburn  5866:     my $httphost = $args->{'use_absolute'};
1.1274    raeburn  5867:     my $hostname = $args->{'hostname'};
1.339     albertel 5868: 
1.183     matthew  5869:     $function = &get_users_function() if (!$function);
1.339     albertel 5870:     my $img =    &designparm($function.'.img',$domain);
                   5871:     my $font =   &designparm($function.'.font',$domain);
                   5872:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5873: 
1.803     bisitz   5874:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5875: 		   'bgcolor' => $pgbg,
1.339     albertel 5876: 		   'text'    => $font,
                   5877:                    'alink'   => &designparm($function.'.alink',$domain),
                   5878: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5879: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5880:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5881: 
1.63      www      5882:  # role and realm
1.1178    raeburn  5883:     my ($role,$realm) = split(m{\./},$env{'request.role'},2);
                   5884:     if ($realm) {
                   5885:         $realm = '/'.$realm;
                   5886:     }
1.378     raeburn  5887:     if ($role  eq 'ca') {
1.479     albertel 5888:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5889:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5890:     } 
1.55      www      5891: # realm
1.258     albertel 5892:     if ($env{'request.course.id'}) {
1.378     raeburn  5893:         if ($env{'request.role'} !~ /^cr/) {
                   5894:             $role = &Apache::lonnet::plaintext($role,&course_type());
1.1257    raeburn  5895:         } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1269    raeburn  5896:             if ($env{'request.role.desc'}) {
                   5897:                 $role = $env{'request.role.desc'};
                   5898:             } else {
                   5899:                 $role = &mt('Helpdesk[_1]','&nbsp;'.$2);
                   5900:             }
1.1257    raeburn  5901:         } else {
                   5902:             $role = (split(/\//,$role,4))[-1]; 
1.378     raeburn  5903:         }
1.898     raeburn  5904:         if ($env{'request.course.sec'}) {
                   5905:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5906:         }   
1.359     albertel 5907: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5908:     } else {
                   5909:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5910:     }
1.433     albertel 5911: 
1.359     albertel 5912:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5913: 
1.438     albertel 5914:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5915: 
1.101     www      5916: # construct main body tag
1.359     albertel 5917:     my $bodytag = "<body $extra_body_attr>".
1.1235    raeburn  5918: 	&Apache::lontexconvert::init_math_support();
1.252     albertel 5919: 
1.1131    raeburn  5920:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5921: 
1.1130    raeburn  5922:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5923:         return $bodytag;
1.1130    raeburn  5924:     }
1.359     albertel 5925: 
1.954     raeburn  5926:     if ($public) {
1.433     albertel 5927: 	undef($role);
                   5928:     }
1.359     albertel 5929:     
1.762     bisitz   5930:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5931:     #
                   5932:     # Extra info if you are the DC
                   5933:     my $dc_info = '';
                   5934:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5935:                         $env{'course.'.$env{'request.course.id'}.
                   5936:                                  '.domain'}.'/'})) {
                   5937:         my $cid = $env{'request.course.id'};
1.917     raeburn  5938:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5939:         $dc_info =~ s/\s+$//;
1.359     albertel 5940:     }
                   5941: 
1.1237    raeburn  5942:     my $crstype;
                   5943:     if ($env{'request.course.id'}) {
                   5944:         $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   5945:     } elsif ($args->{'crstype'}) {
                   5946:         $crstype = $args->{'crstype'};
                   5947:     }
                   5948:     if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
                   5949:         undef($role);
                   5950:     } else {
1.1242    raeburn  5951:         $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237    raeburn  5952:     }
1.853     droeschl 5953: 
1.903     droeschl 5954:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5955: 
                   5956:         #    if ($env{'request.state'} eq 'construct') {
                   5957:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5958:         #    }
                   5959: 
1.1130    raeburn  5960:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154    raeburn  5961:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 5962: 
1.1237    raeburn  5963:         my ($left,$right) = Apache::lonmenu::primary_menu($crstype);
1.359     albertel 5964: 
1.916     droeschl 5965:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917     raeburn  5966:              if ($dc_info) {
                   5967:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   5968:              }
1.1130    raeburn  5969:              $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916     droeschl 5970:                 <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5971:             return $bodytag;
                   5972:         }
1.894     droeschl 5973: 
1.927     raeburn  5974:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130    raeburn  5975:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5976:         }
1.916     droeschl 5977: 
1.1130    raeburn  5978:         $bodytag .= $right;
1.852     droeschl 5979: 
1.917     raeburn  5980:         if ($dc_info) {
                   5981:             $dc_info = &dc_courseid_toggle($dc_info);
                   5982:         }
                   5983:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5984: 
1.1169    raeburn  5985:         #if directed to not display the secondary menu, don't.  
1.1168    raeburn  5986:         if ($args->{'no_secondary_menu'}) {
                   5987:             return $bodytag;
                   5988:         }
1.1169    raeburn  5989:         #don't show menus for public users
1.954     raeburn  5990:         if (!$public){
1.1154    raeburn  5991:             $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903     droeschl 5992:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5993:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5994:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5995:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1274    raeburn  5996:                                 $args->{'bread_crumbs'},'','',$hostname);
1.1096    raeburn  5997:             } elsif ($forcereg) {
                   5998:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1258    raeburn  5999:                                                             $args->{'group'},
1.1274    raeburn  6000:                                                             $args->{'hide_buttons'},
                   6001:                                                             $hostname);
1.1096    raeburn  6002:             } else {
                   6003:                 $bodytag .= 
                   6004:                     &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   6005:                                                         $forcereg,$args->{'group'},
                   6006:                                                         $args->{'bread_crumbs'},
1.1274    raeburn  6007:                                                         $advtoolsref,'',$hostname);
1.920     raeburn  6008:             }
1.903     droeschl 6009:         }else{
                   6010:             # this is to seperate menu from content when there's no secondary
                   6011:             # menu. Especially needed for public accessible ressources.
                   6012:             $bodytag .= '<hr style="clear:both" />';
                   6013:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  6014:         }
1.903     droeschl 6015: 
1.235     raeburn  6016:         return $bodytag;
1.182     matthew  6017: }
                   6018: 
1.917     raeburn  6019: sub dc_courseid_toggle {
                   6020:     my ($dc_info) = @_;
1.980     raeburn  6021:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  6022:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  6023:            &mt('(More ...)').'</a></span>'.
                   6024:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   6025: }
                   6026: 
1.330     albertel 6027: sub make_attr_string {
                   6028:     my ($register,$attr_ref) = @_;
                   6029: 
                   6030:     if ($attr_ref && !ref($attr_ref)) {
                   6031: 	die("addentries Must be a hash ref ".
                   6032: 	    join(':',caller(1))." ".
                   6033: 	    join(':',caller(0))." ");
                   6034:     }
                   6035: 
                   6036:     if ($register) {
1.339     albertel 6037: 	my ($on_load,$on_unload);
                   6038: 	foreach my $key (keys(%{$attr_ref})) {
                   6039: 	    if      (lc($key) eq 'onload') {
                   6040: 		$on_load.=$attr_ref->{$key}.';';
                   6041: 		delete($attr_ref->{$key});
                   6042: 
                   6043: 	    } elsif (lc($key) eq 'onunload') {
                   6044: 		$on_unload.=$attr_ref->{$key}.';';
                   6045: 		delete($attr_ref->{$key});
                   6046: 	    }
                   6047: 	}
1.953     droeschl 6048: 	$attr_ref->{'onload'}  = $on_load;
                   6049: 	$attr_ref->{'onunload'}= $on_unload;
1.330     albertel 6050:     }
1.339     albertel 6051: 
1.330     albertel 6052:     my $attr_string;
1.1159    raeburn  6053:     foreach my $attr (sort(keys(%$attr_ref))) {
1.330     albertel 6054: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   6055:     }
                   6056:     return $attr_string;
                   6057: }
                   6058: 
                   6059: 
1.182     matthew  6060: ###############################################
1.251     albertel 6061: ###############################################
                   6062: 
                   6063: =pod
                   6064: 
                   6065: =item * &endbodytag()
                   6066: 
                   6067: Returns a uniform footer for LON-CAPA web pages.
                   6068: 
1.635     raeburn  6069: Inputs: 1 - optional reference to an args hash
                   6070: If in the hash, key for noredirectlink has a value which evaluates to true,
                   6071: a 'Continue' link is not displayed if the page contains an
                   6072: internal redirect in the <head></head> section,
                   6073: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 6074: 
                   6075: =cut
                   6076: 
                   6077: sub endbodytag {
1.635     raeburn  6078:     my ($args) = @_;
1.1080    raeburn  6079:     my $endbodytag;
                   6080:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   6081:         $endbodytag='</body>';
                   6082:     }
1.315     albertel 6083:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  6084:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   6085: 	    $endbodytag=
                   6086: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   6087: 	        &mt('Continue').'</a>'.
                   6088: 	        $endbodytag;
                   6089:         }
1.315     albertel 6090:     }
1.251     albertel 6091:     return $endbodytag;
                   6092: }
                   6093: 
1.352     albertel 6094: =pod
                   6095: 
                   6096: =item * &standard_css()
                   6097: 
                   6098: Returns a style sheet
                   6099: 
                   6100: Inputs: (all optional)
                   6101:             domain         -> force to color decorate a page for a specific
                   6102:                                domain
                   6103:             function       -> force usage of a specific rolish color scheme
                   6104:             bgcolor        -> override the default page bgcolor
                   6105: 
                   6106: =cut
                   6107: 
1.343     albertel 6108: sub standard_css {
1.345     albertel 6109:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 6110:     $function  = &get_users_function() if (!$function);
                   6111:     my $img    = &designparm($function.'.img',   $domain);
                   6112:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   6113:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 6114:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 6115: #second colour for later usage
1.345     albertel 6116:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 6117:     my $pgbg_or_bgcolor =
                   6118: 	         $bgcolor ||
1.352     albertel 6119: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 6120:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 6121:     my $alink  = &designparm($function.'.alink', $domain);
                   6122:     my $vlink  = &designparm($function.'.vlink', $domain);
                   6123:     my $link   = &designparm($function.'.link',  $domain);
                   6124: 
1.602     albertel 6125:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 6126:     my $mono                 = 'monospace';
1.850     bisitz   6127:     my $data_table_head      = $sidebg;
                   6128:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   6129:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 6130:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 6131:     my $data_table_highlight = '#FFFF00';
1.352     albertel 6132:     my $mail_new             = '#FFBB77';
                   6133:     my $mail_new_hover       = '#DD9955';
                   6134:     my $mail_read            = '#BBBB77';
                   6135:     my $mail_read_hover      = '#999944';
                   6136:     my $mail_replied         = '#AAAA88';
                   6137:     my $mail_replied_hover   = '#888855';
                   6138:     my $mail_other           = '#99BBBB';
                   6139:     my $mail_other_hover     = '#669999';
1.391     albertel 6140:     my $table_header         = '#DDDDDD';
1.489     raeburn  6141:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   6142:     my $lg_border_color      = '#C8C8C8';
1.952     onken    6143:     my $button_hover         = '#BF2317';
1.392     albertel 6144: 
1.608     albertel 6145:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   6146:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   6147:                                              : '0 3px 0 4px';
1.448     albertel 6148: 
1.523     albertel 6149: 
1.343     albertel 6150:     return <<END;
1.947     droeschl 6151: 
                   6152: /* needed for iframe to allow 100% height in FF */
                   6153: body, html { 
                   6154:     margin: 0;
                   6155:     padding: 0 0.5%;
                   6156:     height: 99%; /* to avoid scrollbars */
                   6157: }
                   6158: 
1.795     www      6159: body {
1.911     bisitz   6160:   font-family: $sans;
                   6161:   line-height:130%;
                   6162:   font-size:0.83em;
                   6163:   color:$font;
1.795     www      6164: }
                   6165: 
1.959     onken    6166: a:focus,
                   6167: a:focus img {
1.795     www      6168:   color: red;
                   6169: }
1.698     harmsja  6170: 
1.911     bisitz   6171: form, .inline {
                   6172:   display: inline;
1.795     www      6173: }
1.721     harmsja  6174: 
1.795     www      6175: .LC_right {
1.911     bisitz   6176:   text-align:right;
1.795     www      6177: }
                   6178: 
                   6179: .LC_middle {
1.911     bisitz   6180:   vertical-align:middle;
1.795     www      6181: }
1.721     harmsja  6182: 
1.1130    raeburn  6183: .LC_floatleft {
                   6184:   float: left;
                   6185: }
                   6186: 
                   6187: .LC_floatright {
                   6188:   float: right;
                   6189: }
                   6190: 
1.911     bisitz   6191: .LC_400Box {
                   6192:   width:400px;
                   6193: }
1.721     harmsja  6194: 
1.947     droeschl 6195: .LC_iframecontainer {
                   6196:     width: 98%;
                   6197:     margin: 0;
                   6198:     position: fixed;
                   6199:     top: 8.5em;
                   6200:     bottom: 0;
                   6201: }
                   6202: 
                   6203: .LC_iframecontainer iframe{
                   6204:     border: none;
                   6205:     width: 100%;
                   6206:     height: 100%;
                   6207: }
                   6208: 
1.778     bisitz   6209: .LC_filename {
                   6210:   font-family: $mono;
                   6211:   white-space:pre;
1.921     bisitz   6212:   font-size: 120%;
1.778     bisitz   6213: }
                   6214: 
                   6215: .LC_fileicon {
                   6216:   border: none;
                   6217:   height: 1.3em;
                   6218:   vertical-align: text-bottom;
                   6219:   margin-right: 0.3em;
                   6220:   text-decoration:none;
                   6221: }
                   6222: 
1.1008    www      6223: .LC_setting {
                   6224:   text-decoration:underline;
                   6225: }
                   6226: 
1.350     albertel 6227: .LC_error {
                   6228:   color: red;
                   6229: }
1.795     www      6230: 
1.1097    bisitz   6231: .LC_warning {
                   6232:   color: darkorange;
                   6233: }
                   6234: 
1.457     albertel 6235: .LC_diff_removed {
1.733     bisitz   6236:   color: red;
1.394     albertel 6237: }
1.532     albertel 6238: 
                   6239: .LC_info,
1.457     albertel 6240: .LC_success,
                   6241: .LC_diff_added {
1.350     albertel 6242:   color: green;
                   6243: }
1.795     www      6244: 
1.802     bisitz   6245: div.LC_confirm_box {
                   6246:   background-color: #FAFAFA;
                   6247:   border: 1px solid $lg_border_color;
                   6248:   margin-right: 0;
                   6249:   padding: 5px;
                   6250: }
                   6251: 
                   6252: div.LC_confirm_box .LC_error img,
                   6253: div.LC_confirm_box .LC_success img {
                   6254:   vertical-align: middle;
                   6255: }
                   6256: 
1.1242    raeburn  6257: .LC_maxwidth {
                   6258:   max-width: 100%;
                   6259:   height: auto;
                   6260: }
                   6261: 
1.1243    raeburn  6262: .LC_textsize_mobile {
                   6263:   \@media only screen and (max-device-width: 480px) {
                   6264:       -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
                   6265:   }
                   6266: }
                   6267: 
1.440     albertel 6268: .LC_icon {
1.771     droeschl 6269:   border: none;
1.790     droeschl 6270:   vertical-align: middle;
1.771     droeschl 6271: }
                   6272: 
1.543     albertel 6273: .LC_docs_spacer {
                   6274:   width: 25px;
                   6275:   height: 1px;
1.771     droeschl 6276:   border: none;
1.543     albertel 6277: }
1.346     albertel 6278: 
1.532     albertel 6279: .LC_internal_info {
1.735     bisitz   6280:   color: #999999;
1.532     albertel 6281: }
                   6282: 
1.794     www      6283: .LC_discussion {
1.1050    www      6284:   background: $data_table_dark;
1.911     bisitz   6285:   border: 1px solid black;
                   6286:   margin: 2px;
1.794     www      6287: }
                   6288: 
                   6289: .LC_disc_action_left {
1.1050    www      6290:   background: $sidebg;
1.911     bisitz   6291:   text-align: left;
1.1050    www      6292:   padding: 4px;
                   6293:   margin: 2px;
1.794     www      6294: }
                   6295: 
                   6296: .LC_disc_action_right {
1.1050    www      6297:   background: $sidebg;
1.911     bisitz   6298:   text-align: right;
1.1050    www      6299:   padding: 4px;
                   6300:   margin: 2px;
1.794     www      6301: }
                   6302: 
                   6303: .LC_disc_new_item {
1.911     bisitz   6304:   background: white;
                   6305:   border: 2px solid red;
1.1050    www      6306:   margin: 4px;
                   6307:   padding: 4px;
1.794     www      6308: }
                   6309: 
                   6310: .LC_disc_old_item {
1.911     bisitz   6311:   background: white;
1.1050    www      6312:   margin: 4px;
                   6313:   padding: 4px;
1.794     www      6314: }
                   6315: 
1.458     albertel 6316: table.LC_pastsubmission {
                   6317:   border: 1px solid black;
                   6318:   margin: 2px;
                   6319: }
                   6320: 
1.924     bisitz   6321: table#LC_menubuttons {
1.345     albertel 6322:   width: 100%;
                   6323:   background: $pgbg;
1.392     albertel 6324:   border: 2px;
1.402     albertel 6325:   border-collapse: separate;
1.803     bisitz   6326:   padding: 0;
1.345     albertel 6327: }
1.392     albertel 6328: 
1.801     tempelho 6329: table#LC_title_bar a {
                   6330:   color: $fontmenu;
                   6331: }
1.836     bisitz   6332: 
1.807     droeschl 6333: table#LC_title_bar {
1.819     tempelho 6334:   clear: both;
1.836     bisitz   6335:   display: none;
1.807     droeschl 6336: }
                   6337: 
1.795     www      6338: table#LC_title_bar,
1.933     droeschl 6339: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 6340: table#LC_title_bar.LC_with_remote {
1.359     albertel 6341:   width: 100%;
1.392     albertel 6342:   border-color: $pgbg;
                   6343:   border-style: solid;
                   6344:   border-width: $border;
1.379     albertel 6345:   background: $pgbg;
1.801     tempelho 6346:   color: $fontmenu;
1.392     albertel 6347:   border-collapse: collapse;
1.803     bisitz   6348:   padding: 0;
1.819     tempelho 6349:   margin: 0;
1.359     albertel 6350: }
1.795     www      6351: 
1.933     droeschl 6352: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 6353:     margin: 0;
                   6354:     padding: 0;
1.933     droeschl 6355:     position: relative;
                   6356:     list-style: none;
1.913     droeschl 6357: }
1.933     droeschl 6358: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 6359:     display: inline;
                   6360: }
1.933     droeschl 6361: 
                   6362: .LC_breadcrumb_tools_navigation {
1.913     droeschl 6363:     padding: 0;
1.933     droeschl 6364:     margin: 0;
                   6365:     float: left;
1.913     droeschl 6366: }
1.933     droeschl 6367: .LC_breadcrumb_tools_tools {
                   6368:     padding: 0;
                   6369:     margin: 0;
1.913     droeschl 6370:     float: right;
                   6371: }
                   6372: 
1.1240    raeburn  6373: .LC_placement_prog {
                   6374:     padding-right: 20px;
                   6375:     font-weight: bold;
                   6376:     font-size: 90%;
                   6377: }
                   6378: 
1.359     albertel 6379: table#LC_title_bar td {
                   6380:   background: $tabbg;
                   6381: }
1.795     www      6382: 
1.911     bisitz   6383: table#LC_menubuttons img {
1.803     bisitz   6384:   border: none;
1.346     albertel 6385: }
1.795     www      6386: 
1.842     droeschl 6387: .LC_breadcrumbs_component {
1.911     bisitz   6388:   float: right;
                   6389:   margin: 0 1em;
1.357     albertel 6390: }
1.842     droeschl 6391: .LC_breadcrumbs_component img {
1.911     bisitz   6392:   vertical-align: middle;
1.777     tempelho 6393: }
1.795     www      6394: 
1.1243    raeburn  6395: .LC_breadcrumbs_hoverable {
                   6396:   background: $sidebg;
                   6397: }
                   6398: 
1.383     albertel 6399: td.LC_table_cell_checkbox {
                   6400:   text-align: center;
                   6401: }
1.795     www      6402: 
                   6403: .LC_fontsize_small {
1.911     bisitz   6404:   font-size: 70%;
1.705     tempelho 6405: }
                   6406: 
1.844     bisitz   6407: #LC_breadcrumbs {
1.911     bisitz   6408:   clear:both;
                   6409:   background: $sidebg;
                   6410:   border-bottom: 1px solid $lg_border_color;
                   6411:   line-height: 2.5em;
1.933     droeschl 6412:   overflow: hidden;
1.911     bisitz   6413:   margin: 0;
                   6414:   padding: 0;
1.995     raeburn  6415:   text-align: left;
1.819     tempelho 6416: }
1.862     bisitz   6417: 
1.1098    bisitz   6418: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   6419:   clear:both;
                   6420:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 6421:   border: 1px solid $sidebg;
1.1098    bisitz   6422:   margin: 0 0 10px 0;
1.966     bisitz   6423:   padding: 3px;
1.995     raeburn  6424:   text-align: left;
1.822     bisitz   6425: }
                   6426: 
1.795     www      6427: .LC_fontsize_medium {
1.911     bisitz   6428:   font-size: 85%;
1.705     tempelho 6429: }
                   6430: 
1.795     www      6431: .LC_fontsize_large {
1.911     bisitz   6432:   font-size: 120%;
1.705     tempelho 6433: }
                   6434: 
1.346     albertel 6435: .LC_menubuttons_inline_text {
                   6436:   color: $font;
1.698     harmsja  6437:   font-size: 90%;
1.701     harmsja  6438:   padding-left:3px;
1.346     albertel 6439: }
                   6440: 
1.934     droeschl 6441: .LC_menubuttons_inline_text img{
                   6442:   vertical-align: middle;
                   6443: }
                   6444: 
1.1051    www      6445: li.LC_menubuttons_inline_text img {
1.951     onken    6446:   cursor:pointer;
1.1002    droeschl 6447:   text-decoration: none;
1.951     onken    6448: }
                   6449: 
1.526     www      6450: .LC_menubuttons_link {
                   6451:   text-decoration: none;
                   6452: }
1.795     www      6453: 
1.522     albertel 6454: .LC_menubuttons_category {
1.521     www      6455:   color: $font;
1.526     www      6456:   background: $pgbg;
1.521     www      6457:   font-size: larger;
                   6458:   font-weight: bold;
                   6459: }
                   6460: 
1.346     albertel 6461: td.LC_menubuttons_text {
1.911     bisitz   6462:   color: $font;
1.346     albertel 6463: }
1.706     harmsja  6464: 
1.346     albertel 6465: .LC_current_location {
                   6466:   background: $tabbg;
                   6467: }
1.795     www      6468: 
1.1286    raeburn  6469: td.LC_zero_height {
                   6470:   line-height: 0; 
                   6471:   cellpadding: 0;
                   6472: }
                   6473: 
1.938     bisitz   6474: table.LC_data_table {
1.347     albertel 6475:   border: 1px solid #000000;
1.402     albertel 6476:   border-collapse: separate;
1.426     albertel 6477:   border-spacing: 1px;
1.610     albertel 6478:   background: $pgbg;
1.347     albertel 6479: }
1.795     www      6480: 
1.422     albertel 6481: .LC_data_table_dense {
                   6482:   font-size: small;
                   6483: }
1.795     www      6484: 
1.507     raeburn  6485: table.LC_nested_outer {
                   6486:   border: 1px solid #000000;
1.589     raeburn  6487:   border-collapse: collapse;
1.803     bisitz   6488:   border-spacing: 0;
1.507     raeburn  6489:   width: 100%;
                   6490: }
1.795     www      6491: 
1.879     raeburn  6492: table.LC_innerpickbox,
1.507     raeburn  6493: table.LC_nested {
1.803     bisitz   6494:   border: none;
1.589     raeburn  6495:   border-collapse: collapse;
1.803     bisitz   6496:   border-spacing: 0;
1.507     raeburn  6497:   width: 100%;
                   6498: }
1.795     www      6499: 
1.911     bisitz   6500: table.LC_data_table tr th,
                   6501: table.LC_calendar tr th,
1.879     raeburn  6502: table.LC_prior_tries tr th,
                   6503: table.LC_innerpickbox tr th {
1.349     albertel 6504:   font-weight: bold;
                   6505:   background-color: $data_table_head;
1.801     tempelho 6506:   color:$fontmenu;
1.701     harmsja  6507:   font-size:90%;
1.347     albertel 6508: }
1.795     www      6509: 
1.879     raeburn  6510: table.LC_innerpickbox tr th,
                   6511: table.LC_innerpickbox tr td {
                   6512:   vertical-align: top;
                   6513: }
                   6514: 
1.711     raeburn  6515: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   6516:   background-color: #CCCCCC;
1.711     raeburn  6517:   font-weight: bold;
                   6518:   text-align: left;
                   6519: }
1.795     www      6520: 
1.912     bisitz   6521: table.LC_data_table tr.LC_odd_row > td {
                   6522:   background-color: $data_table_light;
                   6523:   padding: 2px;
                   6524:   vertical-align: top;
                   6525: }
                   6526: 
1.809     bisitz   6527: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 6528:   background-color: $data_table_light;
1.912     bisitz   6529:   vertical-align: top;
                   6530: }
                   6531: 
                   6532: table.LC_data_table tr.LC_even_row > td {
                   6533:   background-color: $data_table_dark;
1.425     albertel 6534:   padding: 2px;
1.900     bisitz   6535:   vertical-align: top;
1.347     albertel 6536: }
1.795     www      6537: 
1.809     bisitz   6538: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 6539:   background-color: $data_table_dark;
1.900     bisitz   6540:   vertical-align: top;
1.347     albertel 6541: }
1.795     www      6542: 
1.425     albertel 6543: table.LC_data_table tr.LC_data_table_highlight td {
                   6544:   background-color: $data_table_darker;
                   6545: }
1.795     www      6546: 
1.639     raeburn  6547: table.LC_data_table tr td.LC_leftcol_header {
                   6548:   background-color: $data_table_head;
                   6549:   font-weight: bold;
                   6550: }
1.795     www      6551: 
1.451     albertel 6552: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  6553: table.LC_nested tr.LC_empty_row td {
1.421     albertel 6554:   font-weight: bold;
                   6555:   font-style: italic;
                   6556:   text-align: center;
                   6557:   padding: 8px;
1.347     albertel 6558: }
1.795     www      6559: 
1.1114    raeburn  6560: table.LC_data_table tr.LC_empty_row td,
                   6561: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   6562:   background-color: $sidebg;
                   6563: }
                   6564: 
                   6565: table.LC_nested tr.LC_empty_row td {
                   6566:   background-color: #FFFFFF;
                   6567: }
                   6568: 
1.890     droeschl 6569: table.LC_caption {
                   6570: }
                   6571: 
1.507     raeburn  6572: table.LC_nested tr.LC_empty_row td {
1.465     albertel 6573:   padding: 4ex
                   6574: }
1.795     www      6575: 
1.507     raeburn  6576: table.LC_nested_outer tr th {
                   6577:   font-weight: bold;
1.801     tempelho 6578:   color:$fontmenu;
1.507     raeburn  6579:   background-color: $data_table_head;
1.701     harmsja  6580:   font-size: small;
1.507     raeburn  6581:   border-bottom: 1px solid #000000;
                   6582: }
1.795     www      6583: 
1.507     raeburn  6584: table.LC_nested_outer tr td.LC_subheader {
                   6585:   background-color: $data_table_head;
                   6586:   font-weight: bold;
                   6587:   font-size: small;
                   6588:   border-bottom: 1px solid #000000;
                   6589:   text-align: right;
1.451     albertel 6590: }
1.795     www      6591: 
1.507     raeburn  6592: table.LC_nested tr.LC_info_row td {
1.735     bisitz   6593:   background-color: #CCCCCC;
1.451     albertel 6594:   font-weight: bold;
                   6595:   font-size: small;
1.507     raeburn  6596:   text-align: center;
                   6597: }
1.795     www      6598: 
1.589     raeburn  6599: table.LC_nested tr.LC_info_row td.LC_left_item,
                   6600: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  6601:   text-align: left;
1.451     albertel 6602: }
1.795     www      6603: 
1.507     raeburn  6604: table.LC_nested td {
1.735     bisitz   6605:   background-color: #FFFFFF;
1.451     albertel 6606:   font-size: small;
1.507     raeburn  6607: }
1.795     www      6608: 
1.507     raeburn  6609: table.LC_nested_outer tr th.LC_right_item,
                   6610: table.LC_nested tr.LC_info_row td.LC_right_item,
                   6611: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   6612: table.LC_nested tr td.LC_right_item {
1.451     albertel 6613:   text-align: right;
                   6614: }
                   6615: 
1.507     raeburn  6616: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   6617:   background-color: #EEEEEE;
1.451     albertel 6618: }
                   6619: 
1.473     raeburn  6620: table.LC_createuser {
                   6621: }
                   6622: 
                   6623: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  6624:   font-size: small;
1.473     raeburn  6625: }
                   6626: 
                   6627: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   6628:   background-color: #CCCCCC;
1.473     raeburn  6629:   font-weight: bold;
                   6630:   text-align: center;
                   6631: }
                   6632: 
1.349     albertel 6633: table.LC_calendar {
                   6634:   border: 1px solid #000000;
                   6635:   border-collapse: collapse;
1.917     raeburn  6636:   width: 98%;
1.349     albertel 6637: }
1.795     www      6638: 
1.349     albertel 6639: table.LC_calendar_pickdate {
                   6640:   font-size: xx-small;
                   6641: }
1.795     www      6642: 
1.349     albertel 6643: table.LC_calendar tr td {
                   6644:   border: 1px solid #000000;
                   6645:   vertical-align: top;
1.917     raeburn  6646:   width: 14%;
1.349     albertel 6647: }
1.795     www      6648: 
1.349     albertel 6649: table.LC_calendar tr td.LC_calendar_day_empty {
                   6650:   background-color: $data_table_dark;
                   6651: }
1.795     www      6652: 
1.779     bisitz   6653: table.LC_calendar tr td.LC_calendar_day_current {
                   6654:   background-color: $data_table_highlight;
1.777     tempelho 6655: }
1.795     www      6656: 
1.938     bisitz   6657: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 6658:   background-color: $mail_new;
                   6659: }
1.795     www      6660: 
1.938     bisitz   6661: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 6662:   background-color: $mail_new_hover;
                   6663: }
1.795     www      6664: 
1.938     bisitz   6665: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 6666:   background-color: $mail_read;
                   6667: }
1.795     www      6668: 
1.938     bisitz   6669: /*
                   6670: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 6671:   background-color: $mail_read_hover;
                   6672: }
1.938     bisitz   6673: */
1.795     www      6674: 
1.938     bisitz   6675: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 6676:   background-color: $mail_replied;
                   6677: }
1.795     www      6678: 
1.938     bisitz   6679: /*
                   6680: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 6681:   background-color: $mail_replied_hover;
                   6682: }
1.938     bisitz   6683: */
1.795     www      6684: 
1.938     bisitz   6685: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 6686:   background-color: $mail_other;
                   6687: }
1.795     www      6688: 
1.938     bisitz   6689: /*
                   6690: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 6691:   background-color: $mail_other_hover;
                   6692: }
1.938     bisitz   6693: */
1.494     raeburn  6694: 
1.777     tempelho 6695: table.LC_data_table tr > td.LC_browser_file,
                   6696: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   6697:   background: #AAEE77;
1.389     albertel 6698: }
1.795     www      6699: 
1.777     tempelho 6700: table.LC_data_table tr > td.LC_browser_file_locked,
                   6701: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 6702:   background: #FFAA99;
1.387     albertel 6703: }
1.795     www      6704: 
1.777     tempelho 6705: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   6706:   background: #888888;
1.779     bisitz   6707: }
1.795     www      6708: 
1.777     tempelho 6709: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   6710: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   6711:   background: #F8F866;
1.777     tempelho 6712: }
1.795     www      6713: 
1.696     bisitz   6714: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   6715:   background: #E0E8FF;
1.387     albertel 6716: }
1.696     bisitz   6717: 
1.707     bisitz   6718: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   6719:   /* background: #77FF77; */
1.707     bisitz   6720: }
1.795     www      6721: 
1.707     bisitz   6722: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   6723:   border-right: 8px solid #FFFF77;
1.707     bisitz   6724: }
1.795     www      6725: 
1.707     bisitz   6726: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   6727:   border-right: 8px solid #FFAA77;
1.707     bisitz   6728: }
1.795     www      6729: 
1.707     bisitz   6730: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   6731:   border-right: 8px solid #FF7777;
1.707     bisitz   6732: }
1.795     www      6733: 
1.707     bisitz   6734: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   6735:   border-right: 8px solid #AAFF77;
1.707     bisitz   6736: }
1.795     www      6737: 
1.707     bisitz   6738: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   6739:   border-right: 8px solid #11CC55;
1.707     bisitz   6740: }
                   6741: 
1.388     albertel 6742: span.LC_current_location {
1.701     harmsja  6743:   font-size:larger;
1.388     albertel 6744:   background: $pgbg;
                   6745: }
1.387     albertel 6746: 
1.1029    www      6747: span.LC_current_nav_location {
                   6748:   font-weight:bold;
                   6749:   background: $sidebg;
                   6750: }
                   6751: 
1.395     albertel 6752: span.LC_parm_menu_item {
                   6753:   font-size: larger;
                   6754: }
1.795     www      6755: 
1.395     albertel 6756: span.LC_parm_scope_all {
                   6757:   color: red;
                   6758: }
1.795     www      6759: 
1.395     albertel 6760: span.LC_parm_scope_folder {
                   6761:   color: green;
                   6762: }
1.795     www      6763: 
1.395     albertel 6764: span.LC_parm_scope_resource {
                   6765:   color: orange;
                   6766: }
1.795     www      6767: 
1.395     albertel 6768: span.LC_parm_part {
                   6769:   color: blue;
                   6770: }
1.795     www      6771: 
1.911     bisitz   6772: span.LC_parm_folder,
                   6773: span.LC_parm_symb {
1.395     albertel 6774:   font-size: x-small;
                   6775:   font-family: $mono;
                   6776:   color: #AAAAAA;
                   6777: }
                   6778: 
1.977     bisitz   6779: ul.LC_parm_parmlist li {
                   6780:   display: inline-block;
                   6781:   padding: 0.3em 0.8em;
                   6782:   vertical-align: top;
                   6783:   width: 150px;
                   6784:   border-top:1px solid $lg_border_color;
                   6785: }
                   6786: 
1.795     www      6787: td.LC_parm_overview_level_menu,
                   6788: td.LC_parm_overview_map_menu,
                   6789: td.LC_parm_overview_parm_selectors,
                   6790: td.LC_parm_overview_restrictions  {
1.396     albertel 6791:   border: 1px solid black;
                   6792:   border-collapse: collapse;
                   6793: }
1.795     www      6794: 
1.1285    raeburn  6795: span.LC_parm_recursive,
                   6796: td.LC_parm_recursive {
                   6797:   font-weight: bold;
                   6798:   font-size: smaller;
                   6799: }
                   6800: 
1.396     albertel 6801: table.LC_parm_overview_restrictions td {
                   6802:   border-width: 1px 4px 1px 4px;
                   6803:   border-style: solid;
                   6804:   border-color: $pgbg;
                   6805:   text-align: center;
                   6806: }
1.795     www      6807: 
1.396     albertel 6808: table.LC_parm_overview_restrictions th {
                   6809:   background: $tabbg;
                   6810:   border-width: 1px 4px 1px 4px;
                   6811:   border-style: solid;
                   6812:   border-color: $pgbg;
                   6813: }
1.795     www      6814: 
1.398     albertel 6815: table#LC_helpmenu {
1.803     bisitz   6816:   border: none;
1.398     albertel 6817:   height: 55px;
1.803     bisitz   6818:   border-spacing: 0;
1.398     albertel 6819: }
                   6820: 
                   6821: table#LC_helpmenu fieldset legend {
                   6822:   font-size: larger;
                   6823: }
1.795     www      6824: 
1.397     albertel 6825: table#LC_helpmenu_links {
                   6826:   width: 100%;
                   6827:   border: 1px solid black;
                   6828:   background: $pgbg;
1.803     bisitz   6829:   padding: 0;
1.397     albertel 6830:   border-spacing: 1px;
                   6831: }
1.795     www      6832: 
1.397     albertel 6833: table#LC_helpmenu_links tr td {
                   6834:   padding: 1px;
                   6835:   background: $tabbg;
1.399     albertel 6836:   text-align: center;
                   6837:   font-weight: bold;
1.397     albertel 6838: }
1.396     albertel 6839: 
1.795     www      6840: table#LC_helpmenu_links a:link,
                   6841: table#LC_helpmenu_links a:visited,
1.397     albertel 6842: table#LC_helpmenu_links a:active {
                   6843:   text-decoration: none;
                   6844:   color: $font;
                   6845: }
1.795     www      6846: 
1.397     albertel 6847: table#LC_helpmenu_links a:hover {
                   6848:   text-decoration: underline;
                   6849:   color: $vlink;
                   6850: }
1.396     albertel 6851: 
1.417     albertel 6852: .LC_chrt_popup_exists {
                   6853:   border: 1px solid #339933;
                   6854:   margin: -1px;
                   6855: }
1.795     www      6856: 
1.417     albertel 6857: .LC_chrt_popup_up {
                   6858:   border: 1px solid yellow;
                   6859:   margin: -1px;
                   6860: }
1.795     www      6861: 
1.417     albertel 6862: .LC_chrt_popup {
                   6863:   border: 1px solid #8888FF;
                   6864:   background: #CCCCFF;
                   6865: }
1.795     www      6866: 
1.421     albertel 6867: table.LC_pick_box {
                   6868:   border-collapse: separate;
                   6869:   background: white;
                   6870:   border: 1px solid black;
                   6871:   border-spacing: 1px;
                   6872: }
1.795     www      6873: 
1.421     albertel 6874: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6875:   background: $sidebg;
1.421     albertel 6876:   font-weight: bold;
1.900     bisitz   6877:   text-align: left;
1.740     bisitz   6878:   vertical-align: top;
1.421     albertel 6879:   width: 184px;
                   6880:   padding: 8px;
                   6881: }
1.795     www      6882: 
1.579     raeburn  6883: table.LC_pick_box td.LC_pick_box_value {
                   6884:   text-align: left;
                   6885:   padding: 8px;
                   6886: }
1.795     www      6887: 
1.579     raeburn  6888: table.LC_pick_box td.LC_pick_box_select {
                   6889:   text-align: left;
                   6890:   padding: 8px;
                   6891: }
1.795     www      6892: 
1.424     albertel 6893: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6894:   padding: 0;
1.421     albertel 6895:   height: 1px;
                   6896:   background: black;
                   6897: }
1.795     www      6898: 
1.421     albertel 6899: table.LC_pick_box td.LC_pick_box_submit {
                   6900:   text-align: right;
                   6901: }
1.795     www      6902: 
1.579     raeburn  6903: table.LC_pick_box td.LC_evenrow_value {
                   6904:   text-align: left;
                   6905:   padding: 8px;
                   6906:   background-color: $data_table_light;
                   6907: }
1.795     www      6908: 
1.579     raeburn  6909: table.LC_pick_box td.LC_oddrow_value {
                   6910:   text-align: left;
                   6911:   padding: 8px;
                   6912:   background-color: $data_table_light;
                   6913: }
1.795     www      6914: 
1.579     raeburn  6915: span.LC_helpform_receipt_cat {
                   6916:   font-weight: bold;
                   6917: }
1.795     www      6918: 
1.424     albertel 6919: table.LC_group_priv_box {
                   6920:   background: white;
                   6921:   border: 1px solid black;
                   6922:   border-spacing: 1px;
                   6923: }
1.795     www      6924: 
1.424     albertel 6925: table.LC_group_priv_box td.LC_pick_box_title {
                   6926:   background: $tabbg;
                   6927:   font-weight: bold;
                   6928:   text-align: right;
                   6929:   width: 184px;
                   6930: }
1.795     www      6931: 
1.424     albertel 6932: table.LC_group_priv_box td.LC_groups_fixed {
                   6933:   background: $data_table_light;
                   6934:   text-align: center;
                   6935: }
1.795     www      6936: 
1.424     albertel 6937: table.LC_group_priv_box td.LC_groups_optional {
                   6938:   background: $data_table_dark;
                   6939:   text-align: center;
                   6940: }
1.795     www      6941: 
1.424     albertel 6942: table.LC_group_priv_box td.LC_groups_functionality {
                   6943:   background: $data_table_darker;
                   6944:   text-align: center;
                   6945:   font-weight: bold;
                   6946: }
1.795     www      6947: 
1.424     albertel 6948: table.LC_group_priv td {
                   6949:   text-align: left;
1.803     bisitz   6950:   padding: 0;
1.424     albertel 6951: }
                   6952: 
                   6953: .LC_navbuttons {
                   6954:   margin: 2ex 0ex 2ex 0ex;
                   6955: }
1.795     www      6956: 
1.423     albertel 6957: .LC_topic_bar {
                   6958:   font-weight: bold;
                   6959:   background: $tabbg;
1.918     wenzelju 6960:   margin: 1em 0em 1em 2em;
1.805     bisitz   6961:   padding: 3px;
1.918     wenzelju 6962:   font-size: 1.2em;
1.423     albertel 6963: }
1.795     www      6964: 
1.423     albertel 6965: .LC_topic_bar span {
1.918     wenzelju 6966:   left: 0.5em;
                   6967:   position: absolute;
1.423     albertel 6968:   vertical-align: middle;
1.918     wenzelju 6969:   font-size: 1.2em;
1.423     albertel 6970: }
1.795     www      6971: 
1.423     albertel 6972: table.LC_course_group_status {
                   6973:   margin: 20px;
                   6974: }
1.795     www      6975: 
1.423     albertel 6976: table.LC_status_selector td {
                   6977:   vertical-align: top;
                   6978:   text-align: center;
1.424     albertel 6979:   padding: 4px;
                   6980: }
1.795     www      6981: 
1.599     albertel 6982: div.LC_feedback_link {
1.616     albertel 6983:   clear: both;
1.829     kalberla 6984:   background: $sidebg;
1.779     bisitz   6985:   width: 100%;
1.829     kalberla 6986:   padding-bottom: 10px;
                   6987:   border: 1px $tabbg solid;
1.833     kalberla 6988:   height: 22px;
                   6989:   line-height: 22px;
                   6990:   padding-top: 5px;
                   6991: }
                   6992: 
                   6993: div.LC_feedback_link img {
                   6994:   height: 22px;
1.867     kalberla 6995:   vertical-align:middle;
1.829     kalberla 6996: }
                   6997: 
1.911     bisitz   6998: div.LC_feedback_link a {
1.829     kalberla 6999:   text-decoration: none;
1.489     raeburn  7000: }
1.795     www      7001: 
1.867     kalberla 7002: div.LC_comblock {
1.911     bisitz   7003:   display:inline;
1.867     kalberla 7004:   color:$font;
                   7005:   font-size:90%;
                   7006: }
                   7007: 
                   7008: div.LC_feedback_link div.LC_comblock {
                   7009:   padding-left:5px;
                   7010: }
                   7011: 
                   7012: div.LC_feedback_link div.LC_comblock a {
                   7013:   color:$font;
                   7014: }
                   7015: 
1.489     raeburn  7016: span.LC_feedback_link {
1.858     bisitz   7017:   /* background: $feedback_link_bg; */
1.599     albertel 7018:   font-size: larger;
                   7019: }
1.795     www      7020: 
1.599     albertel 7021: span.LC_message_link {
1.858     bisitz   7022:   /* background: $feedback_link_bg; */
1.599     albertel 7023:   font-size: larger;
                   7024:   position: absolute;
                   7025:   right: 1em;
1.489     raeburn  7026: }
1.421     albertel 7027: 
1.515     albertel 7028: table.LC_prior_tries {
1.524     albertel 7029:   border: 1px solid #000000;
                   7030:   border-collapse: separate;
                   7031:   border-spacing: 1px;
1.515     albertel 7032: }
1.523     albertel 7033: 
1.515     albertel 7034: table.LC_prior_tries td {
1.524     albertel 7035:   padding: 2px;
1.515     albertel 7036: }
1.523     albertel 7037: 
                   7038: .LC_answer_correct {
1.795     www      7039:   background: lightgreen;
                   7040:   color: darkgreen;
                   7041:   padding: 6px;
1.523     albertel 7042: }
1.795     www      7043: 
1.523     albertel 7044: .LC_answer_charged_try {
1.797     www      7045:   background: #FFAAAA;
1.795     www      7046:   color: darkred;
                   7047:   padding: 6px;
1.523     albertel 7048: }
1.795     www      7049: 
1.779     bisitz   7050: .LC_answer_not_charged_try,
1.523     albertel 7051: .LC_answer_no_grade,
                   7052: .LC_answer_late {
1.795     www      7053:   background: lightyellow;
1.523     albertel 7054:   color: black;
1.795     www      7055:   padding: 6px;
1.523     albertel 7056: }
1.795     www      7057: 
1.523     albertel 7058: .LC_answer_previous {
1.795     www      7059:   background: lightblue;
                   7060:   color: darkblue;
                   7061:   padding: 6px;
1.523     albertel 7062: }
1.795     www      7063: 
1.779     bisitz   7064: .LC_answer_no_message {
1.777     tempelho 7065:   background: #FFFFFF;
                   7066:   color: black;
1.795     www      7067:   padding: 6px;
1.779     bisitz   7068: }
1.795     www      7069: 
1.779     bisitz   7070: .LC_answer_unknown {
                   7071:   background: orange;
                   7072:   color: black;
1.795     www      7073:   padding: 6px;
1.777     tempelho 7074: }
1.795     www      7075: 
1.529     albertel 7076: span.LC_prior_numerical,
                   7077: span.LC_prior_string,
                   7078: span.LC_prior_custom,
                   7079: span.LC_prior_reaction,
                   7080: span.LC_prior_math {
1.925     bisitz   7081:   font-family: $mono;
1.523     albertel 7082:   white-space: pre;
                   7083: }
                   7084: 
1.525     albertel 7085: span.LC_prior_string {
1.925     bisitz   7086:   font-family: $mono;
1.525     albertel 7087:   white-space: pre;
                   7088: }
                   7089: 
1.523     albertel 7090: table.LC_prior_option {
                   7091:   width: 100%;
                   7092:   border-collapse: collapse;
                   7093: }
1.795     www      7094: 
1.911     bisitz   7095: table.LC_prior_rank,
1.795     www      7096: table.LC_prior_match {
1.528     albertel 7097:   border-collapse: collapse;
                   7098: }
1.795     www      7099: 
1.528     albertel 7100: table.LC_prior_option tr td,
                   7101: table.LC_prior_rank tr td,
                   7102: table.LC_prior_match tr td {
1.524     albertel 7103:   border: 1px solid #000000;
1.515     albertel 7104: }
                   7105: 
1.855     bisitz   7106: .LC_nobreak {
1.544     albertel 7107:   white-space: nowrap;
1.519     raeburn  7108: }
                   7109: 
1.576     raeburn  7110: span.LC_cusr_emph {
                   7111:   font-style: italic;
                   7112: }
                   7113: 
1.633     raeburn  7114: span.LC_cusr_subheading {
                   7115:   font-weight: normal;
                   7116:   font-size: 85%;
                   7117: }
                   7118: 
1.861     bisitz   7119: div.LC_docs_entry_move {
1.859     bisitz   7120:   border: 1px solid #BBBBBB;
1.545     albertel 7121:   background: #DDDDDD;
1.861     bisitz   7122:   width: 22px;
1.859     bisitz   7123:   padding: 1px;
                   7124:   margin: 0;
1.545     albertel 7125: }
                   7126: 
1.861     bisitz   7127: table.LC_data_table tr > td.LC_docs_entry_commands,
                   7128: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 7129:   font-size: x-small;
                   7130: }
1.795     www      7131: 
1.861     bisitz   7132: .LC_docs_entry_parameter {
                   7133:   white-space: nowrap;
                   7134: }
                   7135: 
1.544     albertel 7136: .LC_docs_copy {
1.545     albertel 7137:   color: #000099;
1.544     albertel 7138: }
1.795     www      7139: 
1.544     albertel 7140: .LC_docs_cut {
1.545     albertel 7141:   color: #550044;
1.544     albertel 7142: }
1.795     www      7143: 
1.544     albertel 7144: .LC_docs_rename {
1.545     albertel 7145:   color: #009900;
1.544     albertel 7146: }
1.795     www      7147: 
1.544     albertel 7148: .LC_docs_remove {
1.545     albertel 7149:   color: #990000;
                   7150: }
                   7151: 
1.1284    raeburn  7152: .LC_docs_alias {
                   7153:   color: #440055;  
                   7154: }
                   7155: 
1.1286    raeburn  7156: .LC_domprefs_email,
1.1284    raeburn  7157: .LC_docs_alias_name,
1.547     albertel 7158: .LC_docs_reinit_warn,
                   7159: .LC_docs_ext_edit {
                   7160:   font-size: x-small;
                   7161: }
                   7162: 
1.545     albertel 7163: table.LC_docs_adddocs td,
                   7164: table.LC_docs_adddocs th {
                   7165:   border: 1px solid #BBBBBB;
                   7166:   padding: 4px;
                   7167:   background: #DDDDDD;
1.543     albertel 7168: }
                   7169: 
1.584     albertel 7170: table.LC_sty_begin {
                   7171:   background: #BBFFBB;
                   7172: }
1.795     www      7173: 
1.584     albertel 7174: table.LC_sty_end {
                   7175:   background: #FFBBBB;
                   7176: }
                   7177: 
1.589     raeburn  7178: table.LC_double_column {
1.803     bisitz   7179:   border-width: 0;
1.589     raeburn  7180:   border-collapse: collapse;
                   7181:   width: 100%;
                   7182:   padding: 2px;
                   7183: }
                   7184: 
                   7185: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  7186:   top: 2px;
1.589     raeburn  7187:   left: 2px;
                   7188:   width: 47%;
                   7189:   vertical-align: top;
                   7190: }
                   7191: 
                   7192: table.LC_double_column tr td.LC_right_col {
                   7193:   top: 2px;
1.779     bisitz   7194:   right: 2px;
1.589     raeburn  7195:   width: 47%;
                   7196:   vertical-align: top;
                   7197: }
                   7198: 
1.591     raeburn  7199: div.LC_left_float {
                   7200:   float: left;
                   7201:   padding-right: 5%;
1.597     albertel 7202:   padding-bottom: 4px;
1.591     raeburn  7203: }
                   7204: 
                   7205: div.LC_clear_float_header {
1.597     albertel 7206:   padding-bottom: 2px;
1.591     raeburn  7207: }
                   7208: 
                   7209: div.LC_clear_float_footer {
1.597     albertel 7210:   padding-top: 10px;
1.591     raeburn  7211:   clear: both;
                   7212: }
                   7213: 
1.597     albertel 7214: div.LC_grade_show_user {
1.941     bisitz   7215: /*  border-left: 5px solid $sidebg; */
                   7216:   border-top: 5px solid #000000;
                   7217:   margin: 50px 0 0 0;
1.936     bisitz   7218:   padding: 15px 0 5px 10px;
1.597     albertel 7219: }
1.795     www      7220: 
1.936     bisitz   7221: div.LC_grade_show_user_odd_row {
1.941     bisitz   7222: /*  border-left: 5px solid #000000; */
                   7223: }
                   7224: 
                   7225: div.LC_grade_show_user div.LC_Box {
                   7226:   margin-right: 50px;
1.597     albertel 7227: }
                   7228: 
                   7229: div.LC_grade_submissions,
                   7230: div.LC_grade_message_center,
1.936     bisitz   7231: div.LC_grade_info_links {
1.597     albertel 7232:   margin: 5px;
                   7233:   width: 99%;
                   7234:   background: #FFFFFF;
                   7235: }
1.795     www      7236: 
1.597     albertel 7237: div.LC_grade_submissions_header,
1.936     bisitz   7238: div.LC_grade_message_center_header {
1.705     tempelho 7239:   font-weight: bold;
                   7240:   font-size: large;
1.597     albertel 7241: }
1.795     www      7242: 
1.597     albertel 7243: div.LC_grade_submissions_body,
1.936     bisitz   7244: div.LC_grade_message_center_body {
1.597     albertel 7245:   border: 1px solid black;
                   7246:   width: 99%;
                   7247:   background: #FFFFFF;
                   7248: }
1.795     www      7249: 
1.613     albertel 7250: table.LC_scantron_action {
                   7251:   width: 100%;
                   7252: }
1.795     www      7253: 
1.613     albertel 7254: table.LC_scantron_action tr th {
1.698     harmsja  7255:   font-weight:bold;
                   7256:   font-style:normal;
1.613     albertel 7257: }
1.795     www      7258: 
1.779     bisitz   7259: .LC_edit_problem_header,
1.614     albertel 7260: div.LC_edit_problem_footer {
1.705     tempelho 7261:   font-weight: normal;
                   7262:   font-size:  medium;
1.602     albertel 7263:   margin: 2px;
1.1060    bisitz   7264:   background-color: $sidebg;
1.600     albertel 7265: }
1.795     www      7266: 
1.600     albertel 7267: div.LC_edit_problem_header,
1.602     albertel 7268: div.LC_edit_problem_header div,
1.614     albertel 7269: div.LC_edit_problem_footer,
                   7270: div.LC_edit_problem_footer div,
1.602     albertel 7271: div.LC_edit_problem_editxml_header,
                   7272: div.LC_edit_problem_editxml_header div {
1.1205    golterma 7273:   z-index: 100;
1.600     albertel 7274: }
1.795     www      7275: 
1.600     albertel 7276: div.LC_edit_problem_header_title {
1.705     tempelho 7277:   font-weight: bold;
                   7278:   font-size: larger;
1.602     albertel 7279:   background: $tabbg;
                   7280:   padding: 3px;
1.1060    bisitz   7281:   margin: 0 0 5px 0;
1.602     albertel 7282: }
1.795     www      7283: 
1.602     albertel 7284: table.LC_edit_problem_header_title {
                   7285:   width: 100%;
1.600     albertel 7286:   background: $tabbg;
1.602     albertel 7287: }
                   7288: 
1.1205    golterma 7289: div.LC_edit_actionbar {
                   7290:     background-color: $sidebg;
1.1218    droeschl 7291:     margin: 0;
                   7292:     padding: 0;
                   7293:     line-height: 200%;
1.602     albertel 7294: }
1.795     www      7295: 
1.1218    droeschl 7296: div.LC_edit_actionbar div{
                   7297:     padding: 0;
                   7298:     margin: 0;
                   7299:     display: inline-block;
1.600     albertel 7300: }
1.795     www      7301: 
1.1124    bisitz   7302: .LC_edit_opt {
                   7303:   padding-left: 1em;
                   7304:   white-space: nowrap;
                   7305: }
                   7306: 
1.1152    golterma 7307: .LC_edit_problem_latexhelper{
                   7308:     text-align: right;
                   7309: }
                   7310: 
                   7311: #LC_edit_problem_colorful div{
                   7312:     margin-left: 40px;
                   7313: }
                   7314: 
1.1205    golterma 7315: #LC_edit_problem_codemirror div{
                   7316:     margin-left: 0px;
                   7317: }
                   7318: 
1.911     bisitz   7319: img.stift {
1.803     bisitz   7320:   border-width: 0;
                   7321:   vertical-align: middle;
1.677     riegler  7322: }
1.680     riegler  7323: 
1.923     bisitz   7324: table td.LC_mainmenu_col_fieldset {
1.680     riegler  7325:   vertical-align: top;
1.777     tempelho 7326: }
1.795     www      7327: 
1.716     raeburn  7328: div.LC_createcourse {
1.911     bisitz   7329:   margin: 10px 10px 10px 10px;
1.716     raeburn  7330: }
                   7331: 
1.917     raeburn  7332: .LC_dccid {
1.1130    raeburn  7333:   float: right;
1.917     raeburn  7334:   margin: 0.2em 0 0 0;
                   7335:   padding: 0;
                   7336:   font-size: 90%;
                   7337:   display:none;
                   7338: }
                   7339: 
1.897     wenzelju 7340: ol.LC_primary_menu a:hover,
1.721     harmsja  7341: ol#LC_MenuBreadcrumbs a:hover,
                   7342: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 7343: ul#LC_secondary_menu a:hover,
1.721     harmsja  7344: .LC_FormSectionClearButton input:hover
1.795     www      7345: ul.LC_TabContent   li:hover a {
1.952     onken    7346:   color:$button_hover;
1.911     bisitz   7347:   text-decoration:none;
1.693     droeschl 7348: }
                   7349: 
1.779     bisitz   7350: h1 {
1.911     bisitz   7351:   padding: 0;
                   7352:   line-height:130%;
1.693     droeschl 7353: }
1.698     harmsja  7354: 
1.911     bisitz   7355: h2,
                   7356: h3,
                   7357: h4,
                   7358: h5,
                   7359: h6 {
                   7360:   margin: 5px 0 5px 0;
                   7361:   padding: 0;
                   7362:   line-height:130%;
1.693     droeschl 7363: }
1.795     www      7364: 
                   7365: .LC_hcell {
1.911     bisitz   7366:   padding:3px 15px 3px 15px;
                   7367:   margin: 0;
                   7368:   background-color:$tabbg;
                   7369:   color:$fontmenu;
                   7370:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 7371: }
1.795     www      7372: 
1.840     bisitz   7373: .LC_Box > .LC_hcell {
1.911     bisitz   7374:   margin: 0 -10px 10px -10px;
1.835     bisitz   7375: }
                   7376: 
1.721     harmsja  7377: .LC_noBorder {
1.911     bisitz   7378:   border: 0;
1.698     harmsja  7379: }
1.693     droeschl 7380: 
1.721     harmsja  7381: .LC_FormSectionClearButton input {
1.911     bisitz   7382:   background-color:transparent;
                   7383:   border: none;
                   7384:   cursor:pointer;
                   7385:   text-decoration:underline;
1.693     droeschl 7386: }
1.763     bisitz   7387: 
                   7388: .LC_help_open_topic {
1.911     bisitz   7389:   color: #FFFFFF;
                   7390:   background-color: #EEEEFF;
                   7391:   margin: 1px;
                   7392:   padding: 4px;
                   7393:   border: 1px solid #000033;
                   7394:   white-space: nowrap;
                   7395:   /* vertical-align: middle; */
1.759     neumanie 7396: }
1.693     droeschl 7397: 
1.911     bisitz   7398: dl,
                   7399: ul,
                   7400: div,
                   7401: fieldset {
                   7402:   margin: 10px 10px 10px 0;
                   7403:   /* overflow: hidden; */
1.693     droeschl 7404: }
1.795     www      7405: 
1.1211    raeburn  7406: article.geogebraweb div {
                   7407:     margin: 0;
                   7408: }
                   7409: 
1.838     bisitz   7410: fieldset > legend {
1.911     bisitz   7411:   font-weight: bold;
                   7412:   padding: 0 5px 0 5px;
1.838     bisitz   7413: }
                   7414: 
1.813     bisitz   7415: #LC_nav_bar {
1.911     bisitz   7416:   float: left;
1.995     raeburn  7417:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   7418:   margin: 0 0 2px 0;
1.807     droeschl 7419: }
                   7420: 
1.916     droeschl 7421: #LC_realm {
                   7422:   margin: 0.2em 0 0 0;
                   7423:   padding: 0;
                   7424:   font-weight: bold;
                   7425:   text-align: center;
1.995     raeburn  7426:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 7427: }
                   7428: 
1.911     bisitz   7429: #LC_nav_bar em {
                   7430:   font-weight: bold;
                   7431:   font-style: normal;
1.807     droeschl 7432: }
                   7433: 
1.897     wenzelju 7434: ol.LC_primary_menu {
1.934     droeschl 7435:   margin: 0;
1.1076    raeburn  7436:   padding: 0;
1.807     droeschl 7437: }
                   7438: 
1.852     droeschl 7439: ol#LC_PathBreadcrumbs {
1.911     bisitz   7440:   margin: 0;
1.693     droeschl 7441: }
                   7442: 
1.897     wenzelju 7443: ol.LC_primary_menu li {
1.1076    raeburn  7444:   color: RGB(80, 80, 80);
                   7445:   vertical-align: middle;
                   7446:   text-align: left;
                   7447:   list-style: none;
1.1205    golterma 7448:   position: relative;
1.1076    raeburn  7449:   float: left;
1.1205    golterma 7450:   z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
                   7451:   line-height: 1.5em;
1.1076    raeburn  7452: }
                   7453: 
1.1205    golterma 7454: ol.LC_primary_menu li a,
                   7455: ol.LC_primary_menu li p {
1.1076    raeburn  7456:   display: block;
                   7457:   margin: 0;
                   7458:   padding: 0 5px 0 10px;
                   7459:   text-decoration: none;
                   7460: }
                   7461: 
1.1205    golterma 7462: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
                   7463:   display: inline-block;
                   7464:   width: 95%;
                   7465:   text-align: left;
                   7466: }
                   7467: 
                   7468: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
                   7469:   display: inline-block;	
                   7470:   width: 5%;
                   7471:   float: right;
                   7472:   text-align: right;
                   7473:   font-size: 70%;
                   7474: }
                   7475: 
                   7476: ol.LC_primary_menu ul {
1.1076    raeburn  7477:   display: none;
1.1205    golterma 7478:   width: 15em;
1.1076    raeburn  7479:   background-color: $data_table_light;
1.1205    golterma 7480:   position: absolute;
                   7481:   top: 100%;
1.1076    raeburn  7482: }
                   7483: 
1.1205    golterma 7484: ol.LC_primary_menu ul ul {
                   7485:   left: 100%;
                   7486:   top: 0;
                   7487: }
                   7488: 
                   7489: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076    raeburn  7490:   display: block;
                   7491:   position: absolute;
                   7492:   margin: 0;
                   7493:   padding: 0;
1.1078    raeburn  7494:   z-index: 2;
1.1076    raeburn  7495: }
                   7496: 
                   7497: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205    golterma 7498: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076    raeburn  7499:   font-size: 90%;
1.911     bisitz   7500:   vertical-align: top;
1.1076    raeburn  7501:   float: none;
1.1079    raeburn  7502:   border-left: 1px solid black;
                   7503:   border-right: 1px solid black;
1.1205    golterma 7504: /* A dark bottom border to visualize different menu options; 
                   7505: overwritten in the create_submenu routine for the last border-bottom of the menu */
                   7506:   border-bottom: 1px solid $data_table_dark; 
1.1076    raeburn  7507: }
                   7508: 
1.1205    golterma 7509: ol.LC_primary_menu li li p:hover {
                   7510:   color:$button_hover;
                   7511:   text-decoration:none;
                   7512:   background-color:$data_table_dark;
1.1076    raeburn  7513: }
                   7514: 
                   7515: ol.LC_primary_menu li li a:hover {
                   7516:    color:$button_hover;
                   7517:    background-color:$data_table_dark;
1.693     droeschl 7518: }
                   7519: 
1.1205    golterma 7520: /* Font-size equal to the size of the predecessors*/
                   7521: ol.LC_primary_menu li:hover li li {
                   7522:   font-size: 100%;
                   7523: }
                   7524: 
1.897     wenzelju 7525: ol.LC_primary_menu li img {
1.911     bisitz   7526:   vertical-align: bottom;
1.934     droeschl 7527:   height: 1.1em;
1.1077    raeburn  7528:   margin: 0.2em 0 0 0;
1.693     droeschl 7529: }
                   7530: 
1.897     wenzelju 7531: ol.LC_primary_menu a {
1.911     bisitz   7532:   color: RGB(80, 80, 80);
                   7533:   text-decoration: none;
1.693     droeschl 7534: }
1.795     www      7535: 
1.949     droeschl 7536: ol.LC_primary_menu a.LC_new_message {
                   7537:   font-weight:bold;
                   7538:   color: darkred;
                   7539: }
                   7540: 
1.975     raeburn  7541: ol.LC_docs_parameters {
                   7542:   margin-left: 0;
                   7543:   padding: 0;
                   7544:   list-style: none;
                   7545: }
                   7546: 
                   7547: ol.LC_docs_parameters li {
                   7548:   margin: 0;
                   7549:   padding-right: 20px;
                   7550:   display: inline;
                   7551: }
                   7552: 
1.976     raeburn  7553: ol.LC_docs_parameters li:before {
                   7554:   content: "\\002022 \\0020";
                   7555: }
                   7556: 
                   7557: li.LC_docs_parameters_title {
                   7558:   font-weight: bold;
                   7559: }
                   7560: 
                   7561: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   7562:   content: "";
                   7563: }
                   7564: 
1.897     wenzelju 7565: ul#LC_secondary_menu {
1.1107    raeburn  7566:   clear: right;
1.911     bisitz   7567:   color: $fontmenu;
                   7568:   background: $tabbg;
                   7569:   list-style: none;
                   7570:   padding: 0;
                   7571:   margin: 0;
                   7572:   width: 100%;
1.995     raeburn  7573:   text-align: left;
1.1107    raeburn  7574:   float: left;
1.808     droeschl 7575: }
                   7576: 
1.897     wenzelju 7577: ul#LC_secondary_menu li {
1.911     bisitz   7578:   font-weight: bold;
                   7579:   line-height: 1.8em;
1.1107    raeburn  7580:   border-right: 1px solid black;
                   7581:   float: left;
                   7582: }
                   7583: 
                   7584: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   7585:   background-color: $data_table_light;
                   7586: }
                   7587: 
                   7588: ul#LC_secondary_menu li a {
1.911     bisitz   7589:   padding: 0 0.8em;
1.1107    raeburn  7590: }
                   7591: 
                   7592: ul#LC_secondary_menu li ul {
                   7593:   display: none;
                   7594: }
                   7595: 
                   7596: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   7597:   display: block;
                   7598:   position: absolute;
                   7599:   margin: 0;
                   7600:   padding: 0;
                   7601:   list-style:none;
                   7602:   float: none;
                   7603:   background-color: $data_table_light;
                   7604:   z-index: 2;
                   7605:   margin-left: -1px;
                   7606: }
                   7607: 
                   7608: ul#LC_secondary_menu li ul li {
                   7609:   font-size: 90%;
                   7610:   vertical-align: top;
                   7611:   border-left: 1px solid black;
1.911     bisitz   7612:   border-right: 1px solid black;
1.1119    raeburn  7613:   background-color: $data_table_light;
1.1107    raeburn  7614:   list-style:none;
                   7615:   float: none;
                   7616: }
                   7617: 
                   7618: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   7619:   background-color: $data_table_dark;
1.807     droeschl 7620: }
                   7621: 
1.847     tempelho 7622: ul.LC_TabContent {
1.911     bisitz   7623:   display:block;
                   7624:   background: $sidebg;
                   7625:   border-bottom: solid 1px $lg_border_color;
                   7626:   list-style:none;
1.1020    raeburn  7627:   margin: -1px -10px 0 -10px;
1.911     bisitz   7628:   padding: 0;
1.693     droeschl 7629: }
                   7630: 
1.795     www      7631: ul.LC_TabContent li,
                   7632: ul.LC_TabContentBigger li {
1.911     bisitz   7633:   float:left;
1.741     harmsja  7634: }
1.795     www      7635: 
1.897     wenzelju 7636: ul#LC_secondary_menu li a {
1.911     bisitz   7637:   color: $fontmenu;
                   7638:   text-decoration: none;
1.693     droeschl 7639: }
1.795     www      7640: 
1.721     harmsja  7641: ul.LC_TabContent {
1.952     onken    7642:   min-height:20px;
1.721     harmsja  7643: }
1.795     www      7644: 
                   7645: ul.LC_TabContent li {
1.911     bisitz   7646:   vertical-align:middle;
1.959     onken    7647:   padding: 0 16px 0 10px;
1.911     bisitz   7648:   background-color:$tabbg;
                   7649:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  7650:   border-left: solid 1px $font;
1.721     harmsja  7651: }
1.795     www      7652: 
1.847     tempelho 7653: ul.LC_TabContent .right {
1.911     bisitz   7654:   float:right;
1.847     tempelho 7655: }
                   7656: 
1.911     bisitz   7657: ul.LC_TabContent li a,
                   7658: ul.LC_TabContent li {
                   7659:   color:rgb(47,47,47);
                   7660:   text-decoration:none;
                   7661:   font-size:95%;
                   7662:   font-weight:bold;
1.952     onken    7663:   min-height:20px;
                   7664: }
                   7665: 
1.959     onken    7666: ul.LC_TabContent li a:hover,
                   7667: ul.LC_TabContent li a:focus {
1.952     onken    7668:   color: $button_hover;
1.959     onken    7669:   background:none;
                   7670:   outline:none;
1.952     onken    7671: }
                   7672: 
                   7673: ul.LC_TabContent li:hover {
                   7674:   color: $button_hover;
                   7675:   cursor:pointer;
1.721     harmsja  7676: }
1.795     www      7677: 
1.911     bisitz   7678: ul.LC_TabContent li.active {
1.952     onken    7679:   color: $font;
1.911     bisitz   7680:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    7681:   border-bottom:solid 1px #FFFFFF;
                   7682:   cursor: default;
1.744     ehlerst  7683: }
1.795     www      7684: 
1.959     onken    7685: ul.LC_TabContent li.active a {
                   7686:   color:$font;
                   7687:   background:#FFFFFF;
                   7688:   outline: none;
                   7689: }
1.1047    raeburn  7690: 
                   7691: ul.LC_TabContent li.goback {
                   7692:   float: left;
                   7693:   border-left: none;
                   7694: }
                   7695: 
1.870     tempelho 7696: #maincoursedoc {
1.911     bisitz   7697:   clear:both;
1.870     tempelho 7698: }
                   7699: 
                   7700: ul.LC_TabContentBigger {
1.911     bisitz   7701:   display:block;
                   7702:   list-style:none;
                   7703:   padding: 0;
1.870     tempelho 7704: }
                   7705: 
1.795     www      7706: ul.LC_TabContentBigger li {
1.911     bisitz   7707:   vertical-align:bottom;
                   7708:   height: 30px;
                   7709:   font-size:110%;
                   7710:   font-weight:bold;
                   7711:   color: #737373;
1.841     tempelho 7712: }
                   7713: 
1.957     onken    7714: ul.LC_TabContentBigger li.active {
                   7715:   position: relative;
                   7716:   top: 1px;
                   7717: }
                   7718: 
1.870     tempelho 7719: ul.LC_TabContentBigger li a {
1.911     bisitz   7720:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   7721:   height: 30px;
                   7722:   line-height: 30px;
                   7723:   text-align: center;
                   7724:   display: block;
                   7725:   text-decoration: none;
1.958     onken    7726:   outline: none;  
1.741     harmsja  7727: }
1.795     www      7728: 
1.870     tempelho 7729: ul.LC_TabContentBigger li.active a {
1.911     bisitz   7730:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   7731:   color:$font;
1.744     ehlerst  7732: }
1.795     www      7733: 
1.870     tempelho 7734: ul.LC_TabContentBigger li b {
1.911     bisitz   7735:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   7736:   display: block;
                   7737:   float: left;
                   7738:   padding: 0 30px;
1.957     onken    7739:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 7740: }
                   7741: 
1.956     onken    7742: ul.LC_TabContentBigger li:hover b {
                   7743:   color:$button_hover;
                   7744: }
                   7745: 
1.870     tempelho 7746: ul.LC_TabContentBigger li.active b {
1.911     bisitz   7747:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   7748:   color:$font;
1.957     onken    7749:   border: 0;
1.741     harmsja  7750: }
1.693     droeschl 7751: 
1.870     tempelho 7752: 
1.862     bisitz   7753: ul.LC_CourseBreadcrumbs {
                   7754:   background: $sidebg;
1.1020    raeburn  7755:   height: 2em;
1.862     bisitz   7756:   padding-left: 10px;
1.1020    raeburn  7757:   margin: 0;
1.862     bisitz   7758:   list-style-position: inside;
                   7759: }
                   7760: 
1.911     bisitz   7761: ol#LC_MenuBreadcrumbs,
1.862     bisitz   7762: ol#LC_PathBreadcrumbs {
1.911     bisitz   7763:   padding-left: 10px;
                   7764:   margin: 0;
1.933     droeschl 7765:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 7766: }
                   7767: 
1.911     bisitz   7768: ol#LC_MenuBreadcrumbs li,
                   7769: ol#LC_PathBreadcrumbs li,
1.862     bisitz   7770: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   7771:   display: inline;
1.933     droeschl 7772:   white-space: normal;  
1.693     droeschl 7773: }
                   7774: 
1.823     bisitz   7775: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   7776: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   7777:   text-decoration: none;
                   7778:   font-size:90%;
1.693     droeschl 7779: }
1.795     www      7780: 
1.969     droeschl 7781: ol#LC_MenuBreadcrumbs h1 {
                   7782:   display: inline;
                   7783:   font-size: 90%;
                   7784:   line-height: 2.5em;
                   7785:   margin: 0;
                   7786:   padding: 0;
                   7787: }
                   7788: 
1.795     www      7789: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   7790:   text-decoration:none;
                   7791:   font-size:100%;
                   7792:   font-weight:bold;
1.693     droeschl 7793: }
1.795     www      7794: 
1.840     bisitz   7795: .LC_Box {
1.911     bisitz   7796:   border: solid 1px $lg_border_color;
                   7797:   padding: 0 10px 10px 10px;
1.746     neumanie 7798: }
1.795     www      7799: 
1.1020    raeburn  7800: .LC_DocsBox {
                   7801:   border: solid 1px $lg_border_color;
                   7802:   padding: 0 0 10px 10px;
                   7803: }
                   7804: 
1.795     www      7805: .LC_AboutMe_Image {
1.911     bisitz   7806:   float:left;
                   7807:   margin-right:10px;
1.747     neumanie 7808: }
1.795     www      7809: 
                   7810: .LC_Clear_AboutMe_Image {
1.911     bisitz   7811:   clear:left;
1.747     neumanie 7812: }
1.795     www      7813: 
1.721     harmsja  7814: dl.LC_ListStyleClean dt {
1.911     bisitz   7815:   padding-right: 5px;
                   7816:   display: table-header-group;
1.693     droeschl 7817: }
                   7818: 
1.721     harmsja  7819: dl.LC_ListStyleClean dd {
1.911     bisitz   7820:   display: table-row;
1.693     droeschl 7821: }
                   7822: 
1.721     harmsja  7823: .LC_ListStyleClean,
                   7824: .LC_ListStyleSimple,
                   7825: .LC_ListStyleNormal,
1.795     www      7826: .LC_ListStyleSpecial {
1.911     bisitz   7827:   /* display:block; */
                   7828:   list-style-position: inside;
                   7829:   list-style-type: none;
                   7830:   overflow: hidden;
                   7831:   padding: 0;
1.693     droeschl 7832: }
                   7833: 
1.721     harmsja  7834: .LC_ListStyleSimple li,
                   7835: .LC_ListStyleSimple dd,
                   7836: .LC_ListStyleNormal li,
                   7837: .LC_ListStyleNormal dd,
                   7838: .LC_ListStyleSpecial li,
1.795     www      7839: .LC_ListStyleSpecial dd {
1.911     bisitz   7840:   margin: 0;
                   7841:   padding: 5px 5px 5px 10px;
                   7842:   clear: both;
1.693     droeschl 7843: }
                   7844: 
1.721     harmsja  7845: .LC_ListStyleClean li,
                   7846: .LC_ListStyleClean dd {
1.911     bisitz   7847:   padding-top: 0;
                   7848:   padding-bottom: 0;
1.693     droeschl 7849: }
                   7850: 
1.721     harmsja  7851: .LC_ListStyleSimple dd,
1.795     www      7852: .LC_ListStyleSimple li {
1.911     bisitz   7853:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 7854: }
                   7855: 
1.721     harmsja  7856: .LC_ListStyleSpecial li,
                   7857: .LC_ListStyleSpecial dd {
1.911     bisitz   7858:   list-style-type: none;
                   7859:   background-color: RGB(220, 220, 220);
                   7860:   margin-bottom: 4px;
1.693     droeschl 7861: }
                   7862: 
1.721     harmsja  7863: table.LC_SimpleTable {
1.911     bisitz   7864:   margin:5px;
                   7865:   border:solid 1px $lg_border_color;
1.795     www      7866: }
1.693     droeschl 7867: 
1.721     harmsja  7868: table.LC_SimpleTable tr {
1.911     bisitz   7869:   padding: 0;
                   7870:   border:solid 1px $lg_border_color;
1.693     droeschl 7871: }
1.795     www      7872: 
                   7873: table.LC_SimpleTable thead {
1.911     bisitz   7874:   background:rgb(220,220,220);
1.693     droeschl 7875: }
                   7876: 
1.721     harmsja  7877: div.LC_columnSection {
1.911     bisitz   7878:   display: block;
                   7879:   clear: both;
                   7880:   overflow: hidden;
                   7881:   margin: 0;
1.693     droeschl 7882: }
                   7883: 
1.721     harmsja  7884: div.LC_columnSection>* {
1.911     bisitz   7885:   float: left;
                   7886:   margin: 10px 20px 10px 0;
                   7887:   overflow:hidden;
1.693     droeschl 7888: }
1.721     harmsja  7889: 
1.795     www      7890: table em {
1.911     bisitz   7891:   font-weight: bold;
                   7892:   font-style: normal;
1.748     schulted 7893: }
1.795     www      7894: 
1.779     bisitz   7895: table.LC_tableBrowseRes,
1.795     www      7896: table.LC_tableOfContent {
1.911     bisitz   7897:   border:none;
                   7898:   border-spacing: 1px;
                   7899:   padding: 3px;
                   7900:   background-color: #FFFFFF;
                   7901:   font-size: 90%;
1.753     droeschl 7902: }
1.789     droeschl 7903: 
1.911     bisitz   7904: table.LC_tableOfContent {
                   7905:   border-collapse: collapse;
1.789     droeschl 7906: }
                   7907: 
1.771     droeschl 7908: table.LC_tableBrowseRes a,
1.768     schulted 7909: table.LC_tableOfContent a {
1.911     bisitz   7910:   background-color: transparent;
                   7911:   text-decoration: none;
1.753     droeschl 7912: }
                   7913: 
1.795     www      7914: table.LC_tableOfContent img {
1.911     bisitz   7915:   border: none;
                   7916:   height: 1.3em;
                   7917:   vertical-align: text-bottom;
                   7918:   margin-right: 0.3em;
1.753     droeschl 7919: }
1.757     schulted 7920: 
1.795     www      7921: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7922:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7923: }
                   7924: 
1.795     www      7925: a#LC_content_toolbar_everything {
1.911     bisitz   7926:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7927: }
                   7928: 
1.795     www      7929: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7930:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7931: }
                   7932: 
1.795     www      7933: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7934:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7935: }
                   7936: 
1.795     www      7937: a#LC_content_toolbar_changefolder {
1.911     bisitz   7938:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7939: }
                   7940: 
1.795     www      7941: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7942:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7943: }
                   7944: 
1.1043    raeburn  7945: a#LC_content_toolbar_edittoplevel {
                   7946:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7947: }
                   7948: 
1.795     www      7949: ul#LC_toolbar li a:hover {
1.911     bisitz   7950:   background-position: bottom center;
1.757     schulted 7951: }
                   7952: 
1.795     www      7953: ul#LC_toolbar {
1.911     bisitz   7954:   padding: 0;
                   7955:   margin: 2px;
                   7956:   list-style:none;
                   7957:   position:relative;
                   7958:   background-color:white;
1.1082    raeburn  7959:   overflow: auto;
1.757     schulted 7960: }
                   7961: 
1.795     www      7962: ul#LC_toolbar li {
1.911     bisitz   7963:   border:1px solid white;
                   7964:   padding: 0;
                   7965:   margin: 0;
                   7966:   float: left;
                   7967:   display:inline;
                   7968:   vertical-align:middle;
1.1082    raeburn  7969:   white-space: nowrap;
1.911     bisitz   7970: }
1.757     schulted 7971: 
1.783     amueller 7972: 
1.795     www      7973: a.LC_toolbarItem {
1.911     bisitz   7974:   display:block;
                   7975:   padding: 0;
                   7976:   margin: 0;
                   7977:   height: 32px;
                   7978:   width: 32px;
                   7979:   color:white;
                   7980:   border: none;
                   7981:   background-repeat:no-repeat;
                   7982:   background-color:transparent;
1.757     schulted 7983: }
                   7984: 
1.915     droeschl 7985: ul.LC_funclist {
                   7986:     margin: 0;
                   7987:     padding: 0.5em 1em 0.5em 0;
                   7988: }
                   7989: 
1.933     droeschl 7990: ul.LC_funclist > li:first-child {
                   7991:     font-weight:bold; 
                   7992:     margin-left:0.8em;
                   7993: }
                   7994: 
1.915     droeschl 7995: ul.LC_funclist + ul.LC_funclist {
                   7996:     /* 
                   7997:        left border as a seperator if we have more than
                   7998:        one list 
                   7999:     */
                   8000:     border-left: 1px solid $sidebg;
                   8001:     /* 
                   8002:        this hides the left border behind the border of the 
                   8003:        outer box if element is wrapped to the next 'line' 
                   8004:     */
                   8005:     margin-left: -1px;
                   8006: }
                   8007: 
1.843     bisitz   8008: ul.LC_funclist li {
1.915     droeschl 8009:   display: inline;
1.782     bisitz   8010:   white-space: nowrap;
1.915     droeschl 8011:   margin: 0 0 0 25px;
                   8012:   line-height: 150%;
1.782     bisitz   8013: }
                   8014: 
1.974     wenzelju 8015: .LC_hidden {
                   8016:   display: none;
                   8017: }
                   8018: 
1.1030    www      8019: .LCmodal-overlay {
                   8020: 		position:fixed;
                   8021: 		top:0;
                   8022: 		right:0;
                   8023: 		bottom:0;
                   8024: 		left:0;
                   8025: 		height:100%;
                   8026: 		width:100%;
                   8027: 		margin:0;
                   8028: 		padding:0;
                   8029: 		background:#999;
                   8030: 		opacity:.75;
                   8031: 		filter: alpha(opacity=75);
                   8032: 		-moz-opacity: 0.75;
                   8033: 		z-index:101;
                   8034: }
                   8035: 
                   8036: * html .LCmodal-overlay {   
                   8037: 		position: absolute;
                   8038: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   8039: }
                   8040: 
                   8041: .LCmodal-window {
                   8042: 		position:fixed;
                   8043: 		top:50%;
                   8044: 		left:50%;
                   8045: 		margin:0;
                   8046: 		padding:0;
                   8047: 		z-index:102;
                   8048: 	}
                   8049: 
                   8050: * html .LCmodal-window {
                   8051: 		position:absolute;
                   8052: }
                   8053: 
                   8054: .LCclose-window {
                   8055: 		position:absolute;
                   8056: 		width:32px;
                   8057: 		height:32px;
                   8058: 		right:8px;
                   8059: 		top:8px;
                   8060: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   8061: 		text-indent:-99999px;
                   8062: 		overflow:hidden;
                   8063: 		cursor:pointer;
                   8064: }
                   8065: 
1.1100    raeburn  8066: /*
1.1231    damieng  8067:   styles used for response display
                   8068: */
                   8069: div.LC_radiofoil, div.LC_rankfoil {
                   8070:   margin: .5em 0em .5em 0em;
                   8071: }
                   8072: table.LC_itemgroup {
                   8073:   margin-top: 1em;
                   8074: }
                   8075: 
                   8076: /*
1.1100    raeburn  8077:   styles used by TTH when "Default set of options to pass to tth/m
                   8078:   when converting TeX" in course settings has been set
                   8079: 
                   8080:   option passed: -t
                   8081: 
                   8082: */
                   8083: 
                   8084: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   8085: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   8086: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   8087: td div.norm {line-height:normal;}
                   8088: 
                   8089: /*
                   8090:   option passed -y3
                   8091: */
                   8092: 
                   8093: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   8094: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   8095: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   8096: 
1.1230    damieng  8097: /*
                   8098:   sections with roles, for content only
                   8099: */
                   8100: section[class^="role-"] {
                   8101:   padding-left: 10px;
                   8102:   padding-right: 5px;
                   8103:   margin-top: 8px;
                   8104:   margin-bottom: 8px;
                   8105:   border: 1px solid #2A4;
                   8106:   border-radius: 5px;
                   8107:   box-shadow: 0px 1px 1px #BBB;
                   8108: }
                   8109: section[class^="role-"]>h1 {
                   8110:   position: relative;
                   8111:   margin: 0px;
                   8112:   padding-top: 10px;
                   8113:   padding-left: 40px;
                   8114: }
                   8115: section[class^="role-"]>h1:before {
                   8116:   position: absolute;
                   8117:   left: -5px;
                   8118:   top: 5px;
                   8119: }
                   8120: section.role-activity>h1:before {
                   8121:   content:url('/adm/daxe/images/section_icons/activity.png');
                   8122: }
                   8123: section.role-advice>h1:before {
                   8124:   content:url('/adm/daxe/images/section_icons/advice.png');
                   8125: }
                   8126: section.role-bibliography>h1:before {
                   8127:   content:url('/adm/daxe/images/section_icons/bibliography.png');
                   8128: }
                   8129: section.role-citation>h1:before {
                   8130:   content:url('/adm/daxe/images/section_icons/citation.png');
                   8131: }
                   8132: section.role-conclusion>h1:before {
                   8133:   content:url('/adm/daxe/images/section_icons/conclusion.png');
                   8134: }
                   8135: section.role-definition>h1:before {
                   8136:   content:url('/adm/daxe/images/section_icons/definition.png');
                   8137: }
                   8138: section.role-demonstration>h1:before {
                   8139:   content:url('/adm/daxe/images/section_icons/demonstration.png');
                   8140: }
                   8141: section.role-example>h1:before {
                   8142:   content:url('/adm/daxe/images/section_icons/example.png');
                   8143: }
                   8144: section.role-explanation>h1:before {
                   8145:   content:url('/adm/daxe/images/section_icons/explanation.png');
                   8146: }
                   8147: section.role-introduction>h1:before {
                   8148:   content:url('/adm/daxe/images/section_icons/introduction.png');
                   8149: }
                   8150: section.role-method>h1:before {
                   8151:   content:url('/adm/daxe/images/section_icons/method.png');
                   8152: }
                   8153: section.role-more_information>h1:before {
                   8154:   content:url('/adm/daxe/images/section_icons/more_information.png');
                   8155: }
                   8156: section.role-objectives>h1:before {
                   8157:   content:url('/adm/daxe/images/section_icons/objectives.png');
                   8158: }
                   8159: section.role-prerequisites>h1:before {
                   8160:   content:url('/adm/daxe/images/section_icons/prerequisites.png');
                   8161: }
                   8162: section.role-remark>h1:before {
                   8163:   content:url('/adm/daxe/images/section_icons/remark.png');
                   8164: }
                   8165: section.role-reminder>h1:before {
                   8166:   content:url('/adm/daxe/images/section_icons/reminder.png');
                   8167: }
                   8168: section.role-summary>h1:before {
                   8169:   content:url('/adm/daxe/images/section_icons/summary.png');
                   8170: }
                   8171: section.role-syntax>h1:before {
                   8172:   content:url('/adm/daxe/images/section_icons/syntax.png');
                   8173: }
                   8174: section.role-warning>h1:before {
                   8175:   content:url('/adm/daxe/images/section_icons/warning.png');
                   8176: }
                   8177: 
1.1269    raeburn  8178: #LC_minitab_header {
                   8179:   float:left;
                   8180:   width:100%;
                   8181:   background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
                   8182:   font-size:93%;
                   8183:   line-height:normal;
                   8184:   margin: 0.5em 0 0.5em 0;
                   8185: }
                   8186: #LC_minitab_header ul {
                   8187:   margin:0;
                   8188:   padding:10px 10px 0;
                   8189:   list-style:none;
                   8190: }
                   8191: #LC_minitab_header li {
                   8192:   float:left;
                   8193:   background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
                   8194:   margin:0;
                   8195:   padding:0 0 0 9px;
                   8196: }
                   8197: #LC_minitab_header a {
                   8198:   display:block;
                   8199:   background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
                   8200:   padding:5px 15px 4px 6px;
                   8201: }
                   8202: #LC_minitab_header #LC_current_minitab {
                   8203:   background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
                   8204: }
                   8205: #LC_minitab_header #LC_current_minitab a {
                   8206:   background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
                   8207:   padding-bottom:5px;
                   8208: }
                   8209: 
                   8210: 
1.343     albertel 8211: END
                   8212: }
                   8213: 
1.306     albertel 8214: =pod
                   8215: 
                   8216: =item * &headtag()
                   8217: 
                   8218: Returns a uniform footer for LON-CAPA web pages.
                   8219: 
1.307     albertel 8220: Inputs: $title - optional title for the head
                   8221:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 8222:         $args - optional arguments
1.319     albertel 8223:             force_register - if is true call registerurl so the remote is 
                   8224:                              informed
1.415     albertel 8225:             redirect       -> array ref of
                   8226:                                    1- seconds before redirect occurs
                   8227:                                    2- url to redirect to
                   8228:                                    3- whether the side effect should occur
1.315     albertel 8229:                            (side effect of setting 
                   8230:                                $env{'internal.head.redirect'} to the url 
                   8231:                                redirected too)
1.352     albertel 8232:             domain         -> force to color decorate a page for a specific
                   8233:                                domain
                   8234:             function       -> force usage of a specific rolish color scheme
                   8235:             bgcolor        -> override the default page bgcolor
1.460     albertel 8236:             no_auto_mt_title
                   8237:                            -> prevent &mt()ing the title arg
1.464     albertel 8238: 
1.306     albertel 8239: =cut
                   8240: 
                   8241: sub headtag {
1.313     albertel 8242:     my ($title,$head_extra,$args) = @_;
1.306     albertel 8243:     
1.363     albertel 8244:     my $function = $args->{'function'} || &get_users_function();
                   8245:     my $domain   = $args->{'domain'}   || &determinedomain();
                   8246:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1154    raeburn  8247:     my $httphost = $args->{'use_absolute'};
1.418     albertel 8248:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 8249: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 8250: 		   #time(),
1.418     albertel 8251: 		   $env{'environment.color.timestamp'},
1.363     albertel 8252: 		   $function,$domain,$bgcolor);
                   8253: 
1.369     www      8254:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 8255: 
1.308     albertel 8256:     my $result =
                   8257: 	'<head>'.
1.1160    raeburn  8258: 	&font_settings($args);
1.319     albertel 8259: 
1.1188    raeburn  8260:     my $inhibitprint;
                   8261:     if ($args->{'print_suppress'}) {
                   8262:         $inhibitprint = &print_suppression();
                   8263:     }
1.1064    raeburn  8264: 
1.461     albertel 8265:     if (!$args->{'frameset'}) {
                   8266: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   8267:     }
1.962     droeschl 8268:     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
                   8269:         $result .= Apache::lonxml::display_title();
1.319     albertel 8270:     }
1.436     albertel 8271:     if (!$args->{'no_nav_bar'} 
                   8272: 	&& !$args->{'only_body'}
                   8273: 	&& !$args->{'frameset'}) {
1.1154    raeburn  8274: 	$result .= &help_menu_js($httphost);
1.1032    www      8275:         $result.=&modal_window();
1.1038    www      8276:         $result.=&togglebox_script();
1.1034    www      8277:         $result.=&wishlist_window();
1.1041    www      8278:         $result.=&LCprogressbarUpdate_script();
1.1034    www      8279:     } else {
                   8280:         if ($args->{'add_modal'}) {
                   8281:            $result.=&modal_window();
                   8282:         }
                   8283:         if ($args->{'add_wishlist'}) {
                   8284:            $result.=&wishlist_window();
                   8285:         }
1.1038    www      8286:         if ($args->{'add_togglebox'}) {
                   8287:            $result.=&togglebox_script();
                   8288:         }
1.1041    www      8289:         if ($args->{'add_progressbar'}) {
                   8290:            $result.=&LCprogressbarUpdate_script();
                   8291:         }
1.436     albertel 8292:     }
1.314     albertel 8293:     if (ref($args->{'redirect'})) {
1.414     albertel 8294: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 8295: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 8296: 	if (!$inhibit_continue) {
                   8297: 	    $env{'internal.head.redirect'} = $url;
                   8298: 	}
1.313     albertel 8299: 	$result.=<<ADDMETA
                   8300: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 8301: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 8302: ADDMETA
1.1210    raeburn  8303:     } else {
                   8304:         unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
                   8305:             my $requrl = $env{'request.uri'};
                   8306:             if ($requrl eq '') {
                   8307:                 $requrl = $ENV{'REQUEST_URI'};
                   8308:                 $requrl =~ s/\?.+$//;
                   8309:             }
                   8310:             unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
                   8311:                     (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
                   8312:                      ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
                   8313:                 my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                   8314:                 unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                   8315:                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
                   8316:                     if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                   8317:                         my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   8318:                         if ($domdefs{'offloadnow'}{$lonhost}) {
                   8319:                             my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
                   8320:                             if (($newserver) && ($newserver ne $lonhost)) {
                   8321:                                 my $numsec = 5;
                   8322:                                 my $timeout = $numsec * 1000;
                   8323:                                 my ($newurl,$locknum,%locks,$msg);
                   8324:                                 if ($env{'request.role.adv'}) {
                   8325:                                     ($locknum,%locks) = &Apache::lonnet::get_locks();
                   8326:                                 }
                   8327:                                 my $disable_submit = 0;
                   8328:                                 if ($requrl =~ /$LONCAPA::assess_re/) {
                   8329:                                     $disable_submit = 1;
                   8330:                                 }
                   8331:                                 if ($locknum) {
                   8332:                                     my @lockinfo = sort(values(%locks));
                   8333:                                     $msg = &mt('Once the following tasks are complete: ')."\\n".
                   8334:                                            join(", ",sort(values(%locks)))."\\n".
                   8335:                                            &mt('your session will be transferred to a different server, after you click "Roles".');
                   8336:                                 } else {
                   8337:                                     if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                   8338:                                         $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
                   8339:                                     }
                   8340:                                     $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                   8341:                                     $newurl = '/adm/switchserver?otherserver='.$newserver;
                   8342:                                     if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
                   8343:                                         $newurl .= '&role='.$env{'request.role'};
                   8344:                                     }
                   8345:                                     if ($env{'request.symb'}) {
                   8346:                                         $newurl .= '&symb='.$env{'request.symb'};
                   8347:                                     } else {
                   8348:                                         $newurl .= '&origurl='.$requrl;
                   8349:                                     }
                   8350:                                 }
1.1222    damieng  8351:                                 &js_escape(\$msg);
1.1210    raeburn  8352:                                 $result.=<<OFFLOAD
                   8353: <meta http-equiv="pragma" content="no-cache" />
                   8354: <script type="text/javascript">
1.1215    raeburn  8355: // <![CDATA[
1.1210    raeburn  8356: function LC_Offload_Now() {
                   8357:     var dest = "$newurl";
                   8358:     if (dest != '') {
                   8359:         window.location.href="$newurl";
                   8360:     }
                   8361: }
1.1214    raeburn  8362: \$(document).ready(function () {
                   8363:     window.alert('$msg');
                   8364:     if ($disable_submit) {
1.1210    raeburn  8365:         \$(".LC_hwk_submit").prop("disabled", true);
                   8366:         \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214    raeburn  8367:     }
                   8368:     setTimeout('LC_Offload_Now()', $timeout);
                   8369: });
1.1215    raeburn  8370: // ]]>
1.1210    raeburn  8371: </script>
                   8372: OFFLOAD
                   8373:                             }
                   8374:                         }
                   8375:                     }
                   8376:                 }
                   8377:             }
                   8378:         }
1.313     albertel 8379:     }
1.306     albertel 8380:     if (!defined($title)) {
                   8381: 	$title = 'The LearningOnline Network with CAPA';
                   8382:     }
1.460     albertel 8383:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   8384:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168    raeburn  8385: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'"';
                   8386:     if (!$args->{'frameset'}) {
                   8387:         $result .= ' /';
                   8388:     }
                   8389:     $result .= '>' 
1.1064    raeburn  8390:         .$inhibitprint
1.414     albertel 8391: 	.$head_extra;
1.1242    raeburn  8392:     my $clientmobile;
                   8393:     if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   8394:         (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
                   8395:     } else {
                   8396:         $clientmobile = $env{'browser.mobile'};
                   8397:     }
                   8398:     if ($clientmobile) {
1.1137    raeburn  8399:         $result .= '
                   8400: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   8401: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   8402:     }
1.1278    raeburn  8403:     $result .= '<meta name="google" content="notranslate" />'."\n";
1.962     droeschl 8404:     return $result.'</head>';
1.306     albertel 8405: }
                   8406: 
                   8407: =pod
                   8408: 
1.340     albertel 8409: =item * &font_settings()
                   8410: 
                   8411: Returns neccessary <meta> to set the proper encoding
                   8412: 
1.1160    raeburn  8413: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340     albertel 8414: 
                   8415: =cut
                   8416: 
                   8417: sub font_settings {
1.1160    raeburn  8418:     my ($args) = @_;
1.340     albertel 8419:     my $headerstring='';
1.1160    raeburn  8420:     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
                   8421:         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168    raeburn  8422:         $headerstring.=
                   8423:             '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
                   8424:         if (!$args->{'frameset'}) {
                   8425: 	    $headerstring.= ' /';
                   8426:         }
                   8427: 	$headerstring .= '>'."\n";
1.340     albertel 8428:     }
                   8429:     return $headerstring;
                   8430: }
                   8431: 
1.341     albertel 8432: =pod
                   8433: 
1.1064    raeburn  8434: =item * &print_suppression()
                   8435: 
                   8436: In course context returns css which causes the body to be blank when media="print",
                   8437: if printout generation is unavailable for the current resource.
                   8438: 
                   8439: This could be because:
                   8440: 
                   8441: (a) printstartdate is in the future
                   8442: 
                   8443: (b) printenddate is in the past
                   8444: 
                   8445: (c) there is an active exam block with "printout"
                   8446: functionality blocked
                   8447: 
                   8448: Users with pav, pfo or evb privileges are exempt.
                   8449: 
                   8450: Inputs: none
                   8451: 
                   8452: =cut
                   8453: 
                   8454: 
                   8455: sub print_suppression {
                   8456:     my $noprint;
                   8457:     if ($env{'request.course.id'}) {
                   8458:         my $scope = $env{'request.course.id'};
                   8459:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   8460:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   8461:             return;
                   8462:         }
                   8463:         if ($env{'request.course.sec'} ne '') {
                   8464:             $scope .= "/$env{'request.course.sec'}";
                   8465:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   8466:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  8467:                 return;
1.1064    raeburn  8468:             }
                   8469:         }
                   8470:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   8471:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189    raeburn  8472:         my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064    raeburn  8473:         if ($blocked) {
                   8474:             my $checkrole = "cm./$cdom/$cnum";
                   8475:             if ($env{'request.course.sec'} ne '') {
                   8476:                 $checkrole .= "/$env{'request.course.sec'}";
                   8477:             }
                   8478:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   8479:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   8480:                 $noprint = 1;
                   8481:             }
                   8482:         }
                   8483:         unless ($noprint) {
                   8484:             my $symb = &Apache::lonnet::symbread();
                   8485:             if ($symb ne '') {
                   8486:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   8487:                 if (ref($navmap)) {
                   8488:                     my $res = $navmap->getBySymb($symb);
                   8489:                     if (ref($res)) {
                   8490:                         if (!$res->resprintable()) {
                   8491:                             $noprint = 1;
                   8492:                         }
                   8493:                     }
                   8494:                 }
                   8495:             }
                   8496:         }
                   8497:         if ($noprint) {
                   8498:             return <<"ENDSTYLE";
                   8499: <style type="text/css" media="print">
                   8500:     body { display:none }
                   8501: </style>
                   8502: ENDSTYLE
                   8503:         }
                   8504:     }
                   8505:     return;
                   8506: }
                   8507: 
                   8508: =pod
                   8509: 
1.341     albertel 8510: =item * &xml_begin()
                   8511: 
                   8512: Returns the needed doctype and <html>
                   8513: 
                   8514: Inputs: none
                   8515: 
                   8516: =cut
                   8517: 
                   8518: sub xml_begin {
1.1168    raeburn  8519:     my ($is_frameset) = @_;
1.341     albertel 8520:     my $output='';
                   8521: 
                   8522:     if ($env{'browser.mathml'}) {
                   8523: 	$output='<?xml version="1.0"?>'
                   8524:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   8525: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   8526:             
                   8527: #	    .'<!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">] >'
                   8528: 	    .'<!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">'
                   8529:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   8530: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168    raeburn  8531:     } elsif ($is_frameset) {
                   8532:         $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   8533:                 '<html>'."\n";
1.341     albertel 8534:     } else {
1.1168    raeburn  8535: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
                   8536:                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341     albertel 8537:     }
                   8538:     return $output;
                   8539: }
1.340     albertel 8540: 
                   8541: =pod
                   8542: 
1.306     albertel 8543: =item * &start_page()
                   8544: 
                   8545: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   8546: 
1.648     raeburn  8547: Inputs:
                   8548: 
                   8549: =over 4
                   8550: 
                   8551: $title - optional title for the page
                   8552: 
                   8553: $head_extra - optional extra HTML to incude inside the <head>
                   8554: 
                   8555: $args - additional optional args supported are:
                   8556: 
                   8557: =over 8
                   8558: 
                   8559:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 8560:                                     arg on
1.814     bisitz   8561:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  8562:              add_entries    -> additional attributes to add to the  <body>
                   8563:              domain         -> force to color decorate a page for a 
1.317     albertel 8564:                                     specific domain
1.648     raeburn  8565:              function       -> force usage of a specific rolish color
1.317     albertel 8566:                                     scheme
1.648     raeburn  8567:              redirect       -> see &headtag()
                   8568:              bgcolor        -> override the default page bg color
                   8569:              js_ready       -> return a string ready for being used in 
1.317     albertel 8570:                                     a javascript writeln
1.648     raeburn  8571:              html_encode    -> return a string ready for being used in 
1.320     albertel 8572:                                     a html attribute
1.648     raeburn  8573:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 8574:                                     $forcereg arg
1.648     raeburn  8575:              frameset       -> if true will start with a <frameset>
1.330     albertel 8576:                                     rather than <body>
1.648     raeburn  8577:              skip_phases    -> hash ref of 
1.338     albertel 8578:                                     head -> skip the <html><head> generation
                   8579:                                     body -> skip all <body> generation
1.648     raeburn  8580:              no_auto_mt_title -> prevent &mt()ing the title arg
1.867     kalberla 8581:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  8582:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1272    raeburn  8583:              bread_crumbs_nomenu -> if true will pass false as the value of $menulink
                   8584:                                     to lonhtmlcommon::breadcrumbs
1.1096    raeburn  8585:              group          -> includes the current group, if page is for a 
1.1274    raeburn  8586:                                specific group
                   8587:              use_absolute   -> for request for external resource or syllabus, this
                   8588:                                will contain https://<hostname> if server uses
                   8589:                                https (as per hosts.tab), but request is for http
                   8590:              hostname       -> hostname, originally from $r->hostname(), (optional).
1.361     albertel 8591: 
1.648     raeburn  8592: =back
1.460     albertel 8593: 
1.648     raeburn  8594: =back
1.562     albertel 8595: 
1.306     albertel 8596: =cut
                   8597: 
                   8598: sub start_page {
1.309     albertel 8599:     my ($title,$head_extra,$args) = @_;
1.318     albertel 8600:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 8601: 
1.315     albertel 8602:     $env{'internal.start_page'}++;
1.1096    raeburn  8603:     my ($result,@advtools);
1.964     droeschl 8604: 
1.338     albertel 8605:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168    raeburn  8606:         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338     albertel 8607:     }
                   8608:     
                   8609:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   8610: 	if ($args->{'frameset'}) {
                   8611: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   8612: 						$args->{'add_entries'});
                   8613: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   8614:         } else {
                   8615:             $result .=
                   8616:                 &bodytag($title, 
                   8617:                          $args->{'function'},       $args->{'add_entries'},
                   8618:                          $args->{'only_body'},      $args->{'domain'},
                   8619:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096    raeburn  8620:                          $args->{'bgcolor'},        $args,
                   8621:                          \@advtools);
1.831     bisitz   8622:         }
1.330     albertel 8623:     }
1.338     albertel 8624: 
1.315     albertel 8625:     if ($args->{'js_ready'}) {
1.713     kaisler  8626: 		$result = &js_ready($result);
1.315     albertel 8627:     }
1.320     albertel 8628:     if ($args->{'html_encode'}) {
1.713     kaisler  8629: 		$result = &html_encode($result);
                   8630:     }
                   8631: 
1.813     bisitz   8632:     # Preparation for new and consistent functionlist at top of screen
                   8633:     # if ($args->{'functionlist'}) {
                   8634:     #            $result .= &build_functionlist();
                   8635:     #}
                   8636: 
1.964     droeschl 8637:     # Don't add anything more if only_body wanted or in const space
                   8638:     return $result if    $args->{'only_body'} 
                   8639:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   8640: 
                   8641:     #Breadcrumbs
1.758     kaisler  8642:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   8643: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   8644: 		#if any br links exists, add them to the breadcrumbs
                   8645: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   8646: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   8647: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   8648: 			}
                   8649: 		}
1.1096    raeburn  8650:                 # if @advtools array contains items add then to the breadcrumbs
                   8651:                 if (@advtools > 0) {
                   8652:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   8653:                 }
1.1272    raeburn  8654:                 my $menulink;
                   8655:                 # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
                   8656:                 if ((exists($args->{'bread_crumbs_nomenu'})) ||
                   8657:                      ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
                   8658:                      ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
                   8659:                      (!$env{'request.role.adv'}))) {
                   8660:                     $menulink = 0;
                   8661:                 } else {
                   8662:                     undef($menulink);
                   8663:                 }
1.758     kaisler  8664: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   8665: 		if(exists($args->{'bread_crumbs_component'})){
1.1272    raeburn  8666: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
1.1237    raeburn  8667:                 } else {
1.1272    raeburn  8668: 			$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
1.758     kaisler  8669: 		}
1.320     albertel 8670:     }
1.315     albertel 8671:     return $result;
1.306     albertel 8672: }
                   8673: 
                   8674: sub end_page {
1.315     albertel 8675:     my ($args) = @_;
                   8676:     $env{'internal.end_page'}++;
1.330     albertel 8677:     my $result;
1.335     albertel 8678:     if ($args->{'discussion'}) {
                   8679: 	my ($target,$parser);
                   8680: 	if (ref($args->{'discussion'})) {
                   8681: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   8682: 				$args->{'discussion'}{'parser'});
                   8683: 	}
                   8684: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   8685:     }
1.330     albertel 8686:     if ($args->{'frameset'}) {
                   8687: 	$result .= '</frameset>';
                   8688:     } else {
1.635     raeburn  8689: 	$result .= &endbodytag($args);
1.330     albertel 8690:     }
1.1080    raeburn  8691:     unless ($args->{'notbody'}) {
                   8692:         $result .= "\n</html>";
                   8693:     }
1.330     albertel 8694: 
1.315     albertel 8695:     if ($args->{'js_ready'}) {
1.317     albertel 8696: 	$result = &js_ready($result);
1.315     albertel 8697:     }
1.335     albertel 8698: 
1.320     albertel 8699:     if ($args->{'html_encode'}) {
                   8700: 	$result = &html_encode($result);
                   8701:     }
1.335     albertel 8702: 
1.315     albertel 8703:     return $result;
                   8704: }
                   8705: 
1.1034    www      8706: sub wishlist_window {
                   8707:     return(<<'ENDWISHLIST');
1.1046    raeburn  8708: <script type="text/javascript">
1.1034    www      8709: // <![CDATA[
                   8710: // <!-- BEGIN LON-CAPA Internal
                   8711: function set_wishlistlink(title, path) {
                   8712:     if (!title) {
                   8713:         title = document.title;
                   8714:         title = title.replace(/^LON-CAPA /,'');
                   8715:     }
1.1175    raeburn  8716:     title = encodeURIComponent(title);
1.1203    raeburn  8717:     title = title.replace("'","\\\'");
1.1034    www      8718:     if (!path) {
                   8719:         path = location.pathname;
                   8720:     }
1.1175    raeburn  8721:     path = encodeURIComponent(path);
1.1203    raeburn  8722:     path = path.replace("'","\\\'");
1.1034    www      8723:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   8724:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   8725: }
                   8726: // END LON-CAPA Internal -->
                   8727: // ]]>
                   8728: </script>
                   8729: ENDWISHLIST
                   8730: }
                   8731: 
1.1030    www      8732: sub modal_window {
                   8733:     return(<<'ENDMODAL');
1.1046    raeburn  8734: <script type="text/javascript">
1.1030    www      8735: // <![CDATA[
                   8736: // <!-- BEGIN LON-CAPA Internal
                   8737: var modalWindow = {
                   8738: 	parent:"body",
                   8739: 	windowId:null,
                   8740: 	content:null,
                   8741: 	width:null,
                   8742: 	height:null,
                   8743: 	close:function()
                   8744: 	{
                   8745: 	        $(".LCmodal-window").remove();
                   8746: 	        $(".LCmodal-overlay").remove();
                   8747: 	},
                   8748: 	open:function()
                   8749: 	{
                   8750: 		var modal = "";
                   8751: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   8752: 		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;\">";
                   8753: 		modal += this.content;
                   8754: 		modal += "</div>";	
                   8755: 
                   8756: 		$(this.parent).append(modal);
                   8757: 
                   8758: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   8759: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   8760: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   8761: 	}
                   8762: };
1.1140    raeburn  8763: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      8764: 	{
1.1266    raeburn  8765:                 source = source.replace(/'/g,"&#39;");
1.1030    www      8766: 		modalWindow.windowId = "myModal";
                   8767: 		modalWindow.width = width;
                   8768: 		modalWindow.height = height;
1.1196    raeburn  8769: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030    www      8770: 		modalWindow.open();
1.1208    raeburn  8771: 	};
1.1030    www      8772: // END LON-CAPA Internal -->
                   8773: // ]]>
                   8774: </script>
                   8775: ENDMODAL
                   8776: }
                   8777: 
                   8778: sub modal_link {
1.1140    raeburn  8779:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      8780:     unless ($width) { $width=480; }
                   8781:     unless ($height) { $height=400; }
1.1031    www      8782:     unless ($scrolling) { $scrolling='yes'; }
1.1140    raeburn  8783:     unless ($transparency) { $transparency='true'; }
                   8784: 
1.1074    raeburn  8785:     my $target_attr;
                   8786:     if (defined($target)) {
                   8787:         $target_attr = 'target="'.$target.'"';
                   8788:     }
                   8789:     return <<"ENDLINK";
1.1140    raeburn  8790: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074    raeburn  8791:            $linktext</a>
                   8792: ENDLINK
1.1030    www      8793: }
                   8794: 
1.1032    www      8795: sub modal_adhoc_script {
                   8796:     my ($funcname,$width,$height,$content)=@_;
                   8797:     return (<<ENDADHOC);
1.1046    raeburn  8798: <script type="text/javascript">
1.1032    www      8799: // <![CDATA[
                   8800:         var $funcname = function()
                   8801:         {
                   8802:                 modalWindow.windowId = "myModal";
                   8803:                 modalWindow.width = $width;
                   8804:                 modalWindow.height = $height;
                   8805:                 modalWindow.content = '$content';
                   8806:                 modalWindow.open();
                   8807:         };  
                   8808: // ]]>
                   8809: </script>
                   8810: ENDADHOC
                   8811: }
                   8812: 
1.1041    www      8813: sub modal_adhoc_inner {
                   8814:     my ($funcname,$width,$height,$content)=@_;
                   8815:     my $innerwidth=$width-20;
                   8816:     $content=&js_ready(
1.1140    raeburn  8817:                  &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
                   8818:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   8819:                  $content.
1.1041    www      8820:                  &end_scrollbox().
1.1140    raeburn  8821:                  &end_page()
1.1041    www      8822:              );
                   8823:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   8824: }
                   8825: 
                   8826: sub modal_adhoc_window {
                   8827:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   8828:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   8829:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   8830: }
                   8831: 
                   8832: sub modal_adhoc_launch {
                   8833:     my ($funcname,$width,$height,$content)=@_;
                   8834:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   8835: <script type="text/javascript">
                   8836: // <![CDATA[
                   8837: $funcname();
                   8838: // ]]>
                   8839: </script>
                   8840: ENDLAUNCH
                   8841: }
                   8842: 
                   8843: sub modal_adhoc_close {
                   8844:     return (<<ENDCLOSE);
                   8845: <script type="text/javascript">
                   8846: // <![CDATA[
                   8847: modalWindow.close();
                   8848: // ]]>
                   8849: </script>
                   8850: ENDCLOSE
                   8851: }
                   8852: 
1.1038    www      8853: sub togglebox_script {
                   8854:    return(<<ENDTOGGLE);
                   8855: <script type="text/javascript"> 
                   8856: // <![CDATA[
                   8857: function LCtoggleDisplay(id,hidetext,showtext) {
                   8858:    link = document.getElementById(id + "link").childNodes[0];
                   8859:    with (document.getElementById(id).style) {
                   8860:       if (display == "none" ) {
                   8861:           display = "inline";
                   8862:           link.nodeValue = hidetext;
                   8863:         } else {
                   8864:           display = "none";
                   8865:           link.nodeValue = showtext;
                   8866:        }
                   8867:    }
                   8868: }
                   8869: // ]]>
                   8870: </script>
                   8871: ENDTOGGLE
                   8872: }
                   8873: 
1.1039    www      8874: sub start_togglebox {
                   8875:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   8876:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   8877:     unless ($showtext) { $showtext=&mt('show'); }
                   8878:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   8879:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   8880:     return &start_data_table().
                   8881:            &start_data_table_header_row().
                   8882:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   8883:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   8884:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   8885:            &end_data_table_header_row().
                   8886:            '<tr id="'.$id.'" style="display:none""><td>';
                   8887: }
                   8888: 
                   8889: sub end_togglebox {
                   8890:     return '</td></tr>'.&end_data_table();
                   8891: }
                   8892: 
1.1041    www      8893: sub LCprogressbar_script {
1.1045    www      8894:    my ($id)=@_;
1.1041    www      8895:    return(<<ENDPROGRESS);
                   8896: <script type="text/javascript">
                   8897: // <![CDATA[
1.1045    www      8898: \$('#progressbar$id').progressbar({
1.1041    www      8899:   value: 0,
                   8900:   change: function(event, ui) {
                   8901:     var newVal = \$(this).progressbar('option', 'value');
                   8902:     \$('.pblabel', this).text(LCprogressTxt);
                   8903:   }
                   8904: });
                   8905: // ]]>
                   8906: </script>
                   8907: ENDPROGRESS
                   8908: }
                   8909: 
                   8910: sub LCprogressbarUpdate_script {
                   8911:    return(<<ENDPROGRESSUPDATE);
                   8912: <style type="text/css">
                   8913: .ui-progressbar { position:relative; }
                   8914: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   8915: </style>
                   8916: <script type="text/javascript">
                   8917: // <![CDATA[
1.1045    www      8918: var LCprogressTxt='---';
                   8919: 
                   8920: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      8921:    LCprogressTxt=progresstext;
1.1045    www      8922:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      8923: }
                   8924: // ]]>
                   8925: </script>
                   8926: ENDPROGRESSUPDATE
                   8927: }
                   8928: 
1.1042    www      8929: my $LClastpercent;
1.1045    www      8930: my $LCidcnt;
                   8931: my $LCcurrentid;
1.1042    www      8932: 
1.1041    www      8933: sub LCprogressbar {
1.1042    www      8934:     my ($r)=(@_);
                   8935:     $LClastpercent=0;
1.1045    www      8936:     $LCidcnt++;
                   8937:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      8938:     my $starting=&mt('Starting');
                   8939:     my $content=(<<ENDPROGBAR);
1.1045    www      8940:   <div id="progressbar$LCcurrentid">
1.1041    www      8941:     <span class="pblabel">$starting</span>
                   8942:   </div>
                   8943: ENDPROGBAR
1.1045    www      8944:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      8945: }
                   8946: 
                   8947: sub LCprogressbarUpdate {
1.1042    www      8948:     my ($r,$val,$text)=@_;
                   8949:     unless ($val) { 
                   8950:        if ($LClastpercent) {
                   8951:            $val=$LClastpercent;
                   8952:        } else {
                   8953:            $val=0;
                   8954:        }
                   8955:     }
1.1041    www      8956:     if ($val<0) { $val=0; }
                   8957:     if ($val>100) { $val=0; }
1.1042    www      8958:     $LClastpercent=$val;
1.1041    www      8959:     unless ($text) { $text=$val.'%'; }
                   8960:     $text=&js_ready($text);
1.1044    www      8961:     &r_print($r,<<ENDUPDATE);
1.1041    www      8962: <script type="text/javascript">
                   8963: // <![CDATA[
1.1045    www      8964: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      8965: // ]]>
                   8966: </script>
                   8967: ENDUPDATE
1.1035    www      8968: }
                   8969: 
1.1042    www      8970: sub LCprogressbarClose {
                   8971:     my ($r)=@_;
                   8972:     $LClastpercent=0;
1.1044    www      8973:     &r_print($r,<<ENDCLOSE);
1.1042    www      8974: <script type="text/javascript">
                   8975: // <![CDATA[
1.1045    www      8976: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      8977: // ]]>
                   8978: </script>
                   8979: ENDCLOSE
1.1044    www      8980: }
                   8981: 
                   8982: sub r_print {
                   8983:     my ($r,$to_print)=@_;
                   8984:     if ($r) {
                   8985:       $r->print($to_print);
                   8986:       $r->rflush();
                   8987:     } else {
                   8988:       print($to_print);
                   8989:     }
1.1042    www      8990: }
                   8991: 
1.320     albertel 8992: sub html_encode {
                   8993:     my ($result) = @_;
                   8994: 
1.322     albertel 8995:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 8996:     
                   8997:     return $result;
                   8998: }
1.1044    www      8999: 
1.317     albertel 9000: sub js_ready {
                   9001:     my ($result) = @_;
                   9002: 
1.323     albertel 9003:     $result =~ s/[\n\r]/ /xmsg;
                   9004:     $result =~ s/\\/\\\\/xmsg;
                   9005:     $result =~ s/'/\\'/xmsg;
1.372     albertel 9006:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 9007:     
                   9008:     return $result;
                   9009: }
                   9010: 
1.315     albertel 9011: sub validate_page {
                   9012:     if (  exists($env{'internal.start_page'})
1.316     albertel 9013: 	  &&     $env{'internal.start_page'} > 1) {
                   9014: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 9015: 				 $env{'internal.start_page'}.' '.
1.316     albertel 9016: 				 $ENV{'request.filename'});
1.315     albertel 9017:     }
                   9018:     if (  exists($env{'internal.end_page'})
1.316     albertel 9019: 	  &&     $env{'internal.end_page'} > 1) {
                   9020: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 9021: 				 $env{'internal.end_page'}.' '.
1.316     albertel 9022: 				 $env{'request.filename'});
1.315     albertel 9023:     }
                   9024:     if (     exists($env{'internal.start_page'})
                   9025: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 9026: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   9027: 				 $env{'request.filename'});
1.315     albertel 9028:     }
                   9029:     if (   ! exists($env{'internal.start_page'})
                   9030: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 9031: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   9032: 				 $env{'request.filename'});
1.315     albertel 9033:     }
1.306     albertel 9034: }
1.315     albertel 9035: 
1.996     www      9036: 
                   9037: sub start_scrollbox {
1.1140    raeburn  9038:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  9039:     unless ($outerwidth) { $outerwidth='520px'; }
                   9040:     unless ($width) { $width='500px'; }
                   9041:     unless ($height) { $height='200px'; }
1.1075    raeburn  9042:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  9043:     if ($id ne '') {
1.1140    raeburn  9044:         $table_id = ' id="table_'.$id.'"';
1.1137    raeburn  9045:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  9046:     }
1.1075    raeburn  9047:     if ($bgcolor ne '') {
                   9048:         $tdcol = "background-color: $bgcolor;";
                   9049:     }
1.1137    raeburn  9050:     my $nicescroll_js;
                   9051:     if ($env{'browser.mobile'}) {
1.1140    raeburn  9052:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   9053:     }
                   9054:     return <<"END";
                   9055: $nicescroll_js
                   9056: 
                   9057: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
                   9058: <div style="overflow:auto; width:$width; height:$height;"$div_id>
                   9059: END
                   9060: }
                   9061: 
                   9062: sub end_scrollbox {
                   9063:     return '</div></td></tr></table>';
                   9064: }
                   9065: 
                   9066: sub nicescroll_javascript {
                   9067:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   9068:     my %options;
                   9069:     if (ref($cursor) eq 'HASH') {
                   9070:         %options = %{$cursor};
                   9071:     }
                   9072:     unless ($options{'railalign'} =~ /^left|right$/) {
                   9073:         $options{'railalign'} = 'left';
                   9074:     }
                   9075:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   9076:         my $function  = &get_users_function();
                   9077:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138    raeburn  9078:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140    raeburn  9079:             $options{'cursorcolor'} = '#00F';
1.1138    raeburn  9080:         }
1.1140    raeburn  9081:     }
                   9082:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   9083:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138    raeburn  9084:             $options{'cursoropacity'}='1.0';
                   9085:         }
1.1140    raeburn  9086:     } else {
                   9087:         $options{'cursoropacity'}='1.0';
                   9088:     }
                   9089:     if ($options{'cursorfixedheight'} eq 'none') {
                   9090:         delete($options{'cursorfixedheight'});
                   9091:     } else {
                   9092:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   9093:     }
                   9094:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   9095:         delete($options{'railoffset'});
                   9096:     }
                   9097:     my @niceoptions;
                   9098:     while (my($key,$value) = each(%options)) {
                   9099:         if ($value =~ /^\{.+\}$/) {
                   9100:             push(@niceoptions,$key.':'.$value);
1.1138    raeburn  9101:         } else {
1.1140    raeburn  9102:             push(@niceoptions,$key.':"'.$value.'"');
1.1138    raeburn  9103:         }
1.1140    raeburn  9104:     }
                   9105:     my $nicescroll_js = '
1.1137    raeburn  9106: $(document).ready(
1.1140    raeburn  9107:       function() {
                   9108:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   9109:       }
1.1137    raeburn  9110: );
                   9111: ';
1.1140    raeburn  9112:     if ($framecheck) {
                   9113:         $nicescroll_js .= '
                   9114: function expand_div(caller) {
                   9115:     if (top === self) {
                   9116:         document.getElementById("'.$id.'").style.width = "auto";
                   9117:         document.getElementById("'.$id.'").style.height = "auto";
                   9118:     } else {
                   9119:         try {
                   9120:             if (parent.frames) {
                   9121:                 if (parent.frames.length > 1) {
                   9122:                     var framesrc = parent.frames[1].location.href;
                   9123:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   9124:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   9125:                         document.getElementById("'.$id.'").style.width = "auto";
                   9126:                         document.getElementById("'.$id.'").style.height = "auto";
                   9127:                     }
                   9128:                 }
                   9129:             }
                   9130:         } catch (e) {
                   9131:             return;
                   9132:         }
1.1137    raeburn  9133:     }
1.1140    raeburn  9134:     return;
1.996     www      9135: }
1.1140    raeburn  9136: ';
                   9137:     }
                   9138:     if ($needjsready) {
                   9139:         $nicescroll_js = '
                   9140: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   9141:     } else {
                   9142:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   9143:     }
                   9144:     return $nicescroll_js;
1.996     www      9145: }
                   9146: 
1.318     albertel 9147: sub simple_error_page {
1.1150    bisitz   9148:     my ($r,$title,$msg,$args) = @_;
1.1151    raeburn  9149:     if (ref($args) eq 'HASH') {
                   9150:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
                   9151:     } else {
                   9152:         $msg = &mt($msg);
                   9153:     }
1.1150    bisitz   9154: 
1.318     albertel 9155:     my $page =
                   9156: 	&Apache::loncommon::start_page($title).
1.1150    bisitz   9157: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 9158: 	&Apache::loncommon::end_page();
                   9159:     if (ref($r)) {
                   9160: 	$r->print($page);
1.327     albertel 9161: 	return;
1.318     albertel 9162:     }
                   9163:     return $page;
                   9164: }
1.347     albertel 9165: 
                   9166: {
1.610     albertel 9167:     my @row_count;
1.961     onken    9168: 
                   9169:     sub start_data_table_count {
                   9170:         unshift(@row_count, 0);
                   9171:         return;
                   9172:     }
                   9173: 
                   9174:     sub end_data_table_count {
                   9175:         shift(@row_count);
                   9176:         return;
                   9177:     }
                   9178: 
1.347     albertel 9179:     sub start_data_table {
1.1018    raeburn  9180: 	my ($add_class,$id) = @_;
1.422     albertel 9181: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  9182:         my $table_id;
                   9183:         if (defined($id)) {
                   9184:             $table_id = ' id="'.$id.'"';
                   9185:         }
1.961     onken    9186: 	&start_data_table_count();
1.1018    raeburn  9187: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 9188:     }
                   9189: 
                   9190:     sub end_data_table {
1.961     onken    9191: 	&end_data_table_count();
1.389     albertel 9192: 	return '</table>'."\n";;
1.347     albertel 9193:     }
                   9194: 
                   9195:     sub start_data_table_row {
1.974     wenzelju 9196: 	my ($add_class, $id) = @_;
1.610     albertel 9197: 	$row_count[0]++;
                   9198: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   9199: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 9200:         $id = (' id="'.$id.'"') unless ($id eq '');
                   9201:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 9202:     }
1.471     banghart 9203:     
                   9204:     sub continue_data_table_row {
1.974     wenzelju 9205: 	my ($add_class, $id) = @_;
1.610     albertel 9206: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 9207: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   9208:         $id = (' id="'.$id.'"') unless ($id eq '');
                   9209:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 9210:     }
1.347     albertel 9211: 
                   9212:     sub end_data_table_row {
1.389     albertel 9213: 	return '</tr>'."\n";;
1.347     albertel 9214:     }
1.367     www      9215: 
1.421     albertel 9216:     sub start_data_table_empty_row {
1.707     bisitz   9217: #	$row_count[0]++;
1.421     albertel 9218: 	return  '<tr class="LC_empty_row" >'."\n";;
                   9219:     }
                   9220: 
                   9221:     sub end_data_table_empty_row {
                   9222: 	return '</tr>'."\n";;
                   9223:     }
                   9224: 
1.367     www      9225:     sub start_data_table_header_row {
1.389     albertel 9226: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      9227:     }
                   9228: 
                   9229:     sub end_data_table_header_row {
1.389     albertel 9230: 	return '</tr>'."\n";;
1.367     www      9231:     }
1.890     droeschl 9232: 
                   9233:     sub data_table_caption {
                   9234:         my $caption = shift;
                   9235:         return "<caption class=\"LC_caption\">$caption</caption>";
                   9236:     }
1.347     albertel 9237: }
                   9238: 
1.548     albertel 9239: =pod
                   9240: 
                   9241: =item * &inhibit_menu_check($arg)
                   9242: 
                   9243: Checks for a inhibitmenu state and generates output to preserve it
                   9244: 
                   9245: Inputs:         $arg - can be any of
                   9246:                      - undef - in which case the return value is a string 
                   9247:                                to add  into arguments list of a uri
                   9248:                      - 'input' - in which case the return value is a HTML
                   9249:                                  <form> <input> field of type hidden to
                   9250:                                  preserve the value
                   9251:                      - a url - in which case the return value is the url with
                   9252:                                the neccesary cgi args added to preserve the
                   9253:                                inhibitmenu state
                   9254:                      - a ref to a url - no return value, but the string is
                   9255:                                         updated to include the neccessary cgi
                   9256:                                         args to preserve the inhibitmenu state
                   9257: 
                   9258: =cut
                   9259: 
                   9260: sub inhibit_menu_check {
                   9261:     my ($arg) = @_;
                   9262:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   9263:     if ($arg eq 'input') {
                   9264: 	if ($env{'form.inhibitmenu'}) {
                   9265: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   9266: 	} else {
                   9267: 	    return
                   9268: 	}
                   9269:     }
                   9270:     if ($env{'form.inhibitmenu'}) {
                   9271: 	if (ref($arg)) {
                   9272: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   9273: 	} elsif ($arg eq '') {
                   9274: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   9275: 	} else {
                   9276: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   9277: 	}
                   9278:     }
                   9279:     if (!ref($arg)) {
                   9280: 	return $arg;
                   9281:     }
                   9282: }
                   9283: 
1.251     albertel 9284: ###############################################
1.182     matthew  9285: 
                   9286: =pod
                   9287: 
1.549     albertel 9288: =back
                   9289: 
                   9290: =head1 User Information Routines
                   9291: 
                   9292: =over 4
                   9293: 
1.405     albertel 9294: =item * &get_users_function()
1.182     matthew  9295: 
                   9296: Used by &bodytag to determine the current users primary role.
                   9297: Returns either 'student','coordinator','admin', or 'author'.
                   9298: 
                   9299: =cut
                   9300: 
                   9301: ###############################################
                   9302: sub get_users_function {
1.815     tempelho 9303:     my $function = 'norole';
1.818     tempelho 9304:     if ($env{'request.role'}=~/^(st)/) {
                   9305:         $function='student';
                   9306:     }
1.907     raeburn  9307:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  9308:         $function='coordinator';
                   9309:     }
1.258     albertel 9310:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  9311:         $function='admin';
                   9312:     }
1.826     bisitz   9313:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  9314:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  9315:         $function='author';
                   9316:     }
                   9317:     return $function;
1.54      www      9318: }
1.99      www      9319: 
                   9320: ###############################################
                   9321: 
1.233     raeburn  9322: =pod
                   9323: 
1.821     raeburn  9324: =item * &show_course()
                   9325: 
                   9326: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   9327: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   9328: 
                   9329: Inputs:
                   9330: None
                   9331: 
                   9332: Outputs:
                   9333: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   9334: 
                   9335: =cut
                   9336: 
                   9337: ###############################################
                   9338: sub show_course {
                   9339:     my $course = !$env{'user.adv'};
                   9340:     if (!$env{'user.adv'}) {
                   9341:         foreach my $env (keys(%env)) {
                   9342:             next if ($env !~ m/^user\.priv\./);
                   9343:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   9344:                 $course = 0;
                   9345:                 last;
                   9346:             }
                   9347:         }
                   9348:     }
                   9349:     return $course;
                   9350: }
                   9351: 
                   9352: ###############################################
                   9353: 
                   9354: =pod
                   9355: 
1.542     raeburn  9356: =item * &check_user_status()
1.274     raeburn  9357: 
                   9358: Determines current status of supplied role for a
                   9359: specific user. Roles can be active, previous or future.
                   9360: 
                   9361: Inputs: 
                   9362: user's domain, user's username, course's domain,
1.375     raeburn  9363: course's number, optional section ID.
1.274     raeburn  9364: 
                   9365: Outputs:
                   9366: role status: active, previous or future. 
                   9367: 
                   9368: =cut
                   9369: 
                   9370: sub check_user_status {
1.412     raeburn  9371:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  9372:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202    raeburn  9373:     my @uroles = keys(%userinfo);
1.274     raeburn  9374:     my $srchstr;
                   9375:     my $active_chk = 'none';
1.412     raeburn  9376:     my $now = time;
1.274     raeburn  9377:     if (@uroles > 0) {
1.908     raeburn  9378:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  9379:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   9380:         } else {
1.412     raeburn  9381:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   9382:         }
                   9383:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  9384:             my $role_end = 0;
                   9385:             my $role_start = 0;
                   9386:             $active_chk = 'active';
1.412     raeburn  9387:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   9388:                 $role_end = $1;
                   9389:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   9390:                     $role_start = $1;
1.274     raeburn  9391:                 }
                   9392:             }
                   9393:             if ($role_start > 0) {
1.412     raeburn  9394:                 if ($now < $role_start) {
1.274     raeburn  9395:                     $active_chk = 'future';
                   9396:                 }
                   9397:             }
                   9398:             if ($role_end > 0) {
1.412     raeburn  9399:                 if ($now > $role_end) {
1.274     raeburn  9400:                     $active_chk = 'previous';
                   9401:                 }
                   9402:             }
                   9403:         }
                   9404:     }
                   9405:     return $active_chk;
                   9406: }
                   9407: 
                   9408: ###############################################
                   9409: 
                   9410: =pod
                   9411: 
1.405     albertel 9412: =item * &get_sections()
1.233     raeburn  9413: 
                   9414: Determines all the sections for a course including
                   9415: sections with students and sections containing other roles.
1.419     raeburn  9416: Incoming parameters: 
                   9417: 
                   9418: 1. domain
                   9419: 2. course number 
                   9420: 3. reference to array containing roles for which sections should 
                   9421: be gathered (optional).
                   9422: 4. reference to array containing status types for which sections 
                   9423: should be gathered (optional).
                   9424: 
                   9425: If the third argument is undefined, sections are gathered for any role. 
                   9426: If the fourth argument is undefined, sections are gathered for any status.
                   9427: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  9428:  
1.374     raeburn  9429: Returns section hash (keys are section IDs, values are
                   9430: number of users in each section), subject to the
1.419     raeburn  9431: optional roles filter, optional status filter 
1.233     raeburn  9432: 
                   9433: =cut
                   9434: 
                   9435: ###############################################
                   9436: sub get_sections {
1.419     raeburn  9437:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 9438:     if (!defined($cdom) || !defined($cnum)) {
                   9439:         my $cid =  $env{'request.course.id'};
                   9440: 
                   9441: 	return if (!defined($cid));
                   9442: 
                   9443:         $cdom = $env{'course.'.$cid.'.domain'};
                   9444:         $cnum = $env{'course.'.$cid.'.num'};
                   9445:     }
                   9446: 
                   9447:     my %sectioncount;
1.419     raeburn  9448:     my $now = time;
1.240     albertel 9449: 
1.1118    raeburn  9450:     my $check_students = 1;
                   9451:     my $only_students = 0;
                   9452:     if (ref($possible_roles) eq 'ARRAY') {
                   9453:         if (grep(/^st$/,@{$possible_roles})) {
                   9454:             if (@{$possible_roles} == 1) {
                   9455:                 $only_students = 1;
                   9456:             }
                   9457:         } else {
                   9458:             $check_students = 0;
                   9459:         }
                   9460:     }
                   9461: 
                   9462:     if ($check_students) { 
1.276     albertel 9463: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 9464: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   9465: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  9466:         my $start_index = &Apache::loncoursedata::CL_START();
                   9467:         my $end_index = &Apache::loncoursedata::CL_END();
                   9468:         my $status;
1.366     albertel 9469: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  9470: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   9471: 				                     $data->[$status_index],
                   9472:                                                      $data->[$start_index],
                   9473:                                                      $data->[$end_index]);
                   9474:             if ($stu_status eq 'Active') {
                   9475:                 $status = 'active';
                   9476:             } elsif ($end < $now) {
                   9477:                 $status = 'previous';
                   9478:             } elsif ($start > $now) {
                   9479:                 $status = 'future';
                   9480:             } 
                   9481: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   9482:                 if ((!defined($possible_status)) || (($status ne '') && 
                   9483:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   9484: 		    $sectioncount{$section}++;
                   9485:                 }
1.240     albertel 9486: 	    }
                   9487: 	}
                   9488:     }
1.1118    raeburn  9489:     if ($only_students) {
                   9490:         return %sectioncount;
                   9491:     }
1.240     albertel 9492:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9493:     foreach my $user (sort(keys(%courseroles))) {
                   9494: 	if ($user !~ /^(\w{2})/) { next; }
                   9495: 	my ($role) = ($user =~ /^(\w{2})/);
                   9496: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  9497: 	my ($section,$status);
1.240     albertel 9498: 	if ($role eq 'cr' &&
                   9499: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   9500: 	    $section=$1;
                   9501: 	}
                   9502: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   9503: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  9504:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   9505:         if ($end == -1 && $start == -1) {
                   9506:             next; #deleted role
                   9507:         }
                   9508:         if (!defined($possible_status)) { 
                   9509:             $sectioncount{$section}++;
                   9510:         } else {
                   9511:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   9512:                 $status = 'active';
                   9513:             } elsif ($end < $now) {
                   9514:                 $status = 'future';
                   9515:             } elsif ($start > $now) {
                   9516:                 $status = 'previous';
                   9517:             }
                   9518:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   9519:                 $sectioncount{$section}++;
                   9520:             }
                   9521:         }
1.233     raeburn  9522:     }
1.366     albertel 9523:     return %sectioncount;
1.233     raeburn  9524: }
                   9525: 
1.274     raeburn  9526: ###############################################
1.294     raeburn  9527: 
                   9528: =pod
1.405     albertel 9529: 
                   9530: =item * &get_course_users()
                   9531: 
1.275     raeburn  9532: Retrieves usernames:domains for users in the specified course
                   9533: with specific role(s), and access status. 
                   9534: 
                   9535: Incoming parameters:
1.277     albertel 9536: 1. course domain
                   9537: 2. course number
                   9538: 3. access status: users must have - either active, 
1.275     raeburn  9539: previous, future, or all.
1.277     albertel 9540: 4. reference to array of permissible roles
1.288     raeburn  9541: 5. reference to array of section restrictions (optional)
                   9542: 6. reference to results object (hash of hashes).
                   9543: 7. reference to optional userdata hash
1.609     raeburn  9544: 8. reference to optional statushash
1.630     raeburn  9545: 9. flag if privileged users (except those set to unhide in
                   9546:    course settings) should be excluded    
1.609     raeburn  9547: Keys of top level results hash are roles.
1.275     raeburn  9548: Keys of inner hashes are username:domain, with 
                   9549: values set to access type.
1.288     raeburn  9550: Optional userdata hash returns an array with arguments in the 
                   9551: same order as loncoursedata::get_classlist() for student data.
                   9552: 
1.609     raeburn  9553: Optional statushash returns
                   9554: 
1.288     raeburn  9555: Entries for end, start, section and status are blank because
                   9556: of the possibility of multiple values for non-student roles.
                   9557: 
1.275     raeburn  9558: =cut
1.405     albertel 9559: 
1.275     raeburn  9560: ###############################################
1.405     albertel 9561: 
1.275     raeburn  9562: sub get_course_users {
1.630     raeburn  9563:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  9564:     my %idx = ();
1.419     raeburn  9565:     my %seclists;
1.288     raeburn  9566: 
                   9567:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   9568:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   9569:     $idx{end} = &Apache::loncoursedata::CL_END();
                   9570:     $idx{start} = &Apache::loncoursedata::CL_START();
                   9571:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   9572:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   9573:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   9574:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   9575: 
1.290     albertel 9576:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 9577:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  9578:         my $now = time;
1.277     albertel 9579:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  9580:             my $match = 0;
1.412     raeburn  9581:             my $secmatch = 0;
1.419     raeburn  9582:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  9583:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  9584:             if ($section eq '') {
                   9585:                 $section = 'none';
                   9586:             }
1.291     albertel 9587:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 9588:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  9589:                     $secmatch = 1;
                   9590:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 9591:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  9592:                         $secmatch = 1;
                   9593:                     }
                   9594:                 } else {  
1.419     raeburn  9595: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  9596: 		        $secmatch = 1;
                   9597:                     }
1.290     albertel 9598: 		}
1.412     raeburn  9599:                 if (!$secmatch) {
                   9600:                     next;
                   9601:                 }
1.419     raeburn  9602:             }
1.275     raeburn  9603:             if (defined($$types{'active'})) {
1.288     raeburn  9604:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  9605:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  9606:                     $match = 1;
1.275     raeburn  9607:                 }
                   9608:             }
                   9609:             if (defined($$types{'previous'})) {
1.609     raeburn  9610:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  9611:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  9612:                     $match = 1;
1.275     raeburn  9613:                 }
                   9614:             }
                   9615:             if (defined($$types{'future'})) {
1.609     raeburn  9616:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  9617:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  9618:                     $match = 1;
1.275     raeburn  9619:                 }
                   9620:             }
1.609     raeburn  9621:             if ($match) {
                   9622:                 push(@{$seclists{$student}},$section);
                   9623:                 if (ref($userdata) eq 'HASH') {
                   9624:                     $$userdata{$student} = $$classlist{$student};
                   9625:                 }
                   9626:                 if (ref($statushash) eq 'HASH') {
                   9627:                     $statushash->{$student}{'st'}{$section} = $status;
                   9628:                 }
1.288     raeburn  9629:             }
1.275     raeburn  9630:         }
                   9631:     }
1.412     raeburn  9632:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  9633:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9634:         my $now = time;
1.609     raeburn  9635:         my %displaystatus = ( previous => 'Expired',
                   9636:                               active   => 'Active',
                   9637:                               future   => 'Future',
                   9638:                             );
1.1121    raeburn  9639:         my (%nothide,@possdoms);
1.630     raeburn  9640:         if ($hidepriv) {
                   9641:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   9642:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   9643:                 if ($user !~ /:/) {
                   9644:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   9645:                 } else {
                   9646:                     $nothide{$user} = 1;
                   9647:                 }
                   9648:             }
1.1121    raeburn  9649:             my @possdoms = ($cdom);
                   9650:             if ($coursehash{'checkforpriv'}) {
                   9651:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   9652:             }
1.630     raeburn  9653:         }
1.439     raeburn  9654:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  9655:             my $match = 0;
1.412     raeburn  9656:             my $secmatch = 0;
1.439     raeburn  9657:             my $status;
1.412     raeburn  9658:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  9659:             $user =~ s/:$//;
1.439     raeburn  9660:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   9661:             if ($end == -1 || $start == -1) {
                   9662:                 next;
                   9663:             }
                   9664:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   9665:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  9666:                 my ($uname,$udom) = split(/:/,$user);
                   9667:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 9668:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  9669:                         $secmatch = 1;
                   9670:                     } elsif ($usec eq '') {
1.420     albertel 9671:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  9672:                             $secmatch = 1;
                   9673:                         }
                   9674:                     } else {
                   9675:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   9676:                             $secmatch = 1;
                   9677:                         }
                   9678:                     }
                   9679:                     if (!$secmatch) {
                   9680:                         next;
                   9681:                     }
1.288     raeburn  9682:                 }
1.419     raeburn  9683:                 if ($usec eq '') {
                   9684:                     $usec = 'none';
                   9685:                 }
1.275     raeburn  9686:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  9687:                     if ($hidepriv) {
1.1121    raeburn  9688:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  9689:                             (!$nothide{$uname.':'.$udom})) {
                   9690:                             next;
                   9691:                         }
                   9692:                     }
1.503     raeburn  9693:                     if ($end > 0 && $end < $now) {
1.439     raeburn  9694:                         $status = 'previous';
                   9695:                     } elsif ($start > $now) {
                   9696:                         $status = 'future';
                   9697:                     } else {
                   9698:                         $status = 'active';
                   9699:                     }
1.277     albertel 9700:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  9701:                         if ($status eq $type) {
1.420     albertel 9702:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  9703:                                 push(@{$$users{$role}{$user}},$type);
                   9704:                             }
1.288     raeburn  9705:                             $match = 1;
                   9706:                         }
                   9707:                     }
1.419     raeburn  9708:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   9709:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   9710: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   9711:                         }
1.420     albertel 9712:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  9713:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   9714:                         }
1.609     raeburn  9715:                         if (ref($statushash) eq 'HASH') {
                   9716:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   9717:                         }
1.275     raeburn  9718:                     }
                   9719:                 }
                   9720:             }
                   9721:         }
1.290     albertel 9722:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  9723:             if ((defined($cdom)) && (defined($cnum))) {
                   9724:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   9725:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   9726:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  9727:                     next if ($owner eq '');
                   9728:                     my ($ownername,$ownerdom);
                   9729:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   9730:                         $ownername = $1;
                   9731:                         $ownerdom = $2;
                   9732:                     } else {
                   9733:                         $ownername = $owner;
                   9734:                         $ownerdom = $cdom;
                   9735:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  9736:                     }
                   9737:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 9738:                     if (defined($userdata) && 
1.609     raeburn  9739: 			!exists($$userdata{$owner})) {
                   9740: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   9741:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   9742:                             push(@{$seclists{$owner}},'none');
                   9743:                         }
                   9744:                         if (ref($statushash) eq 'HASH') {
                   9745:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  9746:                         }
1.290     albertel 9747: 		    }
1.279     raeburn  9748:                 }
                   9749:             }
                   9750:         }
1.419     raeburn  9751:         foreach my $user (keys(%seclists)) {
                   9752:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   9753:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   9754:         }
1.275     raeburn  9755:     }
                   9756:     return;
                   9757: }
                   9758: 
1.288     raeburn  9759: sub get_user_info {
                   9760:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 9761:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   9762: 	&plainname($uname,$udom,'lastname');
1.291     albertel 9763:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  9764:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  9765:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   9766:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  9767:     return;
                   9768: }
1.275     raeburn  9769: 
1.472     raeburn  9770: ###############################################
                   9771: 
                   9772: =pod
                   9773: 
                   9774: =item * &get_user_quota()
                   9775: 
1.1134    raeburn  9776: Retrieves quota assigned for storage of user files.
                   9777: Default is to report quota for portfolio files.
1.472     raeburn  9778: 
                   9779: Incoming parameters:
                   9780: 1. user's username
                   9781: 2. user's domain
1.1134    raeburn  9782: 3. quota name - portfolio, author, or course
1.1136    raeburn  9783:    (if no quota name provided, defaults to portfolio).
1.1237    raeburn  9784: 4. crstype - official, unofficial, textbook, placement or community, 
                   9785:    if quota name is course
1.472     raeburn  9786: 
                   9787: Returns:
1.1163    raeburn  9788: 1. Disk quota (in MB) assigned to student.
1.536     raeburn  9789: 2. (Optional) Type of setting: custom or default
                   9790:    (individually assigned or default for user's 
                   9791:    institutional status).
                   9792: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   9793:    or student - types as defined in localenroll::inst_usertypes 
                   9794:    for user's domain, which determines default quota for user.
                   9795: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  9796: 
                   9797: If a value has been stored in the user's environment, 
1.536     raeburn  9798: it will return that, otherwise it returns the maximal default
1.1134    raeburn  9799: defined for the user's institutional status(es) in the domain.
1.472     raeburn  9800: 
                   9801: =cut
                   9802: 
                   9803: ###############################################
                   9804: 
                   9805: 
                   9806: sub get_user_quota {
1.1136    raeburn  9807:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  9808:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  9809:     if (!defined($udom)) {
                   9810:         $udom = $env{'user.domain'};
                   9811:     }
                   9812:     if (!defined($uname)) {
                   9813:         $uname = $env{'user.name'};
                   9814:     }
                   9815:     if (($udom eq '' || $uname eq '') ||
                   9816:         ($udom eq 'public') && ($uname eq 'public')) {
                   9817:         $quota = 0;
1.536     raeburn  9818:         $quotatype = 'default';
                   9819:         $defquota = 0; 
1.472     raeburn  9820:     } else {
1.536     raeburn  9821:         my $inststatus;
1.1134    raeburn  9822:         if ($quotaname eq 'course') {
                   9823:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   9824:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   9825:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   9826:             } else {
                   9827:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   9828:                 $quota = $cenv{'internal.uploadquota'};
                   9829:             }
1.536     raeburn  9830:         } else {
1.1134    raeburn  9831:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   9832:                 if ($quotaname eq 'author') {
                   9833:                     $quota = $env{'environment.authorquota'};
                   9834:                 } else {
                   9835:                     $quota = $env{'environment.portfolioquota'};
                   9836:                 }
                   9837:                 $inststatus = $env{'environment.inststatus'};
                   9838:             } else {
                   9839:                 my %userenv = 
                   9840:                     &Apache::lonnet::get('environment',['portfolioquota',
                   9841:                                          'authorquota','inststatus'],$udom,$uname);
                   9842:                 my ($tmp) = keys(%userenv);
                   9843:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   9844:                     if ($quotaname eq 'author') {
                   9845:                         $quota = $userenv{'authorquota'};
                   9846:                     } else {
                   9847:                         $quota = $userenv{'portfolioquota'};
                   9848:                     }
                   9849:                     $inststatus = $userenv{'inststatus'};
                   9850:                 } else {
                   9851:                     undef(%userenv);
                   9852:                 }
                   9853:             }
                   9854:         }
                   9855:         if ($quota eq '' || wantarray) {
                   9856:             if ($quotaname eq 'course') {
                   9857:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165    raeburn  9858:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') || 
1.1237    raeburn  9859:                     ($crstype eq 'community') || ($crstype eq 'textbook') ||
                   9860:                     ($crstype eq 'placement')) { 
1.1136    raeburn  9861:                     $defquota = $domdefs{$crstype.'quota'};
                   9862:                 }
                   9863:                 if ($defquota eq '') {
                   9864:                     $defquota = 500;
                   9865:                 }
1.1134    raeburn  9866:             } else {
                   9867:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   9868:             }
                   9869:             if ($quota eq '') {
                   9870:                 $quota = $defquota;
                   9871:                 $quotatype = 'default';
                   9872:             } else {
                   9873:                 $quotatype = 'custom';
                   9874:             }
1.472     raeburn  9875:         }
                   9876:     }
1.536     raeburn  9877:     if (wantarray) {
                   9878:         return ($quota,$quotatype,$settingstatus,$defquota);
                   9879:     } else {
                   9880:         return $quota;
                   9881:     }
1.472     raeburn  9882: }
                   9883: 
                   9884: ###############################################
                   9885: 
                   9886: =pod
                   9887: 
                   9888: =item * &default_quota()
                   9889: 
1.536     raeburn  9890: Retrieves default quota assigned for storage of user portfolio files,
                   9891: given an (optional) user's institutional status.
1.472     raeburn  9892: 
                   9893: Incoming parameters:
1.1142    raeburn  9894: 
1.472     raeburn  9895: 1. domain
1.536     raeburn  9896: 2. (Optional) institutional status(es).  This is a : separated list of 
                   9897:    status types (e.g., faculty, staff, student etc.)
                   9898:    which apply to the user for whom the default is being retrieved.
                   9899:    If the institutional status string in undefined, the domain
1.1134    raeburn  9900:    default quota will be returned.
                   9901: 3.  quota name - portfolio, author, or course
                   9902:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  9903: 
                   9904: Returns:
1.1142    raeburn  9905: 
1.1163    raeburn  9906: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536     raeburn  9907: 2. (Optional) institutional type which determined the value of the
                   9908:    default quota.
1.472     raeburn  9909: 
                   9910: If a value has been stored in the domain's configuration db,
                   9911: it will return that, otherwise it returns 20 (for backwards 
                   9912: compatibility with domains which have not set up a configuration
1.1163    raeburn  9913: db file; the original statically defined portfolio quota was 20 MB). 
1.472     raeburn  9914: 
1.536     raeburn  9915: If the user's status includes multiple types (e.g., staff and student),
                   9916: the largest default quota which applies to the user determines the
                   9917: default quota returned.
                   9918: 
1.472     raeburn  9919: =cut
                   9920: 
                   9921: ###############################################
                   9922: 
                   9923: 
                   9924: sub default_quota {
1.1134    raeburn  9925:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  9926:     my ($defquota,$settingstatus);
                   9927:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  9928:                                             ['quotas'],$udom);
1.1134    raeburn  9929:     my $key = 'defaultquota';
                   9930:     if ($quotaname eq 'author') {
                   9931:         $key = 'authorquota';
                   9932:     }
1.622     raeburn  9933:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  9934:         if ($inststatus ne '') {
1.765     raeburn  9935:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  9936:             foreach my $item (@statuses) {
1.1134    raeburn  9937:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   9938:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  9939:                         if ($defquota eq '') {
1.1134    raeburn  9940:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  9941:                             $settingstatus = $item;
1.1134    raeburn  9942:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   9943:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  9944:                             $settingstatus = $item;
                   9945:                         }
                   9946:                     }
1.1134    raeburn  9947:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  9948:                     if ($quotahash{'quotas'}{$item} ne '') {
                   9949:                         if ($defquota eq '') {
                   9950:                             $defquota = $quotahash{'quotas'}{$item};
                   9951:                             $settingstatus = $item;
                   9952:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   9953:                             $defquota = $quotahash{'quotas'}{$item};
                   9954:                             $settingstatus = $item;
                   9955:                         }
1.536     raeburn  9956:                     }
                   9957:                 }
                   9958:             }
                   9959:         }
                   9960:         if ($defquota eq '') {
1.1134    raeburn  9961:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   9962:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   9963:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  9964:                 $defquota = $quotahash{'quotas'}{'default'};
                   9965:             }
1.536     raeburn  9966:             $settingstatus = 'default';
1.1139    raeburn  9967:             if ($defquota eq '') {
                   9968:                 if ($quotaname eq 'author') {
                   9969:                     $defquota = 500;
                   9970:                 }
                   9971:             }
1.536     raeburn  9972:         }
                   9973:     } else {
                   9974:         $settingstatus = 'default';
1.1134    raeburn  9975:         if ($quotaname eq 'author') {
                   9976:             $defquota = 500;
                   9977:         } else {
                   9978:             $defquota = 20;
                   9979:         }
1.536     raeburn  9980:     }
                   9981:     if (wantarray) {
                   9982:         return ($defquota,$settingstatus);
1.472     raeburn  9983:     } else {
1.536     raeburn  9984:         return $defquota;
1.472     raeburn  9985:     }
                   9986: }
                   9987: 
1.1135    raeburn  9988: ###############################################
                   9989: 
                   9990: =pod
                   9991: 
1.1136    raeburn  9992: =item * &excess_filesize_warning()
1.1135    raeburn  9993: 
                   9994: Returns warning message if upload of file to authoring space, or copying
1.1136    raeburn  9995: of existing file within authoring space will cause quota for the authoring
1.1146    raeburn  9996: space to be exceeded.
1.1136    raeburn  9997: 
                   9998: Same, if upload of a file directly to a course/community via Course Editor
1.1137    raeburn  9999: will cause quota for uploaded content for the course to be exceeded.
1.1135    raeburn  10000: 
1.1165    raeburn  10001: Inputs: 7 
1.1136    raeburn  10002: 1. username or coursenum
1.1135    raeburn  10003: 2. domain
1.1136    raeburn  10004: 3. context ('author' or 'course')
1.1135    raeburn  10005: 4. filename of file for which action is being requested
                   10006: 5. filesize (kB) of file
                   10007: 6. action being taken: copy or upload.
1.1237    raeburn  10008: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135    raeburn  10009: 
                   10010: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142    raeburn  10011:          otherwise return null.
                   10012: 
                   10013: =back
1.1135    raeburn  10014: 
                   10015: =cut
                   10016: 
1.1136    raeburn  10017: sub excess_filesize_warning {
1.1165    raeburn  10018:     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136    raeburn  10019:     my $current_disk_usage = 0;
1.1165    raeburn  10020:     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136    raeburn  10021:     if ($context eq 'author') {
                   10022:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   10023:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   10024:     } else {
                   10025:         foreach my $subdir ('docs','supplemental') {
                   10026:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   10027:         }
                   10028:     }
1.1135    raeburn  10029:     $disk_quota = int($disk_quota * 1000);
                   10030:     if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179    bisitz   10031:         return '<p class="LC_warning">'.
1.1135    raeburn  10032:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179    bisitz   10033:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                   10034:                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135    raeburn  10035:                             $disk_quota,$current_disk_usage).
                   10036:                '</p>';
                   10037:     }
                   10038:     return;
                   10039: }
                   10040: 
                   10041: ###############################################
                   10042: 
                   10043: 
1.1136    raeburn  10044: 
                   10045: 
1.384     raeburn  10046: sub get_secgrprole_info {
                   10047:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   10048:     my %sections_count = &get_sections($cdom,$cnum);
                   10049:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   10050:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   10051:     my @groups = sort(keys(%curr_groups));
                   10052:     my $allroles = [];
                   10053:     my $rolehash;
                   10054:     my $accesshash = {
                   10055:                      active => 'Currently has access',
                   10056:                      future => 'Will have future access',
                   10057:                      previous => 'Previously had access',
                   10058:                   };
                   10059:     if ($needroles) {
                   10060:         $rolehash = {'all' => 'all'};
1.385     albertel 10061:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   10062: 	if (&Apache::lonnet::error(%user_roles)) {
                   10063: 	    undef(%user_roles);
                   10064: 	}
                   10065:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  10066:             my ($role)=split(/\:/,$item,2);
                   10067:             if ($role eq 'cr') { next; }
                   10068:             if ($role =~ /^cr/) {
                   10069:                 $$rolehash{$role} = (split('/',$role))[3];
                   10070:             } else {
                   10071:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   10072:             }
                   10073:         }
                   10074:         foreach my $key (sort(keys(%{$rolehash}))) {
                   10075:             push(@{$allroles},$key);
                   10076:         }
                   10077:         push (@{$allroles},'st');
                   10078:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   10079:     }
                   10080:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   10081: }
                   10082: 
1.555     raeburn  10083: sub user_picker {
1.1279    raeburn  10084:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555     raeburn  10085:     my $currdom = $dom;
1.1253    raeburn  10086:     my @alldoms = &Apache::lonnet::all_domains();
                   10087:     if (@alldoms == 1) {
                   10088:         my %domsrch = &Apache::lonnet::get_dom('configuration',
                   10089:                                                ['directorysrch'],$alldoms[0]);
                   10090:         my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
                   10091:         my $showdom = $domdesc;
                   10092:         if ($showdom eq '') {
                   10093:             $showdom = $dom;
                   10094:         }
                   10095:         if (ref($domsrch{'directorysrch'}) eq 'HASH') {
                   10096:             if ((!$domsrch{'directorysrch'}{'available'}) &&
                   10097:                 ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
                   10098:                 return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
                   10099:             }
                   10100:         }
                   10101:     }
1.555     raeburn  10102:     my %curr_selected = (
                   10103:                         srchin => 'dom',
1.580     raeburn  10104:                         srchby => 'lastname',
1.555     raeburn  10105:                       );
                   10106:     my $srchterm;
1.625     raeburn  10107:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  10108:         if ($srch->{'srchby'} ne '') {
                   10109:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   10110:         }
                   10111:         if ($srch->{'srchin'} ne '') {
                   10112:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   10113:         }
                   10114:         if ($srch->{'srchtype'} ne '') {
                   10115:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   10116:         }
                   10117:         if ($srch->{'srchdomain'} ne '') {
                   10118:             $currdom = $srch->{'srchdomain'};
                   10119:         }
                   10120:         $srchterm = $srch->{'srchterm'};
                   10121:     }
1.1222    damieng  10122:     my %html_lt=&Apache::lonlocal::texthash(
1.573     raeburn  10123:                     'usr'       => 'Search criteria',
1.563     raeburn  10124:                     'doma'      => 'Domain/institution to search',
1.558     albertel 10125:                     'uname'     => 'username',
                   10126:                     'lastname'  => 'last name',
1.555     raeburn  10127:                     'lastfirst' => 'last name, first name',
1.558     albertel 10128:                     'crs'       => 'in this course',
1.576     raeburn  10129:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 10130:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  10131:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 10132:                     'exact'     => 'is',
                   10133:                     'contains'  => 'contains',
1.569     raeburn  10134:                     'begins'    => 'begins with',
1.1222    damieng  10135:                                        );
                   10136:     my %js_lt=&Apache::lonlocal::texthash(
1.571     raeburn  10137:                     'youm'      => "You must include some text to search for.",
                   10138:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   10139:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   10140:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   10141:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   10142:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   10143:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   10144:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  10145:                                        );
1.1222    damieng  10146:     &html_escape(\%html_lt);
                   10147:     &js_escape(\%js_lt);
1.1255    raeburn  10148:     my $domform;
1.1277    raeburn  10149:     my $allow_blank = 1;
1.1255    raeburn  10150:     if ($fixeddom) {
1.1277    raeburn  10151:         $allow_blank = 0;
                   10152:         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1255    raeburn  10153:     } else {
1.1287    raeburn  10154:         my $defdom = $env{'request.role.domain'};
1.1288    raeburn  10155:         my ($trusted,$untrusted);
1.1287    raeburn  10156:         if (($context eq 'requestcrs') || ($context eq 'course')) {
1.1288    raeburn  10157:             ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
1.1287    raeburn  10158:         } elsif ($context eq 'author') {
1.1288    raeburn  10159:             ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
1.1287    raeburn  10160:         } elsif ($context eq 'domain') {
1.1288    raeburn  10161:             ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
1.1287    raeburn  10162:         }
1.1288    raeburn  10163:         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
1.1255    raeburn  10164:     }
1.563     raeburn  10165:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  10166: 
                   10167:     my @srchins = ('crs','dom','alc','instd');
                   10168: 
                   10169:     foreach my $option (@srchins) {
                   10170:         # FIXME 'alc' option unavailable until 
                   10171:         #       loncreateuser::print_user_query_page()
                   10172:         #       has been completed.
                   10173:         next if ($option eq 'alc');
1.880     raeburn  10174:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  10175:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.1279    raeburn  10176:         next if (($option eq 'instd') && ($noinstd));
1.563     raeburn  10177:         if ($curr_selected{'srchin'} eq $option) {
                   10178:             $srchinsel .= ' 
1.1222    damieng  10179:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563     raeburn  10180:         } else {
                   10181:             $srchinsel .= '
1.1222    damieng  10182:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563     raeburn  10183:         }
1.555     raeburn  10184:     }
1.563     raeburn  10185:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  10186: 
                   10187:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  10188:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  10189:         if ($curr_selected{'srchby'} eq $option) {
                   10190:             $srchbysel .= '
1.1222    damieng  10191:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  10192:         } else {
                   10193:             $srchbysel .= '
1.1222    damieng  10194:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  10195:          }
                   10196:     }
                   10197:     $srchbysel .= "\n  </select>\n";
                   10198: 
                   10199:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  10200:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  10201:         if ($curr_selected{'srchtype'} eq $option) {
                   10202:             $srchtypesel .= '
1.1222    damieng  10203:    <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555     raeburn  10204:         } else {
                   10205:             $srchtypesel .= '
1.1222    damieng  10206:    <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555     raeburn  10207:         }
                   10208:     }
                   10209:     $srchtypesel .= "\n  </select>\n";
                   10210: 
1.558     albertel 10211:     my ($newuserscript,$new_user_create);
1.994     raeburn  10212:     my $context_dom = $env{'request.role.domain'};
                   10213:     if ($context eq 'requestcrs') {
                   10214:         if ($env{'form.coursedom'} ne '') { 
                   10215:             $context_dom = $env{'form.coursedom'};
                   10216:         }
                   10217:     }
1.556     raeburn  10218:     if ($forcenewuser) {
1.576     raeburn  10219:         if (ref($srch) eq 'HASH') {
1.994     raeburn  10220:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  10221:                 if ($cancreate) {
                   10222:                     $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>';
                   10223:                 } else {
1.799     bisitz   10224:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  10225:                     my %usertypetext = (
                   10226:                         official   => 'institutional',
                   10227:                         unofficial => 'non-institutional',
                   10228:                     );
1.799     bisitz   10229:                     $new_user_create = '<p class="LC_warning">'
                   10230:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   10231:                                       .' '
                   10232:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   10233:                                           ,'<a href="'.$helplink.'">','</a>')
                   10234:                                       .'</p><br />';
1.627     raeburn  10235:                 }
1.576     raeburn  10236:             }
                   10237:         }
                   10238: 
1.556     raeburn  10239:         $newuserscript = <<"ENDSCRIPT";
                   10240: 
1.570     raeburn  10241: function setSearch(createnew,callingForm) {
1.556     raeburn  10242:     if (createnew == 1) {
1.570     raeburn  10243:         for (var i=0; i<callingForm.srchby.length; i++) {
                   10244:             if (callingForm.srchby.options[i].value == 'uname') {
                   10245:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  10246:             }
                   10247:         }
1.570     raeburn  10248:         for (var i=0; i<callingForm.srchin.length; i++) {
                   10249:             if ( callingForm.srchin.options[i].value == 'dom') {
                   10250: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  10251:             }
                   10252:         }
1.570     raeburn  10253:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   10254:             if (callingForm.srchtype.options[i].value == 'exact') {
                   10255:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  10256:             }
                   10257:         }
1.570     raeburn  10258:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  10259:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  10260:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  10261:             }
                   10262:         }
                   10263:     }
                   10264: }
                   10265: ENDSCRIPT
1.558     albertel 10266: 
1.556     raeburn  10267:     }
                   10268: 
1.555     raeburn  10269:     my $output = <<"END_BLOCK";
1.556     raeburn  10270: <script type="text/javascript">
1.824     bisitz   10271: // <![CDATA[
1.570     raeburn  10272: function validateEntry(callingForm) {
1.558     albertel 10273: 
1.556     raeburn  10274:     var checkok = 1;
1.558     albertel 10275:     var srchin;
1.570     raeburn  10276:     for (var i=0; i<callingForm.srchin.length; i++) {
                   10277: 	if ( callingForm.srchin[i].checked ) {
                   10278: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 10279: 	}
                   10280:     }
                   10281: 
1.570     raeburn  10282:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   10283:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   10284:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   10285:     var srchterm =  callingForm.srchterm.value;
                   10286:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  10287:     var msg = "";
                   10288: 
                   10289:     if (srchterm == "") {
                   10290:         checkok = 0;
1.1222    damieng  10291:         msg += "$js_lt{'youm'}\\n";
1.556     raeburn  10292:     }
                   10293: 
1.569     raeburn  10294:     if (srchtype== 'begins') {
                   10295:         if (srchterm.length < 2) {
                   10296:             checkok = 0;
1.1222    damieng  10297:             msg += "$js_lt{'thte'}\\n";
1.569     raeburn  10298:         }
                   10299:     }
                   10300: 
1.556     raeburn  10301:     if (srchtype== 'contains') {
                   10302:         if (srchterm.length < 3) {
                   10303:             checkok = 0;
1.1222    damieng  10304:             msg += "$js_lt{'thet'}\\n";
1.556     raeburn  10305:         }
                   10306:     }
                   10307:     if (srchin == 'instd') {
                   10308:         if (srchdomain == '') {
                   10309:             checkok = 0;
1.1222    damieng  10310:             msg += "$js_lt{'yomc'}\\n";
1.556     raeburn  10311:         }
                   10312:     }
                   10313:     if (srchin == 'dom') {
                   10314:         if (srchdomain == '') {
                   10315:             checkok = 0;
1.1222    damieng  10316:             msg += "$js_lt{'ymcd'}\\n";
1.556     raeburn  10317:         }
                   10318:     }
                   10319:     if (srchby == 'lastfirst') {
                   10320:         if (srchterm.indexOf(",") == -1) {
                   10321:             checkok = 0;
1.1222    damieng  10322:             msg += "$js_lt{'whus'}\\n";
1.556     raeburn  10323:         }
                   10324:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   10325:             checkok = 0;
1.1222    damieng  10326:             msg += "$js_lt{'whse'}\\n";
1.556     raeburn  10327:         }
                   10328:     }
                   10329:     if (checkok == 0) {
1.1222    damieng  10330:         alert("$js_lt{'thfo'}\\n"+msg);
1.556     raeburn  10331:         return;
                   10332:     }
                   10333:     if (checkok == 1) {
1.570     raeburn  10334:         callingForm.submit();
1.556     raeburn  10335:     }
                   10336: }
                   10337: 
                   10338: $newuserscript
                   10339: 
1.824     bisitz   10340: // ]]>
1.556     raeburn  10341: </script>
1.558     albertel 10342: 
                   10343: $new_user_create
                   10344: 
1.555     raeburn  10345: END_BLOCK
1.558     albertel 10346: 
1.876     raeburn  10347:     $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222    damieng  10348:                &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876     raeburn  10349:                $domform.
                   10350:                &Apache::lonhtmlcommon::row_closure().
1.1222    damieng  10351:                &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876     raeburn  10352:                $srchbysel.
                   10353:                $srchtypesel. 
                   10354:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   10355:                $srchinsel.
                   10356:                &Apache::lonhtmlcommon::row_closure(1). 
                   10357:                &Apache::lonhtmlcommon::end_pick_box().
                   10358:                '<br />';
1.1253    raeburn  10359:     return ($output,1);
1.555     raeburn  10360: }
                   10361: 
1.612     raeburn  10362: sub user_rule_check {
1.615     raeburn  10363:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226    raeburn  10364:     my ($response,%inst_response);
1.612     raeburn  10365:     if (ref($usershash) eq 'HASH') {
1.1226    raeburn  10366:         if (keys(%{$usershash}) > 1) {
                   10367:             my (%by_username,%by_id,%userdoms);
                   10368:             my $checkid; 
                   10369:             if (ref($checks) eq 'HASH') {
                   10370:                 if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
                   10371:                     $checkid = 1;
                   10372:                 }
                   10373:             }
                   10374:             foreach my $user (keys(%{$usershash})) {
                   10375:                 my ($uname,$udom) = split(/:/,$user);
                   10376:                 if ($checkid) {
                   10377:                     if (ref($usershash->{$user}) eq 'HASH') {
                   10378:                         if ($usershash->{$user}->{'id'} ne '') {
1.1227    raeburn  10379:                             $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname; 
1.1226    raeburn  10380:                             $userdoms{$udom} = 1;
1.1227    raeburn  10381:                             if (ref($inst_results) eq 'HASH') {
                   10382:                                 $inst_results->{$uname.':'.$udom} = {};
                   10383:                             }
1.1226    raeburn  10384:                         }
                   10385:                     }
                   10386:                 } else {
                   10387:                     $by_username{$udom}{$uname} = 1;
                   10388:                     $userdoms{$udom} = 1;
1.1227    raeburn  10389:                     if (ref($inst_results) eq 'HASH') {
                   10390:                         $inst_results->{$uname.':'.$udom} = {};
                   10391:                     }
1.1226    raeburn  10392:                 }
                   10393:             }
                   10394:             foreach my $udom (keys(%userdoms)) {
                   10395:                 if (!$got_rules->{$udom}) {
                   10396:                     my %domconfig = &Apache::lonnet::get_dom('configuration',
                   10397:                                                              ['usercreation'],$udom);
                   10398:                     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   10399:                         foreach my $item ('username','id') {
                   10400:                             if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227    raeburn  10401:                                 $$curr_rules{$udom}{$item} =
                   10402:                                     $domconfig{'usercreation'}{$item.'_rule'};
1.1226    raeburn  10403:                             }
                   10404:                         }
                   10405:                     }
                   10406:                     $got_rules->{$udom} = 1;
                   10407:                 }
1.612     raeburn  10408:             }
1.1226    raeburn  10409:             if ($checkid) {
                   10410:                 foreach my $udom (keys(%by_id)) {
                   10411:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
                   10412:                     if ($outcome eq 'ok') {
1.1227    raeburn  10413:                         foreach my $id (keys(%{$by_id{$udom}})) {
                   10414:                             my $uname = $by_id{$udom}{$id};
                   10415:                             $inst_response{$uname.':'.$udom} = $outcome;
                   10416:                         }
1.1226    raeburn  10417:                         if (ref($results) eq 'HASH') {
                   10418:                             foreach my $uname (keys(%{$results})) {
1.1227    raeburn  10419:                                 if (exists($inst_response{$uname.':'.$udom})) {
                   10420:                                     $inst_response{$uname.':'.$udom} = $outcome;
                   10421:                                     $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   10422:                                 }
1.1226    raeburn  10423:                             }
                   10424:                         }
                   10425:                     }
1.612     raeburn  10426:                 }
1.615     raeburn  10427:             } else {
1.1226    raeburn  10428:                 foreach my $udom (keys(%by_username)) {
                   10429:                     my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
                   10430:                     if ($outcome eq 'ok') {
1.1227    raeburn  10431:                         foreach my $uname (keys(%{$by_username{$udom}})) {
                   10432:                             $inst_response{$uname.':'.$udom} = $outcome;
                   10433:                         }
1.1226    raeburn  10434:                         if (ref($results) eq 'HASH') {
                   10435:                             foreach my $uname (keys(%{$results})) {
                   10436:                                 $inst_results->{$uname.':'.$udom} = $results->{$uname};
                   10437:                             }
                   10438:                         }
                   10439:                     }
                   10440:                 }
1.612     raeburn  10441:             }
1.1226    raeburn  10442:         } elsif (keys(%{$usershash}) == 1) {
                   10443:             my $user = (keys(%{$usershash}))[0];
                   10444:             my ($uname,$udom) = split(/:/,$user);
                   10445:             if (($udom ne '') && ($uname ne '')) {
                   10446:                 if (ref($usershash->{$user}) eq 'HASH') {
                   10447:                     if (ref($checks) eq 'HASH') {
                   10448:                         if (defined($checks->{'username'})) {
                   10449:                             ($inst_response{$user},%{$inst_results->{$user}}) = 
                   10450:                                 &Apache::lonnet::get_instuser($udom,$uname);
                   10451:                         } elsif (defined($checks->{'id'})) {
                   10452:                             if ($usershash->{$user}->{'id'} ne '') {
                   10453:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   10454:                                     &Apache::lonnet::get_instuser($udom,undef,
                   10455:                                                                   $usershash->{$user}->{'id'});
                   10456:                             } else {
                   10457:                                 ($inst_response{$user},%{$inst_results->{$user}}) =
                   10458:                                     &Apache::lonnet::get_instuser($udom,$uname);
                   10459:                             }
1.585     raeburn  10460:                         }
1.1226    raeburn  10461:                     } else {
                   10462:                        ($inst_response{$user},%{$inst_results->{$user}}) =
                   10463:                             &Apache::lonnet::get_instuser($udom,$uname);
                   10464:                        return;
                   10465:                     }
                   10466:                     if (!$got_rules->{$udom}) {
                   10467:                         my %domconfig = &Apache::lonnet::get_dom('configuration',
                   10468:                                                                  ['usercreation'],$udom);
                   10469:                         if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   10470:                             foreach my $item ('username','id') {
                   10471:                                 if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   10472:                                    $$curr_rules{$udom}{$item} = 
                   10473:                                        $domconfig{'usercreation'}{$item.'_rule'};
                   10474:                                 }
                   10475:                             }
                   10476:                         }
                   10477:                         $got_rules->{$udom} = 1;
1.585     raeburn  10478:                     }
                   10479:                 }
1.1226    raeburn  10480:             } else {
                   10481:                 return;
                   10482:             }
                   10483:         } else {
                   10484:             return;
                   10485:         }
                   10486:         foreach my $user (keys(%{$usershash})) {
                   10487:             my ($uname,$udom) = split(/:/,$user);
                   10488:             next if (($udom eq '') || ($uname eq ''));
                   10489:             my $id;
1.1227    raeburn  10490:             if (ref($inst_results) eq 'HASH') {
                   10491:                 if (ref($inst_results->{$user}) eq 'HASH') {
                   10492:                     $id = $inst_results->{$user}->{'id'};
                   10493:                 }
                   10494:             }
                   10495:             if ($id eq '') { 
                   10496:                 if (ref($usershash->{$user})) {
                   10497:                     $id = $usershash->{$user}->{'id'};
                   10498:                 }
1.585     raeburn  10499:             }
1.612     raeburn  10500:             foreach my $item (keys(%{$checks})) {
                   10501:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   10502:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   10503:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226    raeburn  10504:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
                   10505:                                                                              $$curr_rules{$udom}{$item});
1.612     raeburn  10506:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   10507:                                 if ($rule_check{$rule}) {
                   10508:                                     $$rulematch{$user}{$item} = $rule;
1.1226    raeburn  10509:                                     if ($inst_response{$user} eq 'ok') {
1.615     raeburn  10510:                                         if (ref($inst_results) eq 'HASH') {
                   10511:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   10512:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   10513:                                                     $$alerts{$item}{$udom}{$uname} = 1;
1.1227    raeburn  10514:                                                 } elsif ($item eq 'id') {
                   10515:                                                     if ($inst_results->{$user}->{'id'} eq '') {
                   10516:                                                         $$alerts{$item}{$udom}{$uname} = 1;
                   10517:                                                     }
1.615     raeburn  10518:                                                 }
1.612     raeburn  10519:                                             }
                   10520:                                         }
1.615     raeburn  10521:                                     }
                   10522:                                     last;
1.585     raeburn  10523:                                 }
                   10524:                             }
                   10525:                         }
                   10526:                     }
                   10527:                 }
                   10528:             }
                   10529:         }
                   10530:     }
1.612     raeburn  10531:     return;
                   10532: }
                   10533: 
                   10534: sub user_rule_formats {
                   10535:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   10536:     my %text = ( 
                   10537:                  'username' => 'Usernames',
                   10538:                  'id'       => 'IDs',
                   10539:                );
                   10540:     my $output;
                   10541:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   10542:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   10543:         if (@{$ruleorder} > 0) {
1.1102    raeburn  10544:             $output = '<br />'.
                   10545:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   10546:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   10547:                       ' <ul>';
1.612     raeburn  10548:             foreach my $rule (@{$ruleorder}) {
                   10549:                 if (ref($curr_rules) eq 'ARRAY') {
                   10550:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   10551:                         if (ref($rules->{$rule}) eq 'HASH') {
                   10552:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   10553:                                         $rules->{$rule}{'desc'}.'</li>';
                   10554:                         }
                   10555:                     }
                   10556:                 }
                   10557:             }
                   10558:             $output .= '</ul>';
                   10559:         }
                   10560:     }
                   10561:     return $output;
                   10562: }
                   10563: 
                   10564: sub instrule_disallow_msg {
1.615     raeburn  10565:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  10566:     my $response;
                   10567:     my %text = (
                   10568:                   item   => 'username',
                   10569:                   items  => 'usernames',
                   10570:                   match  => 'matches',
                   10571:                   do     => 'does',
                   10572:                   action => 'a username',
                   10573:                   one    => 'one',
                   10574:                );
                   10575:     if ($count > 1) {
                   10576:         $text{'item'} = 'usernames';
                   10577:         $text{'match'} ='match';
                   10578:         $text{'do'} = 'do';
                   10579:         $text{'action'} = 'usernames',
                   10580:         $text{'one'} = 'ones';
                   10581:     }
                   10582:     if ($checkitem eq 'id') {
                   10583:         $text{'items'} = 'IDs';
                   10584:         $text{'item'} = 'ID';
                   10585:         $text{'action'} = 'an ID';
1.615     raeburn  10586:         if ($count > 1) {
                   10587:             $text{'item'} = 'IDs';
                   10588:             $text{'action'} = 'IDs';
                   10589:         }
1.612     raeburn  10590:     }
1.674     bisitz   10591:     $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  10592:     if ($mode eq 'upload') {
                   10593:         if ($checkitem eq 'username') {
                   10594:             $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'}.");
                   10595:         } elsif ($checkitem eq 'id') {
1.674     bisitz   10596:             $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  10597:         }
1.669     raeburn  10598:     } elsif ($mode eq 'selfcreate') {
                   10599:         if ($checkitem eq 'id') {
                   10600:             $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.");
                   10601:         }
1.615     raeburn  10602:     } else {
                   10603:         if ($checkitem eq 'username') {
                   10604:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   10605:         } elsif ($checkitem eq 'id') {
                   10606:             $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.");
                   10607:         }
1.612     raeburn  10608:     }
                   10609:     return $response;
1.585     raeburn  10610: }
                   10611: 
1.624     raeburn  10612: sub personal_data_fieldtitles {
                   10613:     my %fieldtitles = &Apache::lonlocal::texthash (
                   10614:                         id => 'Student/Employee ID',
                   10615:                         permanentemail => 'E-mail address',
                   10616:                         lastname => 'Last Name',
                   10617:                         firstname => 'First Name',
                   10618:                         middlename => 'Middle Name',
                   10619:                         generation => 'Generation',
                   10620:                         gen => 'Generation',
1.765     raeburn  10621:                         inststatus => 'Affiliation',
1.624     raeburn  10622:                    );
                   10623:     return %fieldtitles;
                   10624: }
                   10625: 
1.642     raeburn  10626: sub sorted_inst_types {
                   10627:     my ($dom) = @_;
1.1185    raeburn  10628:     my ($usertypes,$order);
                   10629:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   10630:     if (ref($domdefaults{'inststatus'}) eq 'HASH') {
                   10631:         $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
                   10632:         $order = $domdefaults{'inststatus'}{'inststatusorder'};
                   10633:     } else {
                   10634:         ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   10635:     }
1.642     raeburn  10636:     my $othertitle = &mt('All users');
                   10637:     if ($env{'request.course.id'}) {
1.668     raeburn  10638:         $othertitle  = &mt('Any users');
1.642     raeburn  10639:     }
                   10640:     my @types;
                   10641:     if (ref($order) eq 'ARRAY') {
                   10642:         @types = @{$order};
                   10643:     }
                   10644:     if (@types == 0) {
                   10645:         if (ref($usertypes) eq 'HASH') {
                   10646:             @types = sort(keys(%{$usertypes}));
                   10647:         }
                   10648:     }
                   10649:     if (keys(%{$usertypes}) > 0) {
                   10650:         $othertitle = &mt('Other users');
                   10651:     }
                   10652:     return ($othertitle,$usertypes,\@types);
                   10653: }
                   10654: 
1.645     raeburn  10655: sub get_institutional_codes {
                   10656:     my ($settings,$allcourses,$LC_code) = @_;
                   10657: # Get complete list of course sections to update
                   10658:     my @currsections = ();
                   10659:     my @currxlists = ();
                   10660:     my $coursecode = $$settings{'internal.coursecode'};
                   10661: 
                   10662:     if ($$settings{'internal.sectionnums'} ne '') {
                   10663:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   10664:     }
                   10665: 
                   10666:     if ($$settings{'internal.crosslistings'} ne '') {
                   10667:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   10668:     }
                   10669: 
                   10670:     if (@currxlists > 0) {
                   10671:         foreach (@currxlists) {
                   10672:             if (m/^([^:]+):(\w*)$/) {
                   10673:                 unless (grep/^$1$/,@{$allcourses}) {
1.1263    raeburn  10674:                     push(@{$allcourses},$1);
1.645     raeburn  10675:                     $$LC_code{$1} = $2;
                   10676:                 }
                   10677:             }
                   10678:         }
                   10679:     }
                   10680:  
                   10681:     if (@currsections > 0) {
                   10682:         foreach (@currsections) {
                   10683:             if (m/^(\w+):(\w*)$/) {
                   10684:                 my $sec = $coursecode.$1;
                   10685:                 my $lc_sec = $2;
                   10686:                 unless (grep/^$sec$/,@{$allcourses}) {
1.1263    raeburn  10687:                     push(@{$allcourses},$sec);
1.645     raeburn  10688:                     $$LC_code{$sec} = $lc_sec;
                   10689:                 }
                   10690:             }
                   10691:         }
                   10692:     }
                   10693:     return;
                   10694: }
                   10695: 
1.971     raeburn  10696: sub get_standard_codeitems {
                   10697:     return ('Year','Semester','Department','Number','Section');
                   10698: }
                   10699: 
1.112     bowersj2 10700: =pod
                   10701: 
1.780     raeburn  10702: =head1 Slot Helpers
                   10703: 
                   10704: =over 4
                   10705: 
                   10706: =item * sorted_slots()
                   10707: 
1.1040    raeburn  10708: Sorts an array of slot names in order of an optional sort key,
                   10709: default sort is by slot start time (earliest first). 
1.780     raeburn  10710: 
                   10711: Inputs:
                   10712: 
                   10713: =over 4
                   10714: 
                   10715: slotsarr  - Reference to array of unsorted slot names.
                   10716: 
                   10717: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   10718: 
1.1040    raeburn  10719: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   10720: 
1.549     albertel 10721: =back
                   10722: 
1.780     raeburn  10723: Returns:
                   10724: 
                   10725: =over 4
                   10726: 
1.1040    raeburn  10727: sorted   - An array of slot names sorted by a specified sort key 
                   10728:            (default sort key is start time of the slot).
1.780     raeburn  10729: 
                   10730: =back
                   10731: 
                   10732: =cut
                   10733: 
                   10734: 
                   10735: sub sorted_slots {
1.1040    raeburn  10736:     my ($slotsarr,$slots,$sortkey) = @_;
                   10737:     if ($sortkey eq '') {
                   10738:         $sortkey = 'starttime';
                   10739:     }
1.780     raeburn  10740:     my @sorted;
                   10741:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   10742:         @sorted =
                   10743:             sort {
                   10744:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  10745:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  10746:                      }
                   10747:                      if (ref($slots->{$a})) { return -1;}
                   10748:                      if (ref($slots->{$b})) { return 1;}
                   10749:                      return 0;
                   10750:                  } @{$slotsarr};
                   10751:     }
                   10752:     return @sorted;
                   10753: }
                   10754: 
1.1040    raeburn  10755: =pod
                   10756: 
                   10757: =item * get_future_slots()
                   10758: 
                   10759: Inputs:
                   10760: 
                   10761: =over 4
                   10762: 
                   10763: cnum - course number
                   10764: 
                   10765: cdom - course domain
                   10766: 
                   10767: now - current UNIX time
                   10768: 
                   10769: symb - optional symb
                   10770: 
                   10771: =back
                   10772: 
                   10773: Returns:
                   10774: 
                   10775: =over 4
                   10776: 
                   10777: sorted_reservable - ref to array of student_schedulable slots currently 
                   10778:                     reservable, ordered by end date of reservation period.
                   10779: 
                   10780: reservable_now - ref to hash of student_schedulable slots currently
                   10781:                  reservable.
                   10782: 
                   10783:     Keys in inner hash are:
                   10784:     (a) symb: either blank or symb to which slot use is restricted.
1.1250    raeburn  10785:     (b) endreserve: end date of reservation period.
                   10786:     (c) uniqueperiod: start,end dates when slot is to be uniquely
                   10787:         selected.
1.1040    raeburn  10788: 
                   10789: sorted_future - ref to array of student_schedulable slots reservable in
                   10790:                 the future, ordered by start date of reservation period.
                   10791: 
                   10792: future_reservable - ref to hash of student_schedulable slots reservable
                   10793:                     in the future.
                   10794: 
                   10795:     Keys in inner hash are:
                   10796:     (a) symb: either blank or symb to which slot use is restricted.
1.1250    raeburn  10797:     (b) startreserve: start date of reservation period.
                   10798:     (c) uniqueperiod: start,end dates when slot is to be uniquely
                   10799:         selected.
1.1040    raeburn  10800: 
                   10801: =back
                   10802: 
                   10803: =cut
                   10804: 
                   10805: sub get_future_slots {
                   10806:     my ($cnum,$cdom,$now,$symb) = @_;
1.1229    raeburn  10807:     my $map;
                   10808:     if ($symb) {
                   10809:         ($map) = &Apache::lonnet::decode_symb($symb);
                   10810:     }
1.1040    raeburn  10811:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   10812:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   10813:     foreach my $slot (keys(%slots)) {
                   10814:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   10815:         if ($symb) {
1.1229    raeburn  10816:             if ($slots{$slot}->{'symb'} ne '') {
                   10817:                 my $canuse;
                   10818:                 my %oksymbs;
                   10819:                 my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
                   10820:                 map { $oksymbs{$_} = 1; } @slotsymbs;
                   10821:                 if ($oksymbs{$symb}) {
                   10822:                     $canuse = 1;
                   10823:                 } else {
                   10824:                     foreach my $item (@slotsymbs) {
                   10825:                         if ($item =~ /\.(page|sequence)$/) {
                   10826:                             (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
                   10827:                             if (($map ne '') && ($map eq $sloturl)) {
                   10828:                                 $canuse = 1;
                   10829:                                 last;
                   10830:                             }
                   10831:                         }
                   10832:                     }
                   10833:                 }
                   10834:                 next unless ($canuse);
                   10835:             }
1.1040    raeburn  10836:         }
                   10837:         if (($slots{$slot}->{'starttime'} > $now) &&
                   10838:             ($slots{$slot}->{'endtime'} > $now)) {
                   10839:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   10840:                 my $userallowed = 0;
                   10841:                 if ($slots{$slot}->{'allowedsections'}) {
                   10842:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   10843:                     if (!defined($env{'request.role.sec'})
                   10844:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   10845:                         $userallowed=1;
                   10846:                     } else {
                   10847:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   10848:                             $userallowed=1;
                   10849:                         }
                   10850:                     }
                   10851:                     unless ($userallowed) {
                   10852:                         if (defined($env{'request.course.groups'})) {
                   10853:                             my @groups = split(/:/,$env{'request.course.groups'});
                   10854:                             foreach my $group (@groups) {
                   10855:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   10856:                                     $userallowed=1;
                   10857:                                     last;
                   10858:                                 }
                   10859:                             }
                   10860:                         }
                   10861:                     }
                   10862:                 }
                   10863:                 if ($slots{$slot}->{'allowedusers'}) {
                   10864:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   10865:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   10866:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   10867:                         $userallowed = 1;
                   10868:                     }
                   10869:                 }
                   10870:                 next unless($userallowed);
                   10871:             }
                   10872:             my $startreserve = $slots{$slot}->{'startreserve'};
                   10873:             my $endreserve = $slots{$slot}->{'endreserve'};
                   10874:             my $symb = $slots{$slot}->{'symb'};
1.1250    raeburn  10875:             my $uniqueperiod;
                   10876:             if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
                   10877:                 $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
                   10878:             }
1.1040    raeburn  10879:             if (($startreserve < $now) &&
                   10880:                 (!$endreserve || $endreserve > $now)) {
                   10881:                 my $lastres = $endreserve;
                   10882:                 if (!$lastres) {
                   10883:                     $lastres = $slots{$slot}->{'starttime'};
                   10884:                 }
                   10885:                 $reservable_now{$slot} = {
                   10886:                                            symb       => $symb,
1.1250    raeburn  10887:                                            endreserve => $lastres,
                   10888:                                            uniqueperiod => $uniqueperiod,
1.1040    raeburn  10889:                                          };
                   10890:             } elsif (($startreserve > $now) &&
                   10891:                      (!$endreserve || $endreserve > $startreserve)) {
                   10892:                 $future_reservable{$slot} = {
                   10893:                                               symb         => $symb,
1.1250    raeburn  10894:                                               startreserve => $startreserve,
                   10895:                                               uniqueperiod => $uniqueperiod,
1.1040    raeburn  10896:                                             };
                   10897:             }
                   10898:         }
                   10899:     }
                   10900:     my @unsorted_reservable = keys(%reservable_now);
                   10901:     if (@unsorted_reservable > 0) {
                   10902:         @sorted_reservable = 
                   10903:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   10904:     }
                   10905:     my @unsorted_future = keys(%future_reservable);
                   10906:     if (@unsorted_future > 0) {
                   10907:         @sorted_future =
                   10908:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   10909:     }
                   10910:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   10911: }
1.780     raeburn  10912: 
                   10913: =pod
                   10914: 
1.1057    foxr     10915: =back
                   10916: 
1.549     albertel 10917: =head1 HTTP Helpers
                   10918: 
                   10919: =over 4
                   10920: 
1.648     raeburn  10921: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 10922: 
1.258     albertel 10923: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 10924: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 10925: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 10926: 
                   10927: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   10928: $possible_names is an ref to an array of form element names.  As an example:
                   10929: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 10930: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 10931: 
                   10932: =cut
1.1       albertel 10933: 
1.6       albertel 10934: sub get_unprocessed_cgi {
1.25      albertel 10935:   my ($query,$possible_names)= @_;
1.26      matthew  10936:   # $Apache::lonxml::debug=1;
1.356     albertel 10937:   foreach my $pair (split(/&/,$query)) {
                   10938:     my ($name, $value) = split(/=/,$pair);
1.369     www      10939:     $name = &unescape($name);
1.25      albertel 10940:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   10941:       $value =~ tr/+/ /;
                   10942:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 10943:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 10944:     }
1.16      harris41 10945:   }
1.6       albertel 10946: }
                   10947: 
1.112     bowersj2 10948: =pod
                   10949: 
1.648     raeburn  10950: =item * &cacheheader() 
1.112     bowersj2 10951: 
                   10952: returns cache-controlling header code
                   10953: 
                   10954: =cut
                   10955: 
1.7       albertel 10956: sub cacheheader {
1.258     albertel 10957:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 10958:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   10959:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 10960:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   10961:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 10962:     return $output;
1.7       albertel 10963: }
                   10964: 
1.112     bowersj2 10965: =pod
                   10966: 
1.648     raeburn  10967: =item * &no_cache($r) 
1.112     bowersj2 10968: 
                   10969: specifies header code to not have cache
                   10970: 
                   10971: =cut
                   10972: 
1.9       albertel 10973: sub no_cache {
1.216     albertel 10974:     my ($r) = @_;
                   10975:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 10976: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 10977:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   10978:     $r->no_cache(1);
                   10979:     $r->header_out("Expires" => $date);
                   10980:     $r->header_out("Pragma" => "no-cache");
1.123     www      10981: }
                   10982: 
                   10983: sub content_type {
1.181     albertel 10984:     my ($r,$type,$charset) = @_;
1.299     foxr     10985:     if ($r) {
                   10986: 	#  Note that printout.pl calls this with undef for $r.
                   10987: 	&no_cache($r);
                   10988:     }
1.258     albertel 10989:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 10990:     unless ($charset) {
                   10991: 	$charset=&Apache::lonlocal::current_encoding;
                   10992:     }
                   10993:     if ($charset) { $type.='; charset='.$charset; }
                   10994:     if ($r) {
                   10995: 	$r->content_type($type);
                   10996:     } else {
                   10997: 	print("Content-type: $type\n\n");
                   10998:     }
1.9       albertel 10999: }
1.25      albertel 11000: 
1.112     bowersj2 11001: =pod
                   11002: 
1.648     raeburn  11003: =item * &add_to_env($name,$value) 
1.112     bowersj2 11004: 
1.258     albertel 11005: adds $name to the %env hash with value
1.112     bowersj2 11006: $value, if $name already exists, the entry is converted to an array
                   11007: reference and $value is added to the array.
                   11008: 
                   11009: =cut
                   11010: 
1.25      albertel 11011: sub add_to_env {
                   11012:   my ($name,$value)=@_;
1.258     albertel 11013:   if (defined($env{$name})) {
                   11014:     if (ref($env{$name})) {
1.25      albertel 11015:       #already have multiple values
1.258     albertel 11016:       push(@{ $env{$name} },$value);
1.25      albertel 11017:     } else {
                   11018:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 11019:       my $first=$env{$name};
                   11020:       undef($env{$name});
                   11021:       push(@{ $env{$name} },$first,$value);
1.25      albertel 11022:     }
                   11023:   } else {
1.258     albertel 11024:     $env{$name}=$value;
1.25      albertel 11025:   }
1.31      albertel 11026: }
1.149     albertel 11027: 
                   11028: =pod
                   11029: 
1.648     raeburn  11030: =item * &get_env_multiple($name) 
1.149     albertel 11031: 
1.258     albertel 11032: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 11033: values may be defined and end up as an array ref.
                   11034: 
                   11035: returns an array of values
                   11036: 
                   11037: =cut
                   11038: 
                   11039: sub get_env_multiple {
                   11040:     my ($name) = @_;
                   11041:     my @values;
1.258     albertel 11042:     if (defined($env{$name})) {
1.149     albertel 11043:         # exists is it an array
1.258     albertel 11044:         if (ref($env{$name})) {
                   11045:             @values=@{ $env{$name} };
1.149     albertel 11046:         } else {
1.258     albertel 11047:             $values[0]=$env{$name};
1.149     albertel 11048:         }
                   11049:     }
                   11050:     return(@values);
                   11051: }
                   11052: 
1.1249    damieng  11053: # Looks at given dependencies, and returns something depending on the context.
                   11054: # For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
                   11055: # For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
                   11056: # For all other contexts, returns ($output, $counter, $numpathchg).
                   11057: # $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
                   11058: # $counter: integer with the number of existing dependencies when no HTML output is returned, and the number of missing dependencies when an HTML output is returned.
                   11059: # $numpathchg: integer with the number of cleaned up dependency paths.
                   11060: # \%existing: hash reference clean path -> 1 only for existing dependencies.
                   11061: # \%mapping: hash reference clean path -> original path for all dependencies.
                   11062: # @param {string} actionurl - The path to the handler, indicative of the context.
                   11063: # @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
                   11064: # @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
                   11065: # @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
                   11066: # @param {hash reference} args - More parameters ! Possible keys: error_on_invalid_names (boolean), ignore_remote_references (boolean), current_path (string), docs_url (string), docs_title (string), context (string)
                   11067: # @return {Array} - array depending on the context (not a reference)
1.660     raeburn  11068: sub ask_for_embedded_content {
1.1249    damieng  11069:     # NOTE: documentation was added afterwards, it could be wrong
1.660     raeburn  11070:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  11071:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085    raeburn  11072:         %currsubfile,%unused,$rem);
1.1071    raeburn  11073:     my $counter = 0;
                   11074:     my $numnew = 0;
1.987     raeburn  11075:     my $numremref = 0;
                   11076:     my $numinvalid = 0;
                   11077:     my $numpathchg = 0;
                   11078:     my $numexisting = 0;
1.1071    raeburn  11079:     my $numunused = 0;
                   11080:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156    raeburn  11081:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  11082:     my $heading = &mt('Upload embedded files');
                   11083:     my $buttontext = &mt('Upload');
                   11084: 
1.1249    damieng  11085:     # fills these variables based on the context:
                   11086:     # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
                   11087:     # $path, $fileloc, $title, $rem, $filename
1.1085    raeburn  11088:     if ($env{'request.course.id'}) {
1.1123    raeburn  11089:         if ($actionurl eq '/adm/dependencies') {
                   11090:             $navmap = Apache::lonnavmaps::navmap->new();
                   11091:         }
                   11092:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   11093:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085    raeburn  11094:     }
1.1123    raeburn  11095:     if (($actionurl eq '/adm/portfolio') || 
                   11096:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  11097:         my $current_path='/';
                   11098:         if ($env{'form.currentpath'}) {
                   11099:             $current_path = $env{'form.currentpath'};
                   11100:         }
                   11101:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123    raeburn  11102:             $udom = $cdom;
                   11103:             $uname = $cnum;
1.984     raeburn  11104:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   11105:         } else {
                   11106:             $udom = $env{'user.domain'};
                   11107:             $uname = $env{'user.name'};
                   11108:             $url = '/userfiles/portfolio';
                   11109:         }
1.987     raeburn  11110:         $toplevel = $url.'/';
1.984     raeburn  11111:         $url .= $current_path;
                   11112:         $getpropath = 1;
1.987     raeburn  11113:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   11114:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      11115:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  11116:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  11117:         $toplevel = $url;
1.984     raeburn  11118:         if ($rest ne '') {
1.987     raeburn  11119:             $url .= $rest;
                   11120:         }
                   11121:     } elsif ($actionurl eq '/adm/coursedocs') {
                   11122:         if (ref($args) eq 'HASH') {
1.1071    raeburn  11123:             $url = $args->{'docs_url'};
                   11124:             $toplevel = $url;
1.1084    raeburn  11125:             if ($args->{'context'} eq 'paste') {
                   11126:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   11127:                 ($path) = 
                   11128:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   11129:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   11130:                 $fileloc =~ s{^/}{};
                   11131:             }
1.1071    raeburn  11132:         }
1.1084    raeburn  11133:     } elsif ($actionurl eq '/adm/dependencies')  {
1.1071    raeburn  11134:         if ($env{'request.course.id'} ne '') {
                   11135:             if (ref($args) eq 'HASH') {
                   11136:                 $url = $args->{'docs_url'};
                   11137:                 $title = $args->{'docs_title'};
1.1126    raeburn  11138:                 $toplevel = $url; 
                   11139:                 unless ($toplevel =~ m{^/}) {
                   11140:                     $toplevel = "/$url";
                   11141:                 }
1.1085    raeburn  11142:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126    raeburn  11143:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   11144:                     $path = $1;
                   11145:                 } else {
                   11146:                     ($path) =
                   11147:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   11148:                 }
1.1195    raeburn  11149:                 if ($toplevel=~/^\/*(uploaded|editupload)/) {
                   11150:                     $fileloc = $toplevel;
                   11151:                     $fileloc=~ s/^\s*(\S+)\s*$/$1/;
                   11152:                     my ($udom,$uname,$fname) =
                   11153:                         ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
                   11154:                     $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
                   11155:                 } else {
                   11156:                     $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   11157:                 }
1.1071    raeburn  11158:                 $fileloc =~ s{^/}{};
                   11159:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   11160:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   11161:             }
1.987     raeburn  11162:         }
1.1123    raeburn  11163:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   11164:         $udom = $cdom;
                   11165:         $uname = $cnum;
                   11166:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   11167:         $toplevel = $url;
                   11168:         $path = $url;
                   11169:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   11170:         $fileloc =~ s{^/}{};
1.987     raeburn  11171:     }
1.1249    damieng  11172:     
                   11173:     # parses the dependency paths to get some info
                   11174:     # fills $newfiles, $mapping, $subdependencies, $dependencies
                   11175:     # $newfiles: hash URL -> 1 for new files or external URLs
                   11176:     # (will be completed later)
                   11177:     # $mapping:
                   11178:     #   for external URLs: external URL -> external URL
                   11179:     #   for relative paths: clean path -> original path
                   11180:     # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
                   11181:     # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
1.1126    raeburn  11182:     foreach my $file (keys(%{$allfiles})) {
                   11183:         my $embed_file;
                   11184:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   11185:             $embed_file = $1;
                   11186:         } else {
                   11187:             $embed_file = $file;
                   11188:         }
1.1158    raeburn  11189:         my ($absolutepath,$cleaned_file);
                   11190:         if ($embed_file =~ m{^\w+://}) {
                   11191:             $cleaned_file = $embed_file;
1.1147    raeburn  11192:             $newfiles{$cleaned_file} = 1;
                   11193:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  11194:         } else {
1.1158    raeburn  11195:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  11196:             if ($embed_file =~ m{^/}) {
                   11197:                 $absolutepath = $embed_file;
                   11198:             }
1.1147    raeburn  11199:             if ($cleaned_file =~ m{/}) {
                   11200:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  11201:                 $path = &check_for_traversal($path,$url,$toplevel);
                   11202:                 my $item = $fname;
                   11203:                 if ($path ne '') {
                   11204:                     $item = $path.'/'.$fname;
                   11205:                     $subdependencies{$path}{$fname} = 1;
                   11206:                 } else {
                   11207:                     $dependencies{$item} = 1;
                   11208:                 }
                   11209:                 if ($absolutepath) {
                   11210:                     $mapping{$item} = $absolutepath;
                   11211:                 } else {
                   11212:                     $mapping{$item} = $embed_file;
                   11213:                 }
                   11214:             } else {
                   11215:                 $dependencies{$embed_file} = 1;
                   11216:                 if ($absolutepath) {
1.1147    raeburn  11217:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  11218:                 } else {
1.1147    raeburn  11219:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  11220:                 }
                   11221:             }
1.984     raeburn  11222:         }
                   11223:     }
1.1249    damieng  11224:     
                   11225:     # looks for all existing files in dependency subdirectories (from $subdependencies filled above)
                   11226:     # and lists
                   11227:     # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
                   11228:     # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
                   11229:     # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
                   11230:     #                                    the path had to be cleaned up
                   11231:     # $existing: hash clean path -> 1 if the file exists
                   11232:     # $numexisting: number of keys in $existing
                   11233:     # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
                   11234:     # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
                   11235:     #                                      dependency subdirectories that are
                   11236:     #                                      not listed as dependencies, with some exceptions using $rem
1.1071    raeburn  11237:     my $dirptr = 16384;
1.984     raeburn  11238:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  11239:         $currsubfile{$path} = {};
1.1123    raeburn  11240:         if (($actionurl eq '/adm/portfolio') || 
                   11241:             ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  11242:             my ($sublistref,$listerror) =
                   11243:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   11244:             if (ref($sublistref) eq 'ARRAY') {
                   11245:                 foreach my $line (@{$sublistref}) {
                   11246:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  11247:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  11248:                 }
1.984     raeburn  11249:             }
1.987     raeburn  11250:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  11251:             if (opendir(my $dir,$url.'/'.$path)) {
                   11252:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  11253:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   11254:             }
1.1084    raeburn  11255:         } elsif (($actionurl eq '/adm/dependencies') ||
                   11256:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  11257:                   ($args->{'context'} eq 'paste')) ||
                   11258:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  11259:             if ($env{'request.course.id'} ne '') {
1.1123    raeburn  11260:                 my $dir;
                   11261:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   11262:                     $dir = $fileloc;
                   11263:                 } else {
                   11264:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   11265:                 }
1.1071    raeburn  11266:                 if ($dir ne '') {
                   11267:                     my ($sublistref,$listerror) =
                   11268:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   11269:                     if (ref($sublistref) eq 'ARRAY') {
                   11270:                         foreach my $line (@{$sublistref}) {
                   11271:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   11272:                                 undef,$mtime)=split(/\&/,$line,12);
                   11273:                             unless (($testdir&$dirptr) ||
                   11274:                                     ($file_name =~ /^\.\.?$/)) {
                   11275:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   11276:                             }
                   11277:                         }
                   11278:                     }
                   11279:                 }
1.984     raeburn  11280:             }
                   11281:         }
                   11282:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  11283:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  11284:                 my $item = $path.'/'.$file;
                   11285:                 unless ($mapping{$item} eq $item) {
                   11286:                     $pathchanges{$item} = 1;
                   11287:                 }
                   11288:                 $existing{$item} = 1;
                   11289:                 $numexisting ++;
                   11290:             } else {
                   11291:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  11292:             }
                   11293:         }
1.1071    raeburn  11294:         if ($actionurl eq '/adm/dependencies') {
                   11295:             foreach my $path (keys(%currsubfile)) {
                   11296:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   11297:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   11298:                          unless ($subdependencies{$path}{$file}) {
1.1085    raeburn  11299:                              next if (($rem ne '') &&
                   11300:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   11301:                                        (ref($navmap) &&
                   11302:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   11303:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   11304:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  11305:                              $unused{$path.'/'.$file} = 1; 
                   11306:                          }
                   11307:                     }
                   11308:                 }
                   11309:             }
                   11310:         }
1.984     raeburn  11311:     }
1.1249    damieng  11312:     
                   11313:     # fills $currfile, hash file name -> 1 or [$size,$mtime]
                   11314:     # for files in $url or $fileloc (target directory) in some contexts
1.987     raeburn  11315:     my %currfile;
1.1123    raeburn  11316:     if (($actionurl eq '/adm/portfolio') ||
                   11317:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  11318:         my ($dirlistref,$listerror) =
                   11319:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   11320:         if (ref($dirlistref) eq 'ARRAY') {
                   11321:             foreach my $line (@{$dirlistref}) {
                   11322:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   11323:                 $currfile{$file_name} = 1;
                   11324:             }
1.984     raeburn  11325:         }
1.987     raeburn  11326:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  11327:         if (opendir(my $dir,$url)) {
1.987     raeburn  11328:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  11329:             map {$currfile{$_} = 1;} @dir_list;
                   11330:         }
1.1084    raeburn  11331:     } elsif (($actionurl eq '/adm/dependencies') ||
                   11332:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  11333:               ($args->{'context'} eq 'paste')) ||
                   11334:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  11335:         if ($env{'request.course.id'} ne '') {
                   11336:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   11337:             if ($dir ne '') {
                   11338:                 my ($dirlistref,$listerror) =
                   11339:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   11340:                 if (ref($dirlistref) eq 'ARRAY') {
                   11341:                     foreach my $line (@{$dirlistref}) {
                   11342:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   11343:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   11344:                         unless (($testdir&$dirptr) ||
                   11345:                                 ($file_name =~ /^\.\.?$/)) {
                   11346:                             $currfile{$file_name} = [$size,$mtime];
                   11347:                         }
                   11348:                     }
                   11349:                 }
                   11350:             }
                   11351:         }
1.984     raeburn  11352:     }
1.1249    damieng  11353:     # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
                   11354:     # are not in subdirectories, using $currfile
1.984     raeburn  11355:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  11356:         if (exists($currfile{$file})) {
1.987     raeburn  11357:             unless ($mapping{$file} eq $file) {
                   11358:                 $pathchanges{$file} = 1;
                   11359:             }
                   11360:             $existing{$file} = 1;
                   11361:             $numexisting ++;
                   11362:         } else {
1.984     raeburn  11363:             $newfiles{$file} = 1;
                   11364:         }
                   11365:     }
1.1071    raeburn  11366:     foreach my $file (keys(%currfile)) {
                   11367:         unless (($file eq $filename) ||
                   11368:                 ($file eq $filename.'.bak') ||
                   11369:                 ($dependencies{$file})) {
1.1085    raeburn  11370:             if ($actionurl eq '/adm/dependencies') {
1.1126    raeburn  11371:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   11372:                     next if (($rem ne '') &&
                   11373:                              (($env{"httpref.$rem".$file} ne '') ||
                   11374:                               (ref($navmap) &&
                   11375:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   11376:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   11377:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   11378:                 }
1.1085    raeburn  11379:             }
1.1071    raeburn  11380:             $unused{$file} = 1;
                   11381:         }
                   11382:     }
1.1249    damieng  11383:     
                   11384:     # returns some results for coursedocs paste and syllabus rewrites ($output is undef)
1.1084    raeburn  11385:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   11386:         ($args->{'context'} eq 'paste')) {
                   11387:         $counter = scalar(keys(%existing));
                   11388:         $numpathchg = scalar(keys(%pathchanges));
1.1123    raeburn  11389:         return ($output,$counter,$numpathchg,\%existing);
                   11390:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && 
                   11391:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   11392:         $counter = scalar(keys(%existing));
                   11393:         $numpathchg = scalar(keys(%pathchanges));
                   11394:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084    raeburn  11395:     }
1.1249    damieng  11396:     
                   11397:     # returns HTML otherwise, with dependency results and to ask for more uploads
                   11398:     
                   11399:     # $upload_output: missing dependencies (with upload form)
                   11400:     # $modify_output: uploaded dependencies (in use)
                   11401:     # $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
1.984     raeburn  11402:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  11403:         if ($actionurl eq '/adm/dependencies') {
                   11404:             next if ($embed_file =~ m{^\w+://});
                   11405:         }
1.660     raeburn  11406:         $upload_output .= &start_data_table_row().
1.1123    raeburn  11407:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  11408:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  11409:         unless ($mapping{$embed_file} eq $embed_file) {
1.1123    raeburn  11410:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   11411:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  11412:         }
1.1123    raeburn  11413:         $upload_output .= '</td>';
1.1071    raeburn  11414:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1123    raeburn  11415:             $upload_output.='<td align="right">'.
                   11416:                             '<span class="LC_info LC_fontsize_medium">'.
                   11417:                             &mt("URL points to web address").'</span>';
1.987     raeburn  11418:             $numremref++;
1.660     raeburn  11419:         } elsif ($args->{'error_on_invalid_names'}
                   11420:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123    raeburn  11421:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   11422:                             &mt('Invalid characters').'</span>';
1.987     raeburn  11423:             $numinvalid++;
1.660     raeburn  11424:         } else {
1.1123    raeburn  11425:             $upload_output .= '<td>'.
                   11426:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  11427:                                                      $embed_file,\%mapping,
1.1071    raeburn  11428:                                                      $allfiles,$codebase,'upload');
                   11429:             $counter ++;
                   11430:             $numnew ++;
1.987     raeburn  11431:         }
                   11432:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   11433:     }
                   11434:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  11435:         if ($actionurl eq '/adm/dependencies') {
                   11436:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   11437:             $modify_output .= &start_data_table_row().
                   11438:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   11439:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   11440:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   11441:                               '<td>'.$size.'</td>'.
                   11442:                               '<td>'.$mtime.'</td>'.
                   11443:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   11444:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   11445:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   11446:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   11447:                               &embedded_file_element('upload_embedded',$counter,
                   11448:                                                      $embed_file,\%mapping,
                   11449:                                                      $allfiles,$codebase,'modify').
                   11450:                               '</div></td>'.
                   11451:                               &end_data_table_row()."\n";
                   11452:             $counter ++;
                   11453:         } else {
                   11454:             $upload_output .= &start_data_table_row().
1.1123    raeburn  11455:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   11456:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   11457:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  11458:                               &Apache::loncommon::end_data_table_row()."\n";
                   11459:         }
                   11460:     }
                   11461:     my $delidx = $counter;
                   11462:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   11463:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   11464:         $delete_output .= &start_data_table_row().
                   11465:                           '<td><img src="'.&icon($oldfile).'" />'.
                   11466:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   11467:                           '<td>'.$size.'</td>'.
                   11468:                           '<td>'.$mtime.'</td>'.
                   11469:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   11470:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   11471:                           &embedded_file_element('upload_embedded',$delidx,
                   11472:                                                  $oldfile,\%mapping,$allfiles,
                   11473:                                                  $codebase,'delete').'</td>'.
                   11474:                           &end_data_table_row()."\n"; 
                   11475:         $numunused ++;
                   11476:         $delidx ++;
1.987     raeburn  11477:     }
                   11478:     if ($upload_output) {
                   11479:         $upload_output = &start_data_table().
                   11480:                          $upload_output.
                   11481:                          &end_data_table()."\n";
                   11482:     }
1.1071    raeburn  11483:     if ($modify_output) {
                   11484:         $modify_output = &start_data_table().
                   11485:                          &start_data_table_header_row().
                   11486:                          '<th>'.&mt('File').'</th>'.
                   11487:                          '<th>'.&mt('Size (KB)').'</th>'.
                   11488:                          '<th>'.&mt('Modified').'</th>'.
                   11489:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   11490:                          &end_data_table_header_row().
                   11491:                          $modify_output.
                   11492:                          &end_data_table()."\n";
                   11493:     }
                   11494:     if ($delete_output) {
                   11495:         $delete_output = &start_data_table().
                   11496:                          &start_data_table_header_row().
                   11497:                          '<th>'.&mt('File').'</th>'.
                   11498:                          '<th>'.&mt('Size (KB)').'</th>'.
                   11499:                          '<th>'.&mt('Modified').'</th>'.
                   11500:                          '<th>'.&mt('Delete?').'</th>'.
                   11501:                          &end_data_table_header_row().
                   11502:                          $delete_output.
                   11503:                          &end_data_table()."\n";
                   11504:     }
1.987     raeburn  11505:     my $applies = 0;
                   11506:     if ($numremref) {
                   11507:         $applies ++;
                   11508:     }
                   11509:     if ($numinvalid) {
                   11510:         $applies ++;
                   11511:     }
                   11512:     if ($numexisting) {
                   11513:         $applies ++;
                   11514:     }
1.1071    raeburn  11515:     if ($counter || $numunused) {
1.987     raeburn  11516:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   11517:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  11518:                   $state.'<h3>'.$heading.'</h3>'; 
                   11519:         if ($actionurl eq '/adm/dependencies') {
                   11520:             if ($numnew) {
                   11521:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   11522:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   11523:                            $upload_output.'<br />'."\n";
                   11524:             }
                   11525:             if ($numexisting) {
                   11526:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   11527:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   11528:                            $modify_output.'<br />'."\n";
                   11529:                            $buttontext = &mt('Save changes');
                   11530:             }
                   11531:             if ($numunused) {
                   11532:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   11533:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   11534:                            $delete_output.'<br />'."\n";
                   11535:                            $buttontext = &mt('Save changes');
                   11536:             }
                   11537:         } else {
                   11538:             $output .= $upload_output.'<br />'."\n";
                   11539:         }
                   11540:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   11541:                    $counter.'" />'."\n";
                   11542:         if ($actionurl eq '/adm/dependencies') { 
                   11543:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   11544:                        $numnew.'" />'."\n";
                   11545:         } elsif ($actionurl eq '') {
1.987     raeburn  11546:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   11547:         }
                   11548:     } elsif ($applies) {
                   11549:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   11550:         if ($applies > 1) {
                   11551:             $output .=  
1.1123    raeburn  11552:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  11553:             if ($numremref) {
                   11554:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   11555:             }
                   11556:             if ($numinvalid) {
                   11557:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   11558:             }
                   11559:             if ($numexisting) {
                   11560:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   11561:             }
                   11562:             $output .= '</ul><br />';
                   11563:         } elsif ($numremref) {
                   11564:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   11565:         } elsif ($numinvalid) {
                   11566:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   11567:         } elsif ($numexisting) {
                   11568:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   11569:         }
                   11570:         $output .= $upload_output.'<br />';
                   11571:     }
                   11572:     my ($pathchange_output,$chgcount);
1.1071    raeburn  11573:     $chgcount = $counter;
1.987     raeburn  11574:     if (keys(%pathchanges) > 0) {
                   11575:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  11576:             if ($counter) {
1.987     raeburn  11577:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   11578:                                                   $embed_file,\%mapping,
1.1071    raeburn  11579:                                                   $allfiles,$codebase,'change');
1.987     raeburn  11580:             } else {
                   11581:                 $pathchange_output .= 
                   11582:                     &start_data_table_row().
                   11583:                     '<td><input type ="checkbox" name="namechange" value="'.
                   11584:                     $chgcount.'" checked="checked" /></td>'.
                   11585:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   11586:                     '<td>'.$embed_file.
                   11587:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  11588:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  11589:                     '</td>'.&end_data_table_row();
1.660     raeburn  11590:             }
1.987     raeburn  11591:             $numpathchg ++;
                   11592:             $chgcount ++;
1.660     raeburn  11593:         }
                   11594:     }
1.1127    raeburn  11595:     if (($counter) || ($numunused)) {
1.987     raeburn  11596:         if ($numpathchg) {
                   11597:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   11598:                        $numpathchg.'" />'."\n";
                   11599:         }
                   11600:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   11601:             ($actionurl eq '/adm/imsimport')) {
                   11602:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   11603:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   11604:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  11605:         } elsif ($actionurl eq '/adm/dependencies') {
                   11606:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  11607:         }
1.1123    raeburn  11608:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  11609:     } elsif ($numpathchg) {
                   11610:         my %pathchange = ();
                   11611:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   11612:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   11613:             $output .= '<p>'.&mt('or').'</p>'; 
1.1123    raeburn  11614:         }
1.987     raeburn  11615:     }
1.1071    raeburn  11616:     return ($output,$counter,$numpathchg);
1.987     raeburn  11617: }
                   11618: 
1.1147    raeburn  11619: =pod
                   11620: 
                   11621: =item * clean_path($name)
                   11622: 
                   11623: Performs clean-up of directories, subdirectories and filename in an
                   11624: embedded object, referenced in an HTML file which is being uploaded
                   11625: to a course or portfolio, where 
                   11626: "Upload embedded images/multimedia files if HTML file" checkbox was
                   11627: checked.
                   11628: 
                   11629: Clean-up is similar to replacements in lonnet::clean_filename()
                   11630: except each / between sub-directory and next level is preserved.
                   11631: 
                   11632: =cut
                   11633: 
                   11634: sub clean_path {
                   11635:     my ($embed_file) = @_;
                   11636:     $embed_file =~s{^/+}{};
                   11637:     my @contents;
                   11638:     if ($embed_file =~ m{/}) {
                   11639:         @contents = split(/\//,$embed_file);
                   11640:     } else {
                   11641:         @contents = ($embed_file);
                   11642:     }
                   11643:     my $lastidx = scalar(@contents)-1;
                   11644:     for (my $i=0; $i<=$lastidx; $i++) { 
                   11645:         $contents[$i]=~s{\\}{/}g;
                   11646:         $contents[$i]=~s/\s+/\_/g;
                   11647:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   11648:         if ($i == $lastidx) {
                   11649:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   11650:         }
                   11651:     }
                   11652:     if ($lastidx > 0) {
                   11653:         return join('/',@contents);
                   11654:     } else {
                   11655:         return $contents[0];
                   11656:     }
                   11657: }
                   11658: 
1.987     raeburn  11659: sub embedded_file_element {
1.1071    raeburn  11660:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  11661:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   11662:                    (ref($codebase) eq 'HASH'));
                   11663:     my $output;
1.1071    raeburn  11664:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  11665:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   11666:     }
                   11667:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   11668:                &escape($embed_file).'" />';
                   11669:     unless (($context eq 'upload_embedded') && 
                   11670:             ($mapping->{$embed_file} eq $embed_file)) {
                   11671:         $output .='
                   11672:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   11673:     }
                   11674:     my $attrib;
                   11675:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   11676:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   11677:     }
                   11678:     $output .=
                   11679:         "\n\t\t".
                   11680:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   11681:         $attrib.'" />';
                   11682:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   11683:         $output .=
                   11684:             "\n\t\t".
                   11685:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   11686:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  11687:     }
1.987     raeburn  11688:     return $output;
1.660     raeburn  11689: }
                   11690: 
1.1071    raeburn  11691: sub get_dependency_details {
                   11692:     my ($currfile,$currsubfile,$embed_file) = @_;
                   11693:     my ($size,$mtime,$showsize,$showmtime);
                   11694:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   11695:         if ($embed_file =~ m{/}) {
                   11696:             my ($path,$fname) = split(/\//,$embed_file);
                   11697:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   11698:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   11699:             }
                   11700:         } else {
                   11701:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   11702:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   11703:             }
                   11704:         }
                   11705:         $showsize = $size/1024.0;
                   11706:         $showsize = sprintf("%.1f",$showsize);
                   11707:         if ($mtime > 0) {
                   11708:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   11709:         }
                   11710:     }
                   11711:     return ($showsize,$showmtime);
                   11712: }
                   11713: 
                   11714: sub ask_embedded_js {
                   11715:     return <<"END";
                   11716: <script type="text/javascript"">
                   11717: // <![CDATA[
                   11718: function toggleBrowse(counter) {
                   11719:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   11720:     var fileid = document.getElementById('embedded_item_'+counter);
                   11721:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   11722:     if (chkboxid.checked == true) {
                   11723:         uploaddivid.style.display='block';
                   11724:     } else {
                   11725:         uploaddivid.style.display='none';
                   11726:         fileid.value = '';
                   11727:     }
                   11728: }
                   11729: // ]]>
                   11730: </script>
                   11731: 
                   11732: END
                   11733: }
                   11734: 
1.661     raeburn  11735: sub upload_embedded {
                   11736:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  11737:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   11738:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  11739:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   11740:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   11741:         my $orig_uploaded_filename =
                   11742:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  11743:         foreach my $type ('orig','ref','attrib','codebase') {
                   11744:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   11745:                 $env{'form.embedded_'.$type.'_'.$i} =
                   11746:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   11747:             }
                   11748:         }
1.661     raeburn  11749:         my ($path,$fname) =
                   11750:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   11751:         # no path, whole string is fname
                   11752:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   11753:         $fname = &Apache::lonnet::clean_filename($fname);
                   11754:         # See if there is anything left
                   11755:         next if ($fname eq '');
                   11756: 
                   11757:         # Check if file already exists as a file or directory.
                   11758:         my ($state,$msg);
                   11759:         if ($context eq 'portfolio') {
                   11760:             my $port_path = $dirpath;
                   11761:             if ($group ne '') {
                   11762:                 $port_path = "groups/$group/$port_path";
                   11763:             }
1.987     raeburn  11764:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   11765:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  11766:                                               $dir_root,$port_path,$disk_quota,
                   11767:                                               $current_disk_usage,$uname,$udom);
                   11768:             if ($state eq 'will_exceed_quota'
1.984     raeburn  11769:                 || $state eq 'file_locked') {
1.661     raeburn  11770:                 $output .= $msg;
                   11771:                 next;
                   11772:             }
                   11773:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   11774:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   11775:             if ($state eq 'exists') {
                   11776:                 $output .= $msg;
                   11777:                 next;
                   11778:             }
                   11779:         }
                   11780:         # Check if extension is valid
                   11781:         if (($fname =~ /\.(\w+)$/) &&
                   11782:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155    bisitz   11783:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   11784:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  11785:             next;
                   11786:         } elsif (($fname =~ /\.(\w+)$/) &&
                   11787:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  11788:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  11789:             next;
                   11790:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120    bisitz   11791:             $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  11792:             next;
                   11793:         }
                   11794:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123    raeburn  11795:         my $subdir = $path;
                   11796:         $subdir =~ s{/+$}{};
1.661     raeburn  11797:         if ($context eq 'portfolio') {
1.984     raeburn  11798:             my $result;
                   11799:             if ($state eq 'existingfile') {
                   11800:                 $result=
                   11801:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123    raeburn  11802:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  11803:             } else {
1.984     raeburn  11804:                 $result=
                   11805:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  11806:                                                     $dirpath.
1.1123    raeburn  11807:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  11808:                 if ($result !~ m|^/uploaded/|) {
                   11809:                     $output .= '<span class="LC_error">'
                   11810:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   11811:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   11812:                                .'</span><br />';
                   11813:                     next;
                   11814:                 } else {
1.987     raeburn  11815:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11816:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  11817:                 }
1.661     raeburn  11818:             }
1.1123    raeburn  11819:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126    raeburn  11820:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   11821:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  11822:             my $result =
1.1126    raeburn  11823:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  11824:             if ($result !~ m|^/uploaded/|) {
                   11825:                 $output .= '<span class="LC_error">'
                   11826:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   11827:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   11828:                            .'</span><br />';
                   11829:                     next;
                   11830:             } else {
                   11831:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11832:                            $path.$fname.'</span>').'<br />';
1.1125    raeburn  11833:                 if ($context eq 'syllabus') {
                   11834:                     &Apache::lonnet::make_public_indefinitely($result);
                   11835:                 }
1.987     raeburn  11836:             }
1.661     raeburn  11837:         } else {
                   11838: # Save the file
                   11839:             my $target = $env{'form.embedded_item_'.$i};
                   11840:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   11841:             my $dest = $fullpath.$fname;
                   11842:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  11843:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  11844:             my $count;
                   11845:             my $filepath = $dir_root;
1.1027    raeburn  11846:             foreach my $subdir (@parts) {
                   11847:                 $filepath .= "/$subdir";
                   11848:                 if (!-e $filepath) {
1.661     raeburn  11849:                     mkdir($filepath,0770);
                   11850:                 }
                   11851:             }
                   11852:             my $fh;
                   11853:             if (!open($fh,'>'.$dest)) {
                   11854:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   11855:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  11856:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   11857:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  11858:                            '</span><br />';
                   11859:             } else {
                   11860:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   11861:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   11862:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  11863:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   11864:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  11865:                               '</span><br />';
                   11866:                 } else {
1.987     raeburn  11867:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   11868:                                $url.'</span>').'<br />';
                   11869:                     unless ($context eq 'testbank') {
                   11870:                         $footer .= &mt('View embedded file: [_1]',
                   11871:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   11872:                     }
                   11873:                 }
                   11874:                 close($fh);
                   11875:             }
                   11876:         }
                   11877:         if ($env{'form.embedded_ref_'.$i}) {
                   11878:             $pathchange{$i} = 1;
                   11879:         }
                   11880:     }
                   11881:     if ($output) {
                   11882:         $output = '<p>'.$output.'</p>';
                   11883:     }
                   11884:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   11885:     $returnflag = 'ok';
1.1071    raeburn  11886:     my $numpathchgs = scalar(keys(%pathchange));
                   11887:     if ($numpathchgs > 0) {
1.987     raeburn  11888:         if ($context eq 'portfolio') {
                   11889:             $output .= '<p>'.&mt('or').'</p>';
                   11890:         } elsif ($context eq 'testbank') {
1.1071    raeburn  11891:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   11892:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  11893:             $returnflag = 'modify_orightml';
                   11894:         }
                   11895:     }
1.1071    raeburn  11896:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  11897: }
                   11898: 
                   11899: sub modify_html_form {
                   11900:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   11901:     my $end = 0;
                   11902:     my $modifyform;
                   11903:     if ($context eq 'upload_embedded') {
                   11904:         return unless (ref($pathchange) eq 'HASH');
                   11905:         if ($env{'form.number_embedded_items'}) {
                   11906:             $end += $env{'form.number_embedded_items'};
                   11907:         }
                   11908:         if ($env{'form.number_pathchange_items'}) {
                   11909:             $end += $env{'form.number_pathchange_items'};
                   11910:         }
                   11911:         if ($end) {
                   11912:             for (my $i=0; $i<$end; $i++) {
                   11913:                 if ($i < $env{'form.number_embedded_items'}) {
                   11914:                     next unless($pathchange->{$i});
                   11915:                 }
                   11916:                 $modifyform .=
                   11917:                     &start_data_table_row().
                   11918:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   11919:                     'checked="checked" /></td>'.
                   11920:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   11921:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   11922:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   11923:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   11924:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   11925:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   11926:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   11927:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   11928:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   11929:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   11930:                     &end_data_table_row();
1.1071    raeburn  11931:             }
1.987     raeburn  11932:         }
                   11933:     } else {
                   11934:         $modifyform = $pathchgtable;
                   11935:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   11936:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   11937:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   11938:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   11939:         }
                   11940:     }
                   11941:     if ($modifyform) {
1.1071    raeburn  11942:         if ($actionurl eq '/adm/dependencies') {
                   11943:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   11944:         }
1.987     raeburn  11945:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   11946:                '<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".
                   11947:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   11948:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   11949:                '</ol></p>'."\n".'<p>'.
                   11950:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   11951:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   11952:                &start_data_table()."\n".
                   11953:                &start_data_table_header_row().
                   11954:                '<th>'.&mt('Change?').'</th>'.
                   11955:                '<th>'.&mt('Current reference').'</th>'.
                   11956:                '<th>'.&mt('Required reference').'</th>'.
                   11957:                &end_data_table_header_row()."\n".
                   11958:                $modifyform.
                   11959:                &end_data_table().'<br />'."\n".$hiddenstate.
                   11960:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   11961:                '</form>'."\n";
                   11962:     }
                   11963:     return;
                   11964: }
                   11965: 
                   11966: sub modify_html_refs {
1.1123    raeburn  11967:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  11968:     my $container;
                   11969:     if ($context eq 'portfolio') {
                   11970:         $container = $env{'form.container'};
                   11971:     } elsif ($context eq 'coursedoc') {
                   11972:         $container = $env{'form.primaryurl'};
1.1071    raeburn  11973:     } elsif ($context eq 'manage_dependencies') {
                   11974:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   11975:         $container = "/$container";
1.1123    raeburn  11976:     } elsif ($context eq 'syllabus') {
                   11977:         $container = $url;
1.987     raeburn  11978:     } else {
1.1027    raeburn  11979:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  11980:     }
                   11981:     my (%allfiles,%codebase,$output,$content);
                   11982:     my @changes = &get_env_multiple('form.namechange');
1.1126    raeburn  11983:     unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071    raeburn  11984:         if (wantarray) {
                   11985:             return ('',0,0); 
                   11986:         } else {
                   11987:             return;
                   11988:         }
                   11989:     }
                   11990:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  11991:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  11992:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   11993:             if (wantarray) {
                   11994:                 return ('',0,0);
                   11995:             } else {
                   11996:                 return;
                   11997:             }
                   11998:         } 
1.987     raeburn  11999:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  12000:         if ($content eq '-1') {
                   12001:             if (wantarray) {
                   12002:                 return ('',0,0);
                   12003:             } else {
                   12004:                 return;
                   12005:             }
                   12006:         }
1.987     raeburn  12007:     } else {
1.1071    raeburn  12008:         unless ($container =~ /^\Q$dir_root\E/) {
                   12009:             if (wantarray) {
                   12010:                 return ('',0,0);
                   12011:             } else {
                   12012:                 return;
                   12013:             }
                   12014:         } 
1.987     raeburn  12015:         if (open(my $fh,"<$container")) {
                   12016:             $content = join('', <$fh>);
                   12017:             close($fh);
                   12018:         } else {
1.1071    raeburn  12019:             if (wantarray) {
                   12020:                 return ('',0,0);
                   12021:             } else {
                   12022:                 return;
                   12023:             }
1.987     raeburn  12024:         }
                   12025:     }
                   12026:     my ($count,$codebasecount) = (0,0);
                   12027:     my $mm = new File::MMagic;
                   12028:     my $mime_type = $mm->checktype_contents($content);
                   12029:     if ($mime_type eq 'text/html') {
                   12030:         my $parse_result = 
                   12031:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   12032:                                                     \%codebase,\$content);
                   12033:         if ($parse_result eq 'ok') {
                   12034:             foreach my $i (@changes) {
                   12035:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   12036:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   12037:                 if ($allfiles{$ref}) {
                   12038:                     my $newname =  $orig;
                   12039:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  12040:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  12041:                     if ($attrib_regexp =~ /:/) {
                   12042:                         $attrib_regexp =~ s/\:/|/g;
                   12043:                     }
                   12044:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   12045:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   12046:                         $count += $numchg;
1.1123    raeburn  12047:                         $allfiles{$newname} = $allfiles{$ref};
1.1148    raeburn  12048:                         delete($allfiles{$ref});
1.987     raeburn  12049:                     }
                   12050:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  12051:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  12052:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   12053:                         $codebasecount ++;
                   12054:                     }
                   12055:                 }
                   12056:             }
1.1123    raeburn  12057:             my $skiprewrites;
1.987     raeburn  12058:             if ($count || $codebasecount) {
                   12059:                 my $saveresult;
1.1071    raeburn  12060:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  12061:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  12062:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   12063:                     if ($url eq $container) {
                   12064:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   12065:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   12066:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  12067:                                             $fname.'</span>').'</p>';
1.987     raeburn  12068:                     } else {
                   12069:                          $output = '<p class="LC_error">'.
                   12070:                                    &mt('Error: update failed for: [_1].',
                   12071:                                    '<span class="LC_filename">'.
                   12072:                                    $container.'</span>').'</p>';
                   12073:                     }
1.1123    raeburn  12074:                     if ($context eq 'syllabus') {
                   12075:                         unless ($saveresult eq 'ok') {
                   12076:                             $skiprewrites = 1;
                   12077:                         }
                   12078:                     }
1.987     raeburn  12079:                 } else {
                   12080:                     if (open(my $fh,">$container")) {
                   12081:                         print $fh $content;
                   12082:                         close($fh);
                   12083:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   12084:                                   $count,'<span class="LC_filename">'.
                   12085:                                   $container.'</span>').'</p>';
1.661     raeburn  12086:                     } else {
1.987     raeburn  12087:                          $output = '<p class="LC_error">'.
                   12088:                                    &mt('Error: could not update [_1].',
                   12089:                                    '<span class="LC_filename">'.
                   12090:                                    $container.'</span>').'</p>';
1.661     raeburn  12091:                     }
                   12092:                 }
                   12093:             }
1.1123    raeburn  12094:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   12095:                 my ($actionurl,$state);
                   12096:                 $actionurl = "/public/$udom/$uname/syllabus";
                   12097:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   12098:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   12099:                                               \%codebase,
                   12100:                                               {'context' => 'rewrites',
                   12101:                                                'ignore_remote_references' => 1,});
                   12102:                 if (ref($mapping) eq 'HASH') {
                   12103:                     my $rewrites = 0;
                   12104:                     foreach my $key (keys(%{$mapping})) {
                   12105:                         next if ($key =~ m{^https?://});
                   12106:                         my $ref = $mapping->{$key};
                   12107:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   12108:                         my $attrib;
                   12109:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   12110:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   12111:                         }
                   12112:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   12113:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   12114:                             $rewrites += $numchg;
                   12115:                         }
                   12116:                     }
                   12117:                     if ($rewrites) {
                   12118:                         my $saveresult; 
                   12119:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   12120:                         if ($url eq $container) {
                   12121:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   12122:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   12123:                                             $count,'<span class="LC_filename">'.
                   12124:                                             $fname.'</span>').'</p>';
                   12125:                         } else {
                   12126:                             $output .= '<p class="LC_error">'.
                   12127:                                        &mt('Error: could not update links in [_1].',
                   12128:                                        '<span class="LC_filename">'.
                   12129:                                        $container.'</span>').'</p>';
                   12130: 
                   12131:                         }
                   12132:                     }
                   12133:                 }
                   12134:             }
1.987     raeburn  12135:         } else {
                   12136:             &logthis('Failed to parse '.$container.
                   12137:                      ' to modify references: '.$parse_result);
1.661     raeburn  12138:         }
                   12139:     }
1.1071    raeburn  12140:     if (wantarray) {
                   12141:         return ($output,$count,$codebasecount);
                   12142:     } else {
                   12143:         return $output;
                   12144:     }
1.661     raeburn  12145: }
                   12146: 
                   12147: sub check_for_existing {
                   12148:     my ($path,$fname,$element) = @_;
                   12149:     my ($state,$msg);
                   12150:     if (-d $path.'/'.$fname) {
                   12151:         $state = 'exists';
                   12152:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   12153:     } elsif (-e $path.'/'.$fname) {
                   12154:         $state = 'exists';
                   12155:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   12156:     }
                   12157:     if ($state eq 'exists') {
                   12158:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   12159:     }
                   12160:     return ($state,$msg);
                   12161: }
                   12162: 
                   12163: sub check_for_upload {
                   12164:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   12165:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  12166:     my $filesize = length($env{'form.'.$element});
                   12167:     if (!$filesize) {
                   12168:         my $msg = '<span class="LC_error">'.
                   12169:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   12170:                       '<span class="LC_filename">'.$fname.'</span>',
                   12171:                       $filesize).'<br />'.
1.1007    raeburn  12172:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  12173:                   '</span>';
                   12174:         return ('zero_bytes',$msg);
                   12175:     }
                   12176:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  12177:     my $getpropath = 1;
1.1021    raeburn  12178:     my ($dirlistref,$listerror) =
                   12179:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  12180:     my $found_file = 0;
                   12181:     my $locked_file = 0;
1.991     raeburn  12182:     my @lockers;
                   12183:     my $navmap;
                   12184:     if ($env{'request.course.id'}) {
                   12185:         $navmap = Apache::lonnavmaps::navmap->new();
                   12186:     }
1.1021    raeburn  12187:     if (ref($dirlistref) eq 'ARRAY') {
                   12188:         foreach my $line (@{$dirlistref}) {
                   12189:             my ($file_name,$rest)=split(/\&/,$line,2);
                   12190:             if ($file_name eq $fname){
                   12191:                 $file_name = $path.$file_name;
                   12192:                 if ($group ne '') {
                   12193:                     $file_name = $group.$file_name;
                   12194:                 }
                   12195:                 $found_file = 1;
                   12196:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   12197:                     foreach my $lock (@lockers) {
                   12198:                         if (ref($lock) eq 'ARRAY') {
                   12199:                             my ($symb,$crsid) = @{$lock};
                   12200:                             if ($crsid eq $env{'request.course.id'}) {
                   12201:                                 if (ref($navmap)) {
                   12202:                                     my $res = $navmap->getBySymb($symb);
                   12203:                                     foreach my $part (@{$res->parts()}) { 
                   12204:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   12205:                                         unless (($slot_status == $res->RESERVED) ||
                   12206:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   12207:                                             $locked_file = 1;
                   12208:                                         }
1.991     raeburn  12209:                                     }
1.1021    raeburn  12210:                                 } else {
                   12211:                                     $locked_file = 1;
1.991     raeburn  12212:                                 }
                   12213:                             } else {
                   12214:                                 $locked_file = 1;
                   12215:                             }
                   12216:                         }
1.1021    raeburn  12217:                    }
                   12218:                 } else {
                   12219:                     my @info = split(/\&/,$rest);
                   12220:                     my $currsize = $info[6]/1000;
                   12221:                     if ($currsize < $filesize) {
                   12222:                         my $extra = $filesize - $currsize;
                   12223:                         if (($current_disk_usage + $extra) > $disk_quota) {
1.1179    bisitz   12224:                             my $msg = '<p class="LC_warning">'.
1.1021    raeburn  12225:                                       &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   12226:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                   12227:                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   12228:                                                    $disk_quota,$current_disk_usage).'</p>';
1.1021    raeburn  12229:                             return ('will_exceed_quota',$msg);
                   12230:                         }
1.984     raeburn  12231:                     }
                   12232:                 }
1.661     raeburn  12233:             }
                   12234:         }
                   12235:     }
                   12236:     if (($current_disk_usage + $filesize) > $disk_quota){
1.1179    bisitz   12237:         my $msg = '<p class="LC_warning">'.
                   12238:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184    raeburn  12239:                   '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661     raeburn  12240:         return ('will_exceed_quota',$msg);
                   12241:     } elsif ($found_file) {
                   12242:         if ($locked_file) {
1.1179    bisitz   12243:             my $msg = '<p class="LC_warning">';
1.661     raeburn  12244:             $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   12245:             $msg .= '</p>';
1.661     raeburn  12246:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   12247:             return ('file_locked',$msg);
                   12248:         } else {
1.1179    bisitz   12249:             my $msg = '<p class="LC_error">';
1.984     raeburn  12250:             $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   12251:             $msg .= '</p>';
1.984     raeburn  12252:             return ('existingfile',$msg);
1.661     raeburn  12253:         }
                   12254:     }
                   12255: }
                   12256: 
1.987     raeburn  12257: sub check_for_traversal {
                   12258:     my ($path,$url,$toplevel) = @_;
                   12259:     my @parts=split(/\//,$path);
                   12260:     my $cleanpath;
                   12261:     my $fullpath = $url;
                   12262:     for (my $i=0;$i<@parts;$i++) {
                   12263:         next if ($parts[$i] eq '.');
                   12264:         if ($parts[$i] eq '..') {
                   12265:             $fullpath =~ s{([^/]+/)$}{};
                   12266:         } else {
                   12267:             $fullpath .= $parts[$i].'/';
                   12268:         }
                   12269:     }
                   12270:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   12271:         $cleanpath = $1;
                   12272:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   12273:         my $curr_toprel = $1;
                   12274:         my @parts = split(/\//,$curr_toprel);
                   12275:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   12276:         my @urlparts = split(/\//,$url_toprel);
                   12277:         my $doubledots;
                   12278:         my $startdiff = -1;
                   12279:         for (my $i=0; $i<@urlparts; $i++) {
                   12280:             if ($startdiff == -1) {
                   12281:                 unless ($urlparts[$i] eq $parts[$i]) {
                   12282:                     $startdiff = $i;
                   12283:                     $doubledots .= '../';
                   12284:                 }
                   12285:             } else {
                   12286:                 $doubledots .= '../';
                   12287:             }
                   12288:         }
                   12289:         if ($startdiff > -1) {
                   12290:             $cleanpath = $doubledots;
                   12291:             for (my $i=$startdiff; $i<@parts; $i++) {
                   12292:                 $cleanpath .= $parts[$i].'/';
                   12293:             }
                   12294:         }
                   12295:     }
                   12296:     $cleanpath =~ s{(/)$}{};
                   12297:     return $cleanpath;
                   12298: }
1.31      albertel 12299: 
1.1053    raeburn  12300: sub is_archive_file {
                   12301:     my ($mimetype) = @_;
                   12302:     if (($mimetype eq 'application/octet-stream') ||
                   12303:         ($mimetype eq 'application/x-stuffit') ||
                   12304:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   12305:         return 1;
                   12306:     }
                   12307:     return;
                   12308: }
                   12309: 
                   12310: sub decompress_form {
1.1065    raeburn  12311:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  12312:     my %lt = &Apache::lonlocal::texthash (
                   12313:         this => 'This file is an archive file.',
1.1067    raeburn  12314:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  12315:         itsc => 'Its contents are as follows:',
1.1053    raeburn  12316:         youm => 'You may wish to extract its contents.',
                   12317:         extr => 'Extract contents',
1.1067    raeburn  12318:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   12319:         proa => 'Process automatically?',
1.1053    raeburn  12320:         yes  => 'Yes',
                   12321:         no   => 'No',
1.1067    raeburn  12322:         fold => 'Title for folder containing movie',
                   12323:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  12324:     );
1.1065    raeburn  12325:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  12326:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  12327:     my $info = &list_archive_contents($fileloc,\@paths);
                   12328:     if (@paths) {
                   12329:         foreach my $path (@paths) {
                   12330:             $path =~ s{^/}{};
1.1067    raeburn  12331:             if ($path =~ m{^([^/]+)/$}) {
                   12332:                 $topdir = $1;
                   12333:             }
1.1065    raeburn  12334:             if ($path =~ m{^([^/]+)/}) {
                   12335:                 $toplevel{$1} = $path;
                   12336:             } else {
                   12337:                 $toplevel{$path} = $path;
                   12338:             }
                   12339:         }
                   12340:     }
1.1067    raeburn  12341:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164    raeburn  12342:         my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067    raeburn  12343:                         "$topdir/media/",
                   12344:                         "$topdir/media/$topdir.mp4",
                   12345:                         "$topdir/media/FirstFrame.png",
                   12346:                         "$topdir/media/player.swf",
                   12347:                         "$topdir/media/swfobject.js",
                   12348:                         "$topdir/media/expressInstall.swf");
1.1197    raeburn  12349:         my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164    raeburn  12350:                          "$topdir/$topdir.mp4",
                   12351:                          "$topdir/$topdir\_config.xml",
                   12352:                          "$topdir/$topdir\_controller.swf",
                   12353:                          "$topdir/$topdir\_embed.css",
                   12354:                          "$topdir/$topdir\_First_Frame.png",
                   12355:                          "$topdir/$topdir\_player.html",
                   12356:                          "$topdir/$topdir\_Thumbnails.png",
                   12357:                          "$topdir/playerProductInstall.swf",
                   12358:                          "$topdir/scripts/",
                   12359:                          "$topdir/scripts/config_xml.js",
                   12360:                          "$topdir/scripts/handlebars.js",
                   12361:                          "$topdir/scripts/jquery-1.7.1.min.js",
                   12362:                          "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                   12363:                          "$topdir/scripts/modernizr.js",
                   12364:                          "$topdir/scripts/player-min.js",
                   12365:                          "$topdir/scripts/swfobject.js",
                   12366:                          "$topdir/skins/",
                   12367:                          "$topdir/skins/configuration_express.xml",
                   12368:                          "$topdir/skins/express_show/",
                   12369:                          "$topdir/skins/express_show/player-min.css",
                   12370:                          "$topdir/skins/express_show/spritesheet.png");
1.1197    raeburn  12371:         my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
                   12372:                          "$topdir/$topdir.mp4",
                   12373:                          "$topdir/$topdir\_config.xml",
                   12374:                          "$topdir/$topdir\_controller.swf",
                   12375:                          "$topdir/$topdir\_embed.css",
                   12376:                          "$topdir/$topdir\_First_Frame.png",
                   12377:                          "$topdir/$topdir\_player.html",
                   12378:                          "$topdir/$topdir\_Thumbnails.png",
                   12379:                          "$topdir/playerProductInstall.swf",
                   12380:                          "$topdir/scripts/",
                   12381:                          "$topdir/scripts/config_xml.js",
                   12382:                          "$topdir/scripts/techsmith-smart-player.min.js",
                   12383:                          "$topdir/skins/",
                   12384:                          "$topdir/skins/configuration_express.xml",
                   12385:                          "$topdir/skins/express_show/",
                   12386:                          "$topdir/skins/express_show/spritesheet.min.css",
                   12387:                          "$topdir/skins/express_show/spritesheet.png",
                   12388:                          "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164    raeburn  12389:         my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067    raeburn  12390:         if (@diffs == 0) {
1.1164    raeburn  12391:             $is_camtasia = 6;
                   12392:         } else {
1.1197    raeburn  12393:             @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164    raeburn  12394:             if (@diffs == 0) {
                   12395:                 $is_camtasia = 8;
1.1197    raeburn  12396:             } else {
                   12397:                 @diffs = &compare_arrays(\@paths,\@camtasia8_4);
                   12398:                 if (@diffs == 0) {
                   12399:                     $is_camtasia = 8;
                   12400:                 }
1.1164    raeburn  12401:             }
1.1067    raeburn  12402:         }
                   12403:     }
                   12404:     my $output;
                   12405:     if ($is_camtasia) {
                   12406:         $output = <<"ENDCAM";
                   12407: <script type="text/javascript" language="Javascript">
                   12408: // <![CDATA[
                   12409: 
                   12410: function camtasiaToggle() {
                   12411:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   12412:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164    raeburn  12413:             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067    raeburn  12414:                 document.getElementById('camtasia_titles').style.display='block';
                   12415:             } else {
                   12416:                 document.getElementById('camtasia_titles').style.display='none';
                   12417:             }
                   12418:         }
                   12419:     }
                   12420:     return;
                   12421: }
                   12422: 
                   12423: // ]]>
                   12424: </script>
                   12425: <p>$lt{'camt'}</p>
                   12426: ENDCAM
1.1065    raeburn  12427:     } else {
1.1067    raeburn  12428:         $output = '<p>'.$lt{'this'};
                   12429:         if ($info eq '') {
                   12430:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   12431:         } else {
                   12432:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   12433:                        '<div><pre>'.$info.'</pre></div>';
                   12434:         }
1.1065    raeburn  12435:     }
1.1067    raeburn  12436:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  12437:     my $duplicates;
                   12438:     my $num = 0;
                   12439:     if (ref($dirlist) eq 'ARRAY') {
                   12440:         foreach my $item (@{$dirlist}) {
                   12441:             if (ref($item) eq 'ARRAY') {
                   12442:                 if (exists($toplevel{$item->[0]})) {
                   12443:                     $duplicates .= 
                   12444:                         &start_data_table_row().
                   12445:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   12446:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   12447:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   12448:                         'value="1" />'.&mt('Yes').'</label>'.
                   12449:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   12450:                         '<td>'.$item->[0].'</td>';
                   12451:                     if ($item->[2]) {
                   12452:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   12453:                     } else {
                   12454:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   12455:                     }
                   12456:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   12457:                                    '<td>'.
                   12458:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   12459:                                    '</td>'.
                   12460:                                    &end_data_table_row();
                   12461:                     $num ++;
                   12462:                 }
                   12463:             }
                   12464:         }
                   12465:     }
                   12466:     my $itemcount;
                   12467:     if (@paths > 0) {
                   12468:         $itemcount = scalar(@paths);
                   12469:     } else {
                   12470:         $itemcount = 1;
                   12471:     }
1.1067    raeburn  12472:     if ($is_camtasia) {
                   12473:         $output .= $lt{'auto'}.'<br />'.
                   12474:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164    raeburn  12475:                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067    raeburn  12476:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   12477:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   12478:                    $lt{'no'}.'</label></span><br />'.
                   12479:                    '<div id="camtasia_titles" style="display:block">'.
                   12480:                    &Apache::lonhtmlcommon::start_pick_box().
                   12481:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   12482:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   12483:                    &Apache::lonhtmlcommon::row_closure().
                   12484:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   12485:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   12486:                    &Apache::lonhtmlcommon::row_closure(1).
                   12487:                    &Apache::lonhtmlcommon::end_pick_box().
                   12488:                    '</div>';
                   12489:     }
1.1065    raeburn  12490:     $output .= 
                   12491:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  12492:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   12493:         "\n";
1.1065    raeburn  12494:     if ($duplicates ne '') {
                   12495:         $output .= '<p><span class="LC_warning">'.
                   12496:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   12497:                    &start_data_table().
                   12498:                    &start_data_table_header_row().
                   12499:                    '<th>'.&mt('Overwrite?').'</th>'.
                   12500:                    '<th>'.&mt('Name').'</th>'.
                   12501:                    '<th>'.&mt('Type').'</th>'.
                   12502:                    '<th>'.&mt('Size').'</th>'.
                   12503:                    '<th>'.&mt('Last modified').'</th>'.
                   12504:                    &end_data_table_header_row().
                   12505:                    $duplicates.
                   12506:                    &end_data_table().
                   12507:                    '</p>';
                   12508:     }
1.1067    raeburn  12509:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  12510:     if (ref($hiddenelements) eq 'HASH') {
                   12511:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   12512:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   12513:         }
                   12514:     }
                   12515:     $output .= <<"END";
1.1067    raeburn  12516: <br />
1.1053    raeburn  12517: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   12518: </form>
                   12519: $noextract
                   12520: END
                   12521:     return $output;
                   12522: }
                   12523: 
1.1065    raeburn  12524: sub decompression_utility {
                   12525:     my ($program) = @_;
                   12526:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   12527:     my $location;
                   12528:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   12529:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   12530:                          '/usr/sbin/') {
                   12531:             if (-x $dir.$program) {
                   12532:                 $location = $dir.$program;
                   12533:                 last;
                   12534:             }
                   12535:         }
                   12536:     }
                   12537:     return $location;
                   12538: }
                   12539: 
                   12540: sub list_archive_contents {
                   12541:     my ($file,$pathsref) = @_;
                   12542:     my (@cmd,$output);
                   12543:     my $needsregexp;
                   12544:     if ($file =~ /\.zip$/) {
                   12545:         @cmd = (&decompression_utility('unzip'),"-l");
                   12546:         $needsregexp = 1;
                   12547:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   12548:              ($file =~ /\.tgz$/)) {
                   12549:         @cmd = (&decompression_utility('tar'),"-ztf");
                   12550:     } elsif ($file =~ /\.tar\.bz2$/) {
                   12551:         @cmd = (&decompression_utility('tar'),"-jtf");
                   12552:     } elsif ($file =~ m|\.tar$|) {
                   12553:         @cmd = (&decompression_utility('tar'),"-tf");
                   12554:     }
                   12555:     if (@cmd) {
                   12556:         undef($!);
                   12557:         undef($@);
                   12558:         if (open(my $fh,"-|", @cmd, $file)) {
                   12559:             while (my $line = <$fh>) {
                   12560:                 $output .= $line;
                   12561:                 chomp($line);
                   12562:                 my $item;
                   12563:                 if ($needsregexp) {
                   12564:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   12565:                 } else {
                   12566:                     $item = $line;
                   12567:                 }
                   12568:                 if ($item ne '') {
                   12569:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   12570:                         push(@{$pathsref},$item);
                   12571:                     } 
                   12572:                 }
                   12573:             }
                   12574:             close($fh);
                   12575:         }
                   12576:     }
                   12577:     return $output;
                   12578: }
                   12579: 
1.1053    raeburn  12580: sub decompress_uploaded_file {
                   12581:     my ($file,$dir) = @_;
                   12582:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   12583:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   12584:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   12585:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   12586:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   12587:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   12588:     my $decompressed = $env{'cgi.decompressed'};
                   12589:     &Apache::lonnet::delenv('cgi.file');
                   12590:     &Apache::lonnet::delenv('cgi.dir');
                   12591:     &Apache::lonnet::delenv('cgi.decompressed');
                   12592:     return ($decompressed,$result);
                   12593: }
                   12594: 
1.1055    raeburn  12595: sub process_decompression {
                   12596:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   12597:     my ($dir,$error,$warning,$output);
1.1180    raeburn  12598:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120    bisitz   12599:         $error = &mt('Filename not a supported archive file type.').
                   12600:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  12601:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   12602:     } else {
                   12603:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   12604:         if ($docuhome eq 'no_host') {
                   12605:             $error = &mt('Could not determine home server for course.');
                   12606:         } else {
                   12607:             my @ids=&Apache::lonnet::current_machine_ids();
                   12608:             my $currdir = "$dir_root/$destination";
                   12609:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   12610:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   12611:                        "$dir_root/$destination";
                   12612:             } else {
                   12613:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   12614:                        "$dir_root/$docudom/$docuname/$destination";
                   12615:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   12616:                     $error = &mt('Archive file not found.');
                   12617:                 }
                   12618:             }
1.1065    raeburn  12619:             my (@to_overwrite,@to_skip);
                   12620:             if ($env{'form.archive_overwrite_total'} > 0) {
                   12621:                 my $total = $env{'form.archive_overwrite_total'};
                   12622:                 for (my $i=0; $i<$total; $i++) {
                   12623:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   12624:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   12625:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   12626:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   12627:                     }
                   12628:                 }
                   12629:             }
                   12630:             my $numskip = scalar(@to_skip);
                   12631:             if (($numskip > 0) && 
                   12632:                 ($numskip == $env{'form.archive_itemcount'})) {
                   12633:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   12634:             } elsif ($dir eq '') {
1.1055    raeburn  12635:                 $error = &mt('Directory containing archive file unavailable.');
                   12636:             } elsif (!$error) {
1.1065    raeburn  12637:                 my ($decompressed,$display);
                   12638:                 if ($numskip > 0) {
                   12639:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   12640:                     mkdir("$dir/$tempdir",0755);
                   12641:                     system("mv $dir/$file $dir/$tempdir/$file");
                   12642:                     ($decompressed,$display) = 
                   12643:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   12644:                     foreach my $item (@to_skip) {
                   12645:                         if (($item ne '') && ($item !~ /\.\./)) {
                   12646:                             if (-f "$dir/$tempdir/$item") { 
                   12647:                                 unlink("$dir/$tempdir/$item");
                   12648:                             } elsif (-d "$dir/$tempdir/$item") {
                   12649:                                 system("rm -rf $dir/$tempdir/$item");
                   12650:                             }
                   12651:                         }
                   12652:                     }
                   12653:                     system("mv $dir/$tempdir/* $dir");
                   12654:                     rmdir("$dir/$tempdir");   
                   12655:                 } else {
                   12656:                     ($decompressed,$display) = 
                   12657:                         &decompress_uploaded_file($file,$dir);
                   12658:                 }
1.1055    raeburn  12659:                 if ($decompressed eq 'ok') {
1.1065    raeburn  12660:                     $output = '<p class="LC_info">'.
                   12661:                               &mt('Files extracted successfully from archive.').
                   12662:                               '</p>'."\n";
1.1055    raeburn  12663:                     my ($warning,$result,@contents);
                   12664:                     my ($newdirlistref,$newlisterror) =
                   12665:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   12666:                                                  $docuname,1);
                   12667:                     my (%is_dir,%changes,@newitems);
                   12668:                     my $dirptr = 16384;
1.1065    raeburn  12669:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  12670:                         foreach my $dir_line (@{$newdirlistref}) {
                   12671:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  12672:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   12673:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  12674:                                 push(@newitems,$item);
                   12675:                                 if ($dirptr&$testdir) {
                   12676:                                     $is_dir{$item} = 1;
                   12677:                                 }
                   12678:                                 $changes{$item} = 1;
                   12679:                             }
                   12680:                         }
                   12681:                     }
                   12682:                     if (keys(%changes) > 0) {
                   12683:                         foreach my $item (sort(@newitems)) {
                   12684:                             if ($changes{$item}) {
                   12685:                                 push(@contents,$item);
                   12686:                             }
                   12687:                         }
                   12688:                     }
                   12689:                     if (@contents > 0) {
1.1067    raeburn  12690:                         my $wantform;
                   12691:                         unless ($env{'form.autoextract_camtasia'}) {
                   12692:                             $wantform = 1;
                   12693:                         }
1.1056    raeburn  12694:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  12695:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   12696:                                                                 $currdir,\%is_dir,
                   12697:                                                                 \%children,\%parent,
1.1056    raeburn  12698:                                                                 \@contents,\%dirorder,
                   12699:                                                                 \%titles,$wantform);
1.1055    raeburn  12700:                         if ($datatable ne '') {
                   12701:                             $output .= &archive_options_form('decompressed',$datatable,
                   12702:                                                              $count,$hiddenelem);
1.1065    raeburn  12703:                             my $startcount = 6;
1.1055    raeburn  12704:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  12705:                                                            \%titles,\%children);
1.1055    raeburn  12706:                         }
1.1067    raeburn  12707:                         if ($env{'form.autoextract_camtasia'}) {
1.1164    raeburn  12708:                             my $version = $env{'form.autoextract_camtasia'};
1.1067    raeburn  12709:                             my %displayed;
                   12710:                             my $total = 1;
                   12711:                             $env{'form.archive_directory'} = [];
                   12712:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   12713:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   12714:                                 $path =~ s{/$}{};
                   12715:                                 my $item;
                   12716:                                 if ($path ne '') {
                   12717:                                     $item = "$path/$titles{$i}";
                   12718:                                 } else {
                   12719:                                     $item = $titles{$i};
                   12720:                                 }
                   12721:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   12722:                                 if ($item eq $contents[0]) {
                   12723:                                     push(@{$env{'form.archive_directory'}},$i);
                   12724:                                     $env{'form.archive_'.$i} = 'display';
                   12725:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   12726:                                     $displayed{'folder'} = $i;
1.1164    raeburn  12727:                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                   12728:                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { 
1.1067    raeburn  12729:                                     $env{'form.archive_'.$i} = 'display';
                   12730:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   12731:                                     $displayed{'web'} = $i;
                   12732:                                 } else {
1.1164    raeburn  12733:                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                   12734:                                         ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                   12735:                                              ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067    raeburn  12736:                                         push(@{$env{'form.archive_directory'}},$i);
                   12737:                                     }
                   12738:                                     $env{'form.archive_'.$i} = 'dependency';
                   12739:                                 }
                   12740:                                 $total ++;
                   12741:                             }
                   12742:                             for (my $i=1; $i<$total; $i++) {
                   12743:                                 next if ($i == $displayed{'web'});
                   12744:                                 next if ($i == $displayed{'folder'});
                   12745:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   12746:                             }
                   12747:                             $env{'form.phase'} = 'decompress_cleanup';
                   12748:                             $env{'form.archivedelete'} = 1;
                   12749:                             $env{'form.archive_count'} = $total-1;
                   12750:                             $output .=
                   12751:                                 &process_extracted_files('coursedocs',$docudom,
                   12752:                                                          $docuname,$destination,
                   12753:                                                          $dir_root,$hiddenelem);
                   12754:                         }
1.1055    raeburn  12755:                     } else {
                   12756:                         $warning = &mt('No new items extracted from archive file.');
                   12757:                     }
                   12758:                 } else {
                   12759:                     $output = $display;
                   12760:                     $error = &mt('An error occurred during extraction from the archive file.');
                   12761:                 }
                   12762:             }
                   12763:         }
                   12764:     }
                   12765:     if ($error) {
                   12766:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12767:                    $error.'</p>'."\n";
                   12768:     }
                   12769:     if ($warning) {
                   12770:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12771:     }
                   12772:     return $output;
                   12773: }
                   12774: 
                   12775: sub get_extracted {
1.1056    raeburn  12776:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   12777:         $titles,$wantform) = @_;
1.1055    raeburn  12778:     my $count = 0;
                   12779:     my $depth = 0;
                   12780:     my $datatable;
1.1056    raeburn  12781:     my @hierarchy;
1.1055    raeburn  12782:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  12783:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   12784:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  12785:     foreach my $item (@{$contents}) {
                   12786:         $count ++;
1.1056    raeburn  12787:         @{$dirorder->{$count}} = @hierarchy;
                   12788:         $titles->{$count} = $item;
1.1055    raeburn  12789:         &archive_hierarchy($depth,$count,$parent,$children);
                   12790:         if ($wantform) {
                   12791:             $datatable .= &archive_row($is_dir->{$item},$item,
                   12792:                                        $currdir,$depth,$count);
                   12793:         }
                   12794:         if ($is_dir->{$item}) {
                   12795:             $depth ++;
1.1056    raeburn  12796:             push(@hierarchy,$count);
                   12797:             $parent->{$depth} = $count;
1.1055    raeburn  12798:             $datatable .=
                   12799:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  12800:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   12801:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  12802:             $depth --;
1.1056    raeburn  12803:             pop(@hierarchy);
1.1055    raeburn  12804:         }
                   12805:     }
                   12806:     return ($count,$datatable);
                   12807: }
                   12808: 
                   12809: sub recurse_extracted_archive {
1.1056    raeburn  12810:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   12811:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  12812:     my $result='';
1.1056    raeburn  12813:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   12814:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   12815:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  12816:         return $result;
                   12817:     }
                   12818:     my $dirptr = 16384;
                   12819:     my ($newdirlistref,$newlisterror) =
                   12820:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   12821:     if (ref($newdirlistref) eq 'ARRAY') {
                   12822:         foreach my $dir_line (@{$newdirlistref}) {
                   12823:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   12824:             unless ($item =~ /^\.+$/) {
                   12825:                 $$count ++;
1.1056    raeburn  12826:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   12827:                 $titles->{$$count} = $item;
1.1055    raeburn  12828:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  12829: 
1.1055    raeburn  12830:                 my $is_dir;
                   12831:                 if ($dirptr&$testdir) {
                   12832:                     $is_dir = 1;
                   12833:                 }
                   12834:                 if ($wantform) {
                   12835:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   12836:                 }
                   12837:                 if ($is_dir) {
                   12838:                     $$depth ++;
1.1056    raeburn  12839:                     push(@{$hierarchy},$$count);
                   12840:                     $parent->{$$depth} = $$count;
1.1055    raeburn  12841:                     $result .=
                   12842:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   12843:                                                    $docuname,$depth,$count,
1.1056    raeburn  12844:                                                    $hierarchy,$dirorder,$children,
                   12845:                                                    $parent,$titles,$wantform);
1.1055    raeburn  12846:                     $$depth --;
1.1056    raeburn  12847:                     pop(@{$hierarchy});
1.1055    raeburn  12848:                 }
                   12849:             }
                   12850:         }
                   12851:     }
                   12852:     return $result;
                   12853: }
                   12854: 
                   12855: sub archive_hierarchy {
                   12856:     my ($depth,$count,$parent,$children) =@_;
                   12857:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   12858:         if (exists($parent->{$depth})) {
                   12859:              $children->{$parent->{$depth}} .= $count.':';
                   12860:         }
                   12861:     }
                   12862:     return;
                   12863: }
                   12864: 
                   12865: sub archive_row {
                   12866:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   12867:     my ($name) = ($item =~ m{([^/]+)$});
                   12868:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  12869:                                        'display'    => 'Add as file',
1.1055    raeburn  12870:                                        'dependency' => 'Include as dependency',
                   12871:                                        'discard'    => 'Discard',
                   12872:                                       );
                   12873:     if ($is_dir) {
1.1059    raeburn  12874:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  12875:     }
1.1056    raeburn  12876:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   12877:     my $offset = 0;
1.1055    raeburn  12878:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  12879:         $offset ++;
1.1065    raeburn  12880:         if ($action ne 'display') {
                   12881:             $offset ++;
                   12882:         }  
1.1055    raeburn  12883:         $output .= '<td><span class="LC_nobreak">'.
                   12884:                    '<label><input type="radio" name="archive_'.$count.
                   12885:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   12886:         my $text = $choices{$action};
                   12887:         if ($is_dir) {
                   12888:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   12889:             if ($action eq 'display') {
1.1059    raeburn  12890:                 $text = &mt('Add as folder');
1.1055    raeburn  12891:             }
1.1056    raeburn  12892:         } else {
                   12893:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   12894: 
                   12895:         }
                   12896:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   12897:         if ($action eq 'dependency') {
                   12898:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   12899:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   12900:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   12901:                        '<option value=""></option>'."\n".
                   12902:                        '</select>'."\n".
                   12903:                        '</div>';
1.1059    raeburn  12904:         } elsif ($action eq 'display') {
                   12905:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   12906:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   12907:                        '</div>';
1.1055    raeburn  12908:         }
1.1056    raeburn  12909:         $output .= '</td>';
1.1055    raeburn  12910:     }
                   12911:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   12912:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   12913:     for (my $i=0; $i<$depth; $i++) {
                   12914:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   12915:     }
                   12916:     if ($is_dir) {
                   12917:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   12918:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   12919:     } else {
                   12920:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   12921:     }
                   12922:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   12923:                &end_data_table_row();
                   12924:     return $output;
                   12925: }
                   12926: 
                   12927: sub archive_options_form {
1.1065    raeburn  12928:     my ($form,$display,$count,$hiddenelem) = @_;
                   12929:     my %lt = &Apache::lonlocal::texthash(
                   12930:                perm => 'Permanently remove archive file?',
                   12931:                hows => 'How should each extracted item be incorporated in the course?',
                   12932:                cont => 'Content actions for all',
                   12933:                addf => 'Add as folder/file',
                   12934:                incd => 'Include as dependency for a displayed file',
                   12935:                disc => 'Discard',
                   12936:                no   => 'No',
                   12937:                yes  => 'Yes',
                   12938:                save => 'Save',
                   12939:     );
                   12940:     my $output = <<"END";
                   12941: <form name="$form" method="post" action="">
                   12942: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   12943: <label>
                   12944:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   12945: </label>
                   12946: &nbsp;
                   12947: <label>
                   12948:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   12949: </span>
                   12950: </p>
                   12951: <input type="hidden" name="phase" value="decompress_cleanup" />
                   12952: <br />$lt{'hows'}
                   12953: <div class="LC_columnSection">
                   12954:   <fieldset>
                   12955:     <legend>$lt{'cont'}</legend>
                   12956:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   12957:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   12958:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   12959:   </fieldset>
                   12960: </div>
                   12961: END
                   12962:     return $output.
1.1055    raeburn  12963:            &start_data_table()."\n".
1.1065    raeburn  12964:            $display."\n".
1.1055    raeburn  12965:            &end_data_table()."\n".
                   12966:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   12967:            $hiddenelem.
1.1065    raeburn  12968:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  12969:            '</form>';
                   12970: }
                   12971: 
                   12972: sub archive_javascript {
1.1056    raeburn  12973:     my ($startcount,$numitems,$titles,$children) = @_;
                   12974:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  12975:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  12976:     my $scripttag = <<START;
                   12977: <script type="text/javascript">
                   12978: // <![CDATA[
                   12979: 
                   12980: function checkAll(form,prefix) {
                   12981:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   12982:     for (var i=0; i < form.elements.length; i++) {
                   12983:         var id = form.elements[i].id;
                   12984:         if ((id != '') && (id != undefined)) {
                   12985:             if (idstr.test(id)) {
                   12986:                 if (form.elements[i].type == 'radio') {
                   12987:                     form.elements[i].checked = true;
1.1056    raeburn  12988:                     var nostart = i-$startcount;
1.1059    raeburn  12989:                     var offset = nostart%7;
                   12990:                     var count = (nostart-offset)/7;    
1.1056    raeburn  12991:                     dependencyCheck(form,count,offset);
1.1055    raeburn  12992:                 }
                   12993:             }
                   12994:         }
                   12995:     }
                   12996: }
                   12997: 
                   12998: function propagateCheck(form,count) {
                   12999:     if (count > 0) {
1.1059    raeburn  13000:         var startelement = $startcount + ((count-1) * 7);
                   13001:         for (var j=1; j<6; j++) {
                   13002:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  13003:                 var item = startelement + j; 
                   13004:                 if (form.elements[item].type == 'radio') {
                   13005:                     if (form.elements[item].checked) {
                   13006:                         containerCheck(form,count,j);
                   13007:                         break;
                   13008:                     }
1.1055    raeburn  13009:                 }
                   13010:             }
                   13011:         }
                   13012:     }
                   13013: }
                   13014: 
                   13015: numitems = $numitems
1.1056    raeburn  13016: var titles = new Array(numitems);
                   13017: var parents = new Array(numitems);
1.1055    raeburn  13018: for (var i=0; i<numitems; i++) {
1.1056    raeburn  13019:     parents[i] = new Array;
1.1055    raeburn  13020: }
1.1059    raeburn  13021: var maintitle = '$maintitle';
1.1055    raeburn  13022: 
                   13023: START
                   13024: 
1.1056    raeburn  13025:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   13026:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  13027:         for (my $i=0; $i<@contents; $i ++) {
                   13028:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   13029:         }
                   13030:     }
                   13031: 
1.1056    raeburn  13032:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   13033:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   13034:     }
                   13035: 
1.1055    raeburn  13036:     $scripttag .= <<END;
                   13037: 
                   13038: function containerCheck(form,count,offset) {
                   13039:     if (count > 0) {
1.1056    raeburn  13040:         dependencyCheck(form,count,offset);
1.1059    raeburn  13041:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  13042:         form.elements[item].checked = true;
                   13043:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   13044:             if (parents[count].length > 0) {
                   13045:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  13046:                     containerCheck(form,parents[count][j],offset);
                   13047:                 }
                   13048:             }
                   13049:         }
                   13050:     }
                   13051: }
                   13052: 
                   13053: function dependencyCheck(form,count,offset) {
                   13054:     if (count > 0) {
1.1059    raeburn  13055:         var chosen = (offset+$startcount)+7*(count-1);
                   13056:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  13057:         var currtype = form.elements[depitem].type;
                   13058:         if (form.elements[chosen].value == 'dependency') {
                   13059:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   13060:             form.elements[depitem].options.length = 0;
                   13061:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085    raeburn  13062:             for (var i=1; i<=numitems; i++) {
                   13063:                 if (i == count) {
                   13064:                     continue;
                   13065:                 }
1.1059    raeburn  13066:                 var startelement = $startcount + (i-1) * 7;
                   13067:                 for (var j=1; j<6; j++) {
                   13068:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  13069:                         var item = startelement + j;
                   13070:                         if (form.elements[item].type == 'radio') {
                   13071:                             if (form.elements[item].checked) {
                   13072:                                 if (form.elements[item].value == 'display') {
                   13073:                                     var n = form.elements[depitem].options.length;
                   13074:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   13075:                                 }
                   13076:                             }
                   13077:                         }
                   13078:                     }
                   13079:                 }
                   13080:             }
                   13081:         } else {
                   13082:             document.getElementById('arc_depon_'+count).style.display='none';
                   13083:             form.elements[depitem].options.length = 0;
                   13084:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   13085:         }
1.1059    raeburn  13086:         titleCheck(form,count,offset);
1.1056    raeburn  13087:     }
                   13088: }
                   13089: 
                   13090: function propagateSelect(form,count,offset) {
                   13091:     if (count > 0) {
1.1065    raeburn  13092:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  13093:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   13094:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   13095:             if (parents[count].length > 0) {
                   13096:                 for (var j=0; j<parents[count].length; j++) {
                   13097:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  13098:                 }
                   13099:             }
                   13100:         }
                   13101:     }
                   13102: }
1.1056    raeburn  13103: 
                   13104: function containerSelect(form,count,offset,picked) {
                   13105:     if (count > 0) {
1.1065    raeburn  13106:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  13107:         if (form.elements[item].type == 'radio') {
                   13108:             if (form.elements[item].value == 'dependency') {
                   13109:                 if (form.elements[item+1].type == 'select-one') {
                   13110:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   13111:                         if (form.elements[item+1].options[i].value == picked) {
                   13112:                             form.elements[item+1].selectedIndex = i;
                   13113:                             break;
                   13114:                         }
                   13115:                     }
                   13116:                 }
                   13117:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   13118:                     if (parents[count].length > 0) {
                   13119:                         for (var j=0; j<parents[count].length; j++) {
                   13120:                             containerSelect(form,parents[count][j],offset,picked);
                   13121:                         }
                   13122:                     }
                   13123:                 }
                   13124:             }
                   13125:         }
                   13126:     }
                   13127: }
                   13128: 
1.1059    raeburn  13129: function titleCheck(form,count,offset) {
                   13130:     if (count > 0) {
                   13131:         var chosen = (offset+$startcount)+7*(count-1);
                   13132:         var depitem = $startcount + ((count-1) * 7) + 2;
                   13133:         var currtype = form.elements[depitem].type;
                   13134:         if (form.elements[chosen].value == 'display') {
                   13135:             document.getElementById('arc_title_'+count).style.display='block';
                   13136:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   13137:                 document.getElementById('archive_title_'+count).value=maintitle;
                   13138:             }
                   13139:         } else {
                   13140:             document.getElementById('arc_title_'+count).style.display='none';
                   13141:             if (currtype == 'text') { 
                   13142:                 document.getElementById('archive_title_'+count).value='';
                   13143:             }
                   13144:         }
                   13145:     }
                   13146:     return;
                   13147: }
                   13148: 
1.1055    raeburn  13149: // ]]>
                   13150: </script>
                   13151: END
                   13152:     return $scripttag;
                   13153: }
                   13154: 
                   13155: sub process_extracted_files {
1.1067    raeburn  13156:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  13157:     my $numitems = $env{'form.archive_count'};
                   13158:     return unless ($numitems);
                   13159:     my @ids=&Apache::lonnet::current_machine_ids();
                   13160:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  13161:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  13162:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   13163:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   13164:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   13165:         $pathtocheck = "$dir_root/$destination";
                   13166:         $dir = $dir_root;
                   13167:         $ishome = 1;
                   13168:     } else {
                   13169:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   13170:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   13171:         $dir = "$dir_root/$docudom/$docuname";    
                   13172:     }
                   13173:     my $currdir = "$dir_root/$destination";
                   13174:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   13175:     if ($env{'form.folderpath'}) {
                   13176:         my @items = split('&',$env{'form.folderpath'});
                   13177:         $folders{'0'} = $items[-2];
1.1099    raeburn  13178:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   13179:             $containers{'0'}='page';
                   13180:         } else {  
                   13181:             $containers{'0'}='sequence';
                   13182:         }
1.1055    raeburn  13183:     }
                   13184:     my @archdirs = &get_env_multiple('form.archive_directory');
                   13185:     if ($numitems) {
                   13186:         for (my $i=1; $i<=$numitems; $i++) {
                   13187:             my $path = $env{'form.archive_content_'.$i};
                   13188:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   13189:                 my $item = $1;
                   13190:                 $toplevelitems{$item} = $i;
                   13191:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   13192:                     $is_dir{$item} = 1;
                   13193:                 }
                   13194:             }
                   13195:         }
                   13196:     }
1.1067    raeburn  13197:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  13198:     if (keys(%toplevelitems) > 0) {
                   13199:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  13200:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   13201:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  13202:     }
1.1066    raeburn  13203:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  13204:     if ($numitems) {
                   13205:         for (my $i=1; $i<=$numitems; $i++) {
1.1086    raeburn  13206:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  13207:             my $path = $env{'form.archive_content_'.$i};
                   13208:             if ($path =~ /^\Q$pathtocheck\E/) {
                   13209:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   13210:                     if ($prefix ne '' && $path ne '') {
                   13211:                         if (-e $prefix.$path) {
1.1066    raeburn  13212:                             if ((@archdirs > 0) && 
                   13213:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   13214:                                 $todeletedir{$prefix.$path} = 1;
                   13215:                             } else {
                   13216:                                 $todelete{$prefix.$path} = 1;
                   13217:                             }
1.1055    raeburn  13218:                         }
                   13219:                     }
                   13220:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  13221:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  13222:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  13223:                     $docstitle = $env{'form.archive_title_'.$i};
                   13224:                     if ($docstitle eq '') {
                   13225:                         $docstitle = $title;
                   13226:                     }
1.1055    raeburn  13227:                     $outer = 0;
1.1056    raeburn  13228:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   13229:                         if (@{$dirorder{$i}} > 0) {
                   13230:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  13231:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   13232:                                     $outer = $item;
                   13233:                                     last;
                   13234:                                 }
                   13235:                             }
                   13236:                         }
                   13237:                     }
                   13238:                     my ($errtext,$fatal) = 
                   13239:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   13240:                                                '/'.$folders{$outer}.'.'.
                   13241:                                                $containers{$outer});
                   13242:                     next if ($fatal);
                   13243:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   13244:                         if ($context eq 'coursedocs') {
1.1056    raeburn  13245:                             $mapinner{$i} = time;
1.1055    raeburn  13246:                             $folders{$i} = 'default_'.$mapinner{$i};
                   13247:                             $containers{$i} = 'sequence';
                   13248:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   13249:                                       $folders{$i}.'.'.$containers{$i};
                   13250:                             my $newidx = &LONCAPA::map::getresidx();
                   13251:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  13252:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  13253:                             push(@LONCAPA::map::order,$newidx);
                   13254:                             my ($outtext,$errtext) =
                   13255:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   13256:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  13257:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  13258:                             $newseqid{$i} = $newidx;
1.1067    raeburn  13259:                             unless ($errtext) {
                   13260:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   13261:                             }
1.1055    raeburn  13262:                         }
                   13263:                     } else {
                   13264:                         if ($context eq 'coursedocs') {
                   13265:                             my $newidx=&LONCAPA::map::getresidx();
                   13266:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   13267:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   13268:                                       $title;
                   13269:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   13270:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   13271:                             }
                   13272:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   13273:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   13274:                             }
                   13275:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   13276:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  13277:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  13278:                                 unless ($ishome) {
                   13279:                                     my $fetch = "$newdest{$i}/$title";
                   13280:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   13281:                                     $prompttofetch{$fetch} = 1;
                   13282:                                 }
1.1055    raeburn  13283:                             }
                   13284:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  13285:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  13286:                             push(@LONCAPA::map::order, $newidx);
                   13287:                             my ($outtext,$errtext)=
                   13288:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   13289:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  13290:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  13291:                             unless ($errtext) {
                   13292:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   13293:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   13294:                                 }
                   13295:                             }
1.1055    raeburn  13296:                         }
                   13297:                     }
1.1086    raeburn  13298:                 }
                   13299:             } else {
                   13300:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   13301:             }
                   13302:         }
                   13303:         for (my $i=1; $i<=$numitems; $i++) {
                   13304:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   13305:             my $path = $env{'form.archive_content_'.$i};
                   13306:             if ($path =~ /^\Q$pathtocheck\E/) {
                   13307:                 my ($title) = ($path =~ m{/([^/]+)$});
                   13308:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   13309:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   13310:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   13311:                         my ($itemidx,$fullpath,$relpath);
                   13312:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   13313:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  13314:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086    raeburn  13315:                                 if ($dirorder{$i}->[$j] eq $container) {
                   13316:                                     $itemidx = $j;
1.1056    raeburn  13317:                                 }
                   13318:                             }
1.1086    raeburn  13319:                         }
                   13320:                         if ($itemidx eq '') {
                   13321:                             $itemidx =  0;
                   13322:                         } 
                   13323:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   13324:                             if ($mapinner{$referrer{$i}}) {
                   13325:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   13326:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   13327:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   13328:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   13329:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   13330:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   13331:                                             if (!-e $fullpath) {
                   13332:                                                 mkdir($fullpath,0755);
1.1056    raeburn  13333:                                             }
                   13334:                                         }
1.1086    raeburn  13335:                                     } else {
                   13336:                                         last;
1.1056    raeburn  13337:                                     }
1.1086    raeburn  13338:                                 }
                   13339:                             }
                   13340:                         } elsif ($newdest{$referrer{$i}}) {
                   13341:                             $fullpath = $newdest{$referrer{$i}};
                   13342:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   13343:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   13344:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   13345:                                     last;
                   13346:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   13347:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   13348:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   13349:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   13350:                                         if (!-e $fullpath) {
                   13351:                                             mkdir($fullpath,0755);
1.1056    raeburn  13352:                                         }
                   13353:                                     }
1.1086    raeburn  13354:                                 } else {
                   13355:                                     last;
1.1056    raeburn  13356:                                 }
1.1055    raeburn  13357:                             }
                   13358:                         }
1.1086    raeburn  13359:                         if ($fullpath ne '') {
                   13360:                             if (-e "$prefix$path") {
                   13361:                                 system("mv $prefix$path $fullpath/$title");
                   13362:                             }
                   13363:                             if (-e "$fullpath/$title") {
                   13364:                                 my $showpath;
                   13365:                                 if ($relpath ne '') {
                   13366:                                     $showpath = "$relpath/$title";
                   13367:                                 } else {
                   13368:                                     $showpath = "/$title";
                   13369:                                 } 
                   13370:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   13371:                             } 
                   13372:                             unless ($ishome) {
                   13373:                                 my $fetch = "$fullpath/$title";
                   13374:                                 $fetch =~ s/^\Q$prefix$dir\E//; 
                   13375:                                 $prompttofetch{$fetch} = 1;
                   13376:                             }
                   13377:                         }
1.1055    raeburn  13378:                     }
1.1086    raeburn  13379:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   13380:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   13381:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  13382:                 }
                   13383:             } else {
                   13384:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   13385:             }
                   13386:         }
                   13387:         if (keys(%todelete)) {
                   13388:             foreach my $key (keys(%todelete)) {
                   13389:                 unlink($key);
1.1066    raeburn  13390:             }
                   13391:         }
                   13392:         if (keys(%todeletedir)) {
                   13393:             foreach my $key (keys(%todeletedir)) {
                   13394:                 rmdir($key);
                   13395:             }
                   13396:         }
                   13397:         foreach my $dir (sort(keys(%is_dir))) {
                   13398:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   13399:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  13400:             }
                   13401:         }
1.1067    raeburn  13402:         if ($result ne '') {
                   13403:             $output .= '<ul>'."\n".
                   13404:                        $result."\n".
                   13405:                        '</ul>';
                   13406:         }
                   13407:         unless ($ishome) {
                   13408:             my $replicationfail;
                   13409:             foreach my $item (keys(%prompttofetch)) {
                   13410:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   13411:                 unless ($fetchresult eq 'ok') {
                   13412:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   13413:                 }
                   13414:             }
                   13415:             if ($replicationfail) {
                   13416:                 $output .= '<p class="LC_error">'.
                   13417:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   13418:                            $replicationfail.
                   13419:                            '</ul></p>';
                   13420:             }
                   13421:         }
1.1055    raeburn  13422:     } else {
                   13423:         $warning = &mt('No items found in archive.');
                   13424:     }
                   13425:     if ($error) {
                   13426:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   13427:                    $error.'</p>'."\n";
                   13428:     }
                   13429:     if ($warning) {
                   13430:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   13431:     }
                   13432:     return $output;
                   13433: }
                   13434: 
1.1066    raeburn  13435: sub cleanup_empty_dirs {
                   13436:     my ($path) = @_;
                   13437:     if (($path ne '') && (-d $path)) {
                   13438:         if (opendir(my $dirh,$path)) {
                   13439:             my @dircontents = grep(!/^\./,readdir($dirh));
                   13440:             my $numitems = 0;
                   13441:             foreach my $item (@dircontents) {
                   13442:                 if (-d "$path/$item") {
1.1111    raeburn  13443:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  13444:                     if (-e "$path/$item") {
                   13445:                         $numitems ++;
                   13446:                     }
                   13447:                 } else {
                   13448:                     $numitems ++;
                   13449:                 }
                   13450:             }
                   13451:             if ($numitems == 0) {
                   13452:                 rmdir($path);
                   13453:             }
                   13454:             closedir($dirh);
                   13455:         }
                   13456:     }
                   13457:     return;
                   13458: }
                   13459: 
1.41      ng       13460: =pod
1.45      matthew  13461: 
1.1162    raeburn  13462: =item * &get_folder_hierarchy()
1.1068    raeburn  13463: 
                   13464: Provides hierarchy of names of folders/sub-folders containing the current
                   13465: item,
                   13466: 
                   13467: Inputs: 3
                   13468:      - $navmap - navmaps object
                   13469: 
                   13470:      - $map - url for map (either the trigger itself, or map containing
                   13471:                            the resource, which is the trigger).
                   13472: 
                   13473:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   13474: 
                   13475: Outputs: 1 @pathitems - array of folder/subfolder names.
                   13476: 
                   13477: =cut
                   13478: 
                   13479: sub get_folder_hierarchy {
                   13480:     my ($navmap,$map,$showitem) = @_;
                   13481:     my @pathitems;
                   13482:     if (ref($navmap)) {
                   13483:         my $mapres = $navmap->getResourceByUrl($map);
                   13484:         if (ref($mapres)) {
                   13485:             my $pcslist = $mapres->map_hierarchy();
                   13486:             if ($pcslist ne '') {
                   13487:                 my @pcs = split(/,/,$pcslist);
                   13488:                 foreach my $pc (@pcs) {
                   13489:                     if ($pc == 1) {
1.1129    raeburn  13490:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  13491:                     } else {
                   13492:                         my $res = $navmap->getByMapPc($pc);
                   13493:                         if (ref($res)) {
                   13494:                             my $title = $res->compTitle();
                   13495:                             $title =~ s/\W+/_/g;
                   13496:                             if ($title ne '') {
                   13497:                                 push(@pathitems,$title);
                   13498:                             }
                   13499:                         }
                   13500:                     }
                   13501:                 }
                   13502:             }
1.1071    raeburn  13503:             if ($showitem) {
                   13504:                 if ($mapres->{ID} eq '0.0') {
1.1129    raeburn  13505:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  13506:                 } else {
                   13507:                     my $maptitle = $mapres->compTitle();
                   13508:                     $maptitle =~ s/\W+/_/g;
                   13509:                     if ($maptitle ne '') {
                   13510:                         push(@pathitems,$maptitle);
                   13511:                     }
1.1068    raeburn  13512:                 }
                   13513:             }
                   13514:         }
                   13515:     }
                   13516:     return @pathitems;
                   13517: }
                   13518: 
                   13519: =pod
                   13520: 
1.1015    raeburn  13521: =item * &get_turnedin_filepath()
                   13522: 
                   13523: Determines path in a user's portfolio file for storage of files uploaded
                   13524: to a specific essayresponse or dropbox item.
                   13525: 
                   13526: Inputs: 3 required + 1 optional.
                   13527: $symb is symb for resource, $uname and $udom are for current user (required).
                   13528: $caller is optional (can be "submission", if routine is called when storing
                   13529: an upoaded file when "Submit Answer" button was pressed).
                   13530: 
                   13531: Returns array containing $path and $multiresp. 
                   13532: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   13533: than one file upload item.  Callers of routine should append partid as a 
                   13534: subdirectory to $path in cases where $multiresp is 1.
                   13535: 
                   13536: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   13537: 
                   13538: =cut
                   13539: 
                   13540: sub get_turnedin_filepath {
                   13541:     my ($symb,$uname,$udom,$caller) = @_;
                   13542:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   13543:     my $turnindir;
                   13544:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   13545:     $turnindir = $userhash{'turnindir'};
                   13546:     my ($path,$multiresp);
                   13547:     if ($turnindir eq '') {
                   13548:         if ($caller eq 'submission') {
                   13549:             $turnindir = &mt('turned in');
                   13550:             $turnindir =~ s/\W+/_/g;
                   13551:             my %newhash = (
                   13552:                             'turnindir' => $turnindir,
                   13553:                           );
                   13554:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   13555:         }
                   13556:     }
                   13557:     if ($turnindir ne '') {
                   13558:         $path = '/'.$turnindir.'/';
                   13559:         my ($multipart,$turnin,@pathitems);
                   13560:         my $navmap = Apache::lonnavmaps::navmap->new();
                   13561:         if (defined($navmap)) {
                   13562:             my $mapres = $navmap->getResourceByUrl($map);
                   13563:             if (ref($mapres)) {
                   13564:                 my $pcslist = $mapres->map_hierarchy();
                   13565:                 if ($pcslist ne '') {
                   13566:                     foreach my $pc (split(/,/,$pcslist)) {
                   13567:                         my $res = $navmap->getByMapPc($pc);
                   13568:                         if (ref($res)) {
                   13569:                             my $title = $res->compTitle();
                   13570:                             $title =~ s/\W+/_/g;
                   13571:                             if ($title ne '') {
1.1149    raeburn  13572:                                 if (($pc > 1) && (length($title) > 12)) {
                   13573:                                     $title = substr($title,0,12);
                   13574:                                 }
1.1015    raeburn  13575:                                 push(@pathitems,$title);
                   13576:                             }
                   13577:                         }
                   13578:                     }
                   13579:                 }
                   13580:                 my $maptitle = $mapres->compTitle();
                   13581:                 $maptitle =~ s/\W+/_/g;
                   13582:                 if ($maptitle ne '') {
1.1149    raeburn  13583:                     if (length($maptitle) > 12) {
                   13584:                         $maptitle = substr($maptitle,0,12);
                   13585:                     }
1.1015    raeburn  13586:                     push(@pathitems,$maptitle);
                   13587:                 }
                   13588:                 unless ($env{'request.state'} eq 'construct') {
                   13589:                     my $res = $navmap->getBySymb($symb);
                   13590:                     if (ref($res)) {
                   13591:                         my $partlist = $res->parts();
                   13592:                         my $totaluploads = 0;
                   13593:                         if (ref($partlist) eq 'ARRAY') {
                   13594:                             foreach my $part (@{$partlist}) {
                   13595:                                 my @types = $res->responseType($part);
                   13596:                                 my @ids = $res->responseIds($part);
                   13597:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   13598:                                     if ($types[$i] eq 'essay') {
                   13599:                                         my $partid = $part.'_'.$ids[$i];
                   13600:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   13601:                                             $totaluploads ++;
                   13602:                                         }
                   13603:                                     }
                   13604:                                 }
                   13605:                             }
                   13606:                             if ($totaluploads > 1) {
                   13607:                                 $multiresp = 1;
                   13608:                             }
                   13609:                         }
                   13610:                     }
                   13611:                 }
                   13612:             } else {
                   13613:                 return;
                   13614:             }
                   13615:         } else {
                   13616:             return;
                   13617:         }
                   13618:         my $restitle=&Apache::lonnet::gettitle($symb);
                   13619:         $restitle =~ s/\W+/_/g;
                   13620:         if ($restitle eq '') {
                   13621:             $restitle = ($resurl =~ m{/[^/]+$});
                   13622:             if ($restitle eq '') {
                   13623:                 $restitle = time;
                   13624:             }
                   13625:         }
1.1149    raeburn  13626:         if (length($restitle) > 12) {
                   13627:             $restitle = substr($restitle,0,12);
                   13628:         }
1.1015    raeburn  13629:         push(@pathitems,$restitle);
                   13630:         $path .= join('/',@pathitems);
                   13631:     }
                   13632:     return ($path,$multiresp);
                   13633: }
                   13634: 
                   13635: =pod
                   13636: 
1.464     albertel 13637: =back
1.41      ng       13638: 
1.112     bowersj2 13639: =head1 CSV Upload/Handling functions
1.38      albertel 13640: 
1.41      ng       13641: =over 4
                   13642: 
1.648     raeburn  13643: =item * &upfile_store($r)
1.41      ng       13644: 
                   13645: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 13646: needs $env{'form.upfile'}
1.41      ng       13647: returns $datatoken to be put into hidden field
                   13648: 
                   13649: =cut
1.31      albertel 13650: 
                   13651: sub upfile_store {
                   13652:     my $r=shift;
1.258     albertel 13653:     $env{'form.upfile'}=~s/\r/\n/gs;
                   13654:     $env{'form.upfile'}=~s/\f/\n/gs;
                   13655:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   13656:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 13657: 
1.258     albertel 13658:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   13659: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 13660:     {
1.158     raeburn  13661:         my $datafile = $r->dir_config('lonDaemons').
                   13662:                            '/tmp/'.$datatoken.'.tmp';
                   13663:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 13664:             print $fh $env{'form.upfile'};
1.158     raeburn  13665:             close($fh);
                   13666:         }
1.31      albertel 13667:     }
                   13668:     return $datatoken;
                   13669: }
                   13670: 
1.56      matthew  13671: =pod
                   13672: 
1.1290    raeburn  13673: =item * &load_tmp_file($r,$datatoken)
1.41      ng       13674: 
                   13675: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1290    raeburn  13676: $datatoken is the name to assign to the temporary file.
1.258     albertel 13677: sets $env{'form.upfile'} to the contents of the file
1.41      ng       13678: 
                   13679: =cut
1.31      albertel 13680: 
                   13681: sub load_tmp_file {
1.1290    raeburn  13682:     my ($r,$datatoken) = @_;
                   13683:     return if ($datatoken eq '');
1.31      albertel 13684:     my @studentdata=();
                   13685:     {
1.158     raeburn  13686:         my $studentfile = $r->dir_config('lonDaemons').
1.1290    raeburn  13687:                               '/tmp/'.$datatoken.'.tmp';
1.158     raeburn  13688:         if ( open(my $fh,"<$studentfile") ) {
                   13689:             @studentdata=<$fh>;
                   13690:             close($fh);
                   13691:         }
1.31      albertel 13692:     }
1.258     albertel 13693:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 13694: }
                   13695: 
1.1290    raeburn  13696: sub valid_datatoken {
                   13697:     my ($datatoken) = @_;
1.1291  ! raeburn  13698:     if ($datatoken =~ /^$match_username\_$match_domain\_enroll_$match_domain\_$match_courseid\_\d+_\d+$/) {
1.1290    raeburn  13699:         return $datatoken;
                   13700:     }
                   13701:     return;
                   13702: }
                   13703: 
1.56      matthew  13704: =pod
                   13705: 
1.648     raeburn  13706: =item * &upfile_record_sep()
1.41      ng       13707: 
                   13708: Separate uploaded file into records
                   13709: returns array of records,
1.258     albertel 13710: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       13711: 
                   13712: =cut
1.31      albertel 13713: 
                   13714: sub upfile_record_sep {
1.258     albertel 13715:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 13716:     } else {
1.248     albertel 13717: 	my @records;
1.258     albertel 13718: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 13719: 	    if ($line=~/^\s*$/) { next; }
                   13720: 	    push(@records,$line);
                   13721: 	}
                   13722: 	return @records;
1.31      albertel 13723:     }
                   13724: }
                   13725: 
1.56      matthew  13726: =pod
                   13727: 
1.648     raeburn  13728: =item * &record_sep($record)
1.41      ng       13729: 
1.258     albertel 13730: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       13731: 
                   13732: =cut
                   13733: 
1.263     www      13734: sub takeleft {
                   13735:     my $index=shift;
                   13736:     return substr('0000'.$index,-4,4);
                   13737: }
                   13738: 
1.31      albertel 13739: sub record_sep {
                   13740:     my $record=shift;
                   13741:     my %components=();
1.258     albertel 13742:     if ($env{'form.upfiletype'} eq 'xml') {
                   13743:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 13744:         my $i=0;
1.356     albertel 13745:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 13746:             $field=~s/^(\"|\')//;
                   13747:             $field=~s/(\"|\')$//;
1.263     www      13748:             $components{&takeleft($i)}=$field;
1.31      albertel 13749:             $i++;
                   13750:         }
1.258     albertel 13751:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 13752:         my $i=0;
1.356     albertel 13753:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 13754:             $field=~s/^(\"|\')//;
                   13755:             $field=~s/(\"|\')$//;
1.263     www      13756:             $components{&takeleft($i)}=$field;
1.31      albertel 13757:             $i++;
                   13758:         }
                   13759:     } else {
1.561     www      13760:         my $separator=',';
1.480     banghart 13761:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      13762:             $separator=';';
1.480     banghart 13763:         }
1.31      albertel 13764:         my $i=0;
1.561     www      13765: # the character we are looking for to indicate the end of a quote or a record 
                   13766:         my $looking_for=$separator;
                   13767: # do not add the characters to the fields
                   13768:         my $ignore=0;
                   13769: # we just encountered a separator (or the beginning of the record)
                   13770:         my $just_found_separator=1;
                   13771: # store the field we are working on here
                   13772:         my $field='';
                   13773: # work our way through all characters in record
                   13774:         foreach my $character ($record=~/(.)/g) {
                   13775:             if ($character eq $looking_for) {
                   13776:                if ($character ne $separator) {
                   13777: # Found the end of a quote, again looking for separator
                   13778:                   $looking_for=$separator;
                   13779:                   $ignore=1;
                   13780:                } else {
                   13781: # Found a separator, store away what we got
                   13782:                   $components{&takeleft($i)}=$field;
                   13783: 	          $i++;
                   13784:                   $just_found_separator=1;
                   13785:                   $ignore=0;
                   13786:                   $field='';
                   13787:                }
                   13788:                next;
                   13789:             }
                   13790: # single or double quotation marks after a separator indicate beginning of a quote
                   13791: # we are now looking for the end of the quote and need to ignore separators
                   13792:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   13793:                $looking_for=$character;
                   13794:                next;
                   13795:             }
                   13796: # ignore would be true after we reached the end of a quote
                   13797:             if ($ignore) { next; }
                   13798:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   13799:             $field.=$character;
                   13800:             $just_found_separator=0; 
1.31      albertel 13801:         }
1.561     www      13802: # catch the very last entry, since we never encountered the separator
                   13803:         $components{&takeleft($i)}=$field;
1.31      albertel 13804:     }
                   13805:     return %components;
                   13806: }
                   13807: 
1.144     matthew  13808: ######################################################
                   13809: ######################################################
                   13810: 
1.56      matthew  13811: =pod
                   13812: 
1.648     raeburn  13813: =item * &upfile_select_html()
1.41      ng       13814: 
1.144     matthew  13815: Return HTML code to select a file from the users machine and specify 
                   13816: the file type.
1.41      ng       13817: 
                   13818: =cut
                   13819: 
1.144     matthew  13820: ######################################################
                   13821: ######################################################
1.31      albertel 13822: sub upfile_select_html {
1.144     matthew  13823:     my %Types = (
                   13824:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 13825:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  13826:                  space => &mt('Space separated'),
                   13827:                  tab   => &mt('Tabulator separated'),
                   13828: #                 xml   => &mt('HTML/XML'),
                   13829:                  );
                   13830:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  13831:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  13832:     foreach my $type (sort(keys(%Types))) {
                   13833:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   13834:     }
                   13835:     $Str .= "</select>\n";
                   13836:     return $Str;
1.31      albertel 13837: }
                   13838: 
1.301     albertel 13839: sub get_samples {
                   13840:     my ($records,$toget) = @_;
                   13841:     my @samples=({});
                   13842:     my $got=0;
                   13843:     foreach my $rec (@$records) {
                   13844: 	my %temp = &record_sep($rec);
                   13845: 	if (! grep(/\S/, values(%temp))) { next; }
                   13846: 	if (%temp) {
                   13847: 	    $samples[$got]=\%temp;
                   13848: 	    $got++;
                   13849: 	    if ($got == $toget) { last; }
                   13850: 	}
                   13851:     }
                   13852:     return \@samples;
                   13853: }
                   13854: 
1.144     matthew  13855: ######################################################
                   13856: ######################################################
                   13857: 
1.56      matthew  13858: =pod
                   13859: 
1.648     raeburn  13860: =item * &csv_print_samples($r,$records)
1.41      ng       13861: 
                   13862: Prints a table of sample values from each column uploaded $r is an
                   13863: Apache Request ref, $records is an arrayref from
                   13864: &Apache::loncommon::upfile_record_sep
                   13865: 
                   13866: =cut
                   13867: 
1.144     matthew  13868: ######################################################
                   13869: ######################################################
1.31      albertel 13870: sub csv_print_samples {
                   13871:     my ($r,$records) = @_;
1.662     bisitz   13872:     my $samples = &get_samples($records,5);
1.301     albertel 13873: 
1.594     raeburn  13874:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   13875:               &start_data_table_header_row());
1.356     albertel 13876:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   13877:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  13878:     $r->print(&end_data_table_header_row());
1.301     albertel 13879:     foreach my $hash (@$samples) {
1.594     raeburn  13880: 	$r->print(&start_data_table_row());
1.356     albertel 13881: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 13882: 	    $r->print('<td>');
1.356     albertel 13883: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 13884: 	    $r->print('</td>');
                   13885: 	}
1.594     raeburn  13886: 	$r->print(&end_data_table_row());
1.31      albertel 13887:     }
1.594     raeburn  13888:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 13889: }
                   13890: 
1.144     matthew  13891: ######################################################
                   13892: ######################################################
                   13893: 
1.56      matthew  13894: =pod
                   13895: 
1.648     raeburn  13896: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       13897: 
                   13898: Prints a table to create associations between values and table columns.
1.144     matthew  13899: 
1.41      ng       13900: $r is an Apache Request ref,
                   13901: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  13902: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       13903: 
                   13904: =cut
                   13905: 
1.144     matthew  13906: ######################################################
                   13907: ######################################################
1.31      albertel 13908: sub csv_print_select_table {
                   13909:     my ($r,$records,$d) = @_;
1.301     albertel 13910:     my $i=0;
                   13911:     my $samples = &get_samples($records,1);
1.144     matthew  13912:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  13913: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  13914:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  13915:               '<th>'.&mt('Column').'</th>'.
                   13916:               &end_data_table_header_row()."\n");
1.356     albertel 13917:     foreach my $array_ref (@$d) {
                   13918: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  13919: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 13920: 
1.875     bisitz   13921: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  13922: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 13923: 	$r->print('<option value="none"></option>');
1.356     albertel 13924: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   13925: 	    $r->print('<option value="'.$sample.'"'.
                   13926:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   13927:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 13928: 	}
1.594     raeburn  13929: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 13930: 	$i++;
                   13931:     }
1.594     raeburn  13932:     $r->print(&end_data_table());
1.31      albertel 13933:     $i--;
                   13934:     return $i;
                   13935: }
1.56      matthew  13936: 
1.144     matthew  13937: ######################################################
                   13938: ######################################################
                   13939: 
1.56      matthew  13940: =pod
1.31      albertel 13941: 
1.648     raeburn  13942: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       13943: 
                   13944: Prints a table of sample values from the upload and can make associate samples to internal names.
                   13945: 
                   13946: $r is an Apache Request ref,
                   13947: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   13948: $d is an array of 2 element arrays (internal name, displayed name)
                   13949: 
                   13950: =cut
                   13951: 
1.144     matthew  13952: ######################################################
                   13953: ######################################################
1.31      albertel 13954: sub csv_samples_select_table {
                   13955:     my ($r,$records,$d) = @_;
                   13956:     my $i=0;
1.144     matthew  13957:     #
1.662     bisitz   13958:     my $max_samples = 5;
                   13959:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  13960:     $r->print(&start_data_table().
                   13961:               &start_data_table_header_row().'<th>'.
                   13962:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   13963:               &end_data_table_header_row());
1.301     albertel 13964: 
                   13965:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  13966: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  13967: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 13968: 	foreach my $option (@$d) {
                   13969: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  13970: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 13971:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  13972:                       $display.'</option>');
1.31      albertel 13973: 	}
                   13974: 	$r->print('</select></td><td>');
1.662     bisitz   13975: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 13976: 	    if (defined($samples->[$line]{$key})) { 
                   13977: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   13978: 	    }
                   13979: 	}
1.594     raeburn  13980: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 13981: 	$i++;
                   13982:     }
1.594     raeburn  13983:     $r->print(&end_data_table());
1.31      albertel 13984:     $i--;
                   13985:     return($i);
1.115     matthew  13986: }
                   13987: 
1.144     matthew  13988: ######################################################
                   13989: ######################################################
                   13990: 
1.115     matthew  13991: =pod
                   13992: 
1.648     raeburn  13993: =item * &clean_excel_name($name)
1.115     matthew  13994: 
                   13995: Returns a replacement for $name which does not contain any illegal characters.
                   13996: 
                   13997: =cut
                   13998: 
1.144     matthew  13999: ######################################################
                   14000: ######################################################
1.115     matthew  14001: sub clean_excel_name {
                   14002:     my ($name) = @_;
                   14003:     $name =~ s/[:\*\?\/\\]//g;
                   14004:     if (length($name) > 31) {
                   14005:         $name = substr($name,0,31);
                   14006:     }
                   14007:     return $name;
1.25      albertel 14008: }
1.84      albertel 14009: 
1.85      albertel 14010: =pod
                   14011: 
1.648     raeburn  14012: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 14013: 
                   14014: Returns either 1 or undef
                   14015: 
                   14016: 1 if the part is to be hidden, undef if it is to be shown
                   14017: 
                   14018: Arguments are:
                   14019: 
                   14020: $id the id of the part to be checked
                   14021: $symb, optional the symb of the resource to check
                   14022: $udom, optional the domain of the user to check for
                   14023: $uname, optional the username of the user to check for
                   14024: 
                   14025: =cut
1.84      albertel 14026: 
                   14027: sub check_if_partid_hidden {
                   14028:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 14029:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 14030: 					 $symb,$udom,$uname);
1.141     albertel 14031:     my $truth=1;
                   14032:     #if the string starts with !, then the list is the list to show not hide
                   14033:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 14034:     my @hiddenlist=split(/,/,$hiddenparts);
                   14035:     foreach my $checkid (@hiddenlist) {
1.141     albertel 14036: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 14037:     }
1.141     albertel 14038:     return !$truth;
1.84      albertel 14039: }
1.127     matthew  14040: 
1.138     matthew  14041: 
                   14042: ############################################################
                   14043: ############################################################
                   14044: 
                   14045: =pod
                   14046: 
1.157     matthew  14047: =back 
                   14048: 
1.138     matthew  14049: =head1 cgi-bin script and graphing routines
                   14050: 
1.157     matthew  14051: =over 4
                   14052: 
1.648     raeburn  14053: =item * &get_cgi_id()
1.138     matthew  14054: 
                   14055: Inputs: none
                   14056: 
                   14057: Returns an id which can be used to pass environment variables
                   14058: to various cgi-bin scripts.  These environment variables will
                   14059: be removed from the users environment after a given time by
                   14060: the routine &Apache::lonnet::transfer_profile_to_env.
                   14061: 
                   14062: =cut
                   14063: 
                   14064: ############################################################
                   14065: ############################################################
1.152     albertel 14066: my $uniq=0;
1.136     matthew  14067: sub get_cgi_id {
1.154     albertel 14068:     $uniq=($uniq+1)%100000;
1.280     albertel 14069:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  14070: }
                   14071: 
1.127     matthew  14072: ############################################################
                   14073: ############################################################
                   14074: 
                   14075: =pod
                   14076: 
1.648     raeburn  14077: =item * &DrawBarGraph()
1.127     matthew  14078: 
1.138     matthew  14079: Facilitates the plotting of data in a (stacked) bar graph.
                   14080: Puts plot definition data into the users environment in order for 
                   14081: graph.png to plot it.  Returns an <img> tag for the plot.
                   14082: The bars on the plot are labeled '1','2',...,'n'.
                   14083: 
                   14084: Inputs:
                   14085: 
                   14086: =over 4
                   14087: 
                   14088: =item $Title: string, the title of the plot
                   14089: 
                   14090: =item $xlabel: string, text describing the X-axis of the plot
                   14091: 
                   14092: =item $ylabel: string, text describing the Y-axis of the plot
                   14093: 
                   14094: =item $Max: scalar, the maximum Y value to use in the plot
                   14095: If $Max is < any data point, the graph will not be rendered.
                   14096: 
1.140     matthew  14097: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  14098: they are plotted.  If undefined, default values will be used.
                   14099: 
1.178     matthew  14100: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   14101: 
1.138     matthew  14102: =item @Values: An array of array references.  Each array reference holds data
                   14103: to be plotted in a stacked bar chart.
                   14104: 
1.239     matthew  14105: =item If the final element of @Values is a hash reference the key/value
                   14106: pairs will be added to the graph definition.
                   14107: 
1.138     matthew  14108: =back
                   14109: 
                   14110: Returns:
                   14111: 
                   14112: An <img> tag which references graph.png and the appropriate identifying
                   14113: information for the plot.
                   14114: 
1.127     matthew  14115: =cut
                   14116: 
                   14117: ############################################################
                   14118: ############################################################
1.134     matthew  14119: sub DrawBarGraph {
1.178     matthew  14120:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  14121:     #
                   14122:     if (! defined($colors)) {
                   14123:         $colors = ['#33ff00', 
                   14124:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   14125:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   14126:                   ]; 
                   14127:     }
1.228     matthew  14128:     my $extra_settings = {};
                   14129:     if (ref($Values[-1]) eq 'HASH') {
                   14130:         $extra_settings = pop(@Values);
                   14131:     }
1.127     matthew  14132:     #
1.136     matthew  14133:     my $identifier = &get_cgi_id();
                   14134:     my $id = 'cgi.'.$identifier;        
1.129     matthew  14135:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  14136:         return '';
                   14137:     }
1.225     matthew  14138:     #
                   14139:     my @Labels;
                   14140:     if (defined($labels)) {
                   14141:         @Labels = @$labels;
                   14142:     } else {
                   14143:         for (my $i=0;$i<@{$Values[0]};$i++) {
1.1263    raeburn  14144:             push(@Labels,$i+1);
1.225     matthew  14145:         }
                   14146:     }
                   14147:     #
1.129     matthew  14148:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  14149:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  14150:     my %ValuesHash;
                   14151:     my $NumSets=1;
                   14152:     foreach my $array (@Values) {
                   14153:         next if (! ref($array));
1.136     matthew  14154:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  14155:             join(',',@$array);
1.129     matthew  14156:     }
1.127     matthew  14157:     #
1.136     matthew  14158:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  14159:     if ($NumBars < 3) {
                   14160:         $width = 120+$NumBars*32;
1.220     matthew  14161:         $xskip = 1;
1.225     matthew  14162:         $bar_width = 30;
                   14163:     } elsif ($NumBars < 5) {
                   14164:         $width = 120+$NumBars*20;
                   14165:         $xskip = 1;
                   14166:         $bar_width = 20;
1.220     matthew  14167:     } elsif ($NumBars < 10) {
1.136     matthew  14168:         $width = 120+$NumBars*15;
                   14169:         $xskip = 1;
                   14170:         $bar_width = 15;
                   14171:     } elsif ($NumBars <= 25) {
                   14172:         $width = 120+$NumBars*11;
                   14173:         $xskip = 5;
                   14174:         $bar_width = 8;
                   14175:     } elsif ($NumBars <= 50) {
                   14176:         $width = 120+$NumBars*8;
                   14177:         $xskip = 5;
                   14178:         $bar_width = 4;
                   14179:     } else {
                   14180:         $width = 120+$NumBars*8;
                   14181:         $xskip = 5;
                   14182:         $bar_width = 4;
                   14183:     }
                   14184:     #
1.137     matthew  14185:     $Max = 1 if ($Max < 1);
                   14186:     if ( int($Max) < $Max ) {
                   14187:         $Max++;
                   14188:         $Max = int($Max);
                   14189:     }
1.127     matthew  14190:     $Title  = '' if (! defined($Title));
                   14191:     $xlabel = '' if (! defined($xlabel));
                   14192:     $ylabel = '' if (! defined($ylabel));
1.369     www      14193:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   14194:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   14195:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  14196:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  14197:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   14198:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   14199:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   14200:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   14201:     $ValuesHash{$id.'.height'}   = $height;
                   14202:     $ValuesHash{$id.'.width'}    = $width;
                   14203:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   14204:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   14205:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  14206:     #
1.228     matthew  14207:     # Deal with other parameters
                   14208:     while (my ($key,$value) = each(%$extra_settings)) {
                   14209:         $ValuesHash{$id.'.'.$key} = $value;
                   14210:     }
                   14211:     #
1.646     raeburn  14212:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  14213:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   14214: }
                   14215: 
                   14216: ############################################################
                   14217: ############################################################
                   14218: 
                   14219: =pod
                   14220: 
1.648     raeburn  14221: =item * &DrawXYGraph()
1.137     matthew  14222: 
1.138     matthew  14223: Facilitates the plotting of data in an XY graph.
                   14224: Puts plot definition data into the users environment in order for 
                   14225: graph.png to plot it.  Returns an <img> tag for the plot.
                   14226: 
                   14227: Inputs:
                   14228: 
                   14229: =over 4
                   14230: 
                   14231: =item $Title: string, the title of the plot
                   14232: 
                   14233: =item $xlabel: string, text describing the X-axis of the plot
                   14234: 
                   14235: =item $ylabel: string, text describing the Y-axis of the plot
                   14236: 
                   14237: =item $Max: scalar, the maximum Y value to use in the plot
                   14238: If $Max is < any data point, the graph will not be rendered.
                   14239: 
                   14240: =item $colors: Array ref containing the hex color codes for the data to be 
                   14241: plotted in.  If undefined, default values will be used.
                   14242: 
                   14243: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   14244: 
                   14245: =item $Ydata: Array ref containing Array refs.  
1.185     www      14246: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  14247: 
                   14248: =item %Values: hash indicating or overriding any default values which are 
                   14249: passed to graph.png.  
                   14250: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   14251: 
                   14252: =back
                   14253: 
                   14254: Returns:
                   14255: 
                   14256: An <img> tag which references graph.png and the appropriate identifying
                   14257: information for the plot.
                   14258: 
1.137     matthew  14259: =cut
                   14260: 
                   14261: ############################################################
                   14262: ############################################################
                   14263: sub DrawXYGraph {
                   14264:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   14265:     #
                   14266:     # Create the identifier for the graph
                   14267:     my $identifier = &get_cgi_id();
                   14268:     my $id = 'cgi.'.$identifier;
                   14269:     #
                   14270:     $Title  = '' if (! defined($Title));
                   14271:     $xlabel = '' if (! defined($xlabel));
                   14272:     $ylabel = '' if (! defined($ylabel));
                   14273:     my %ValuesHash = 
                   14274:         (
1.369     www      14275:          $id.'.title'  => &escape($Title),
                   14276:          $id.'.xlabel' => &escape($xlabel),
                   14277:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  14278:          $id.'.y_max_value'=> $Max,
                   14279:          $id.'.labels'     => join(',',@$Xlabels),
                   14280:          $id.'.PlotType'   => 'XY',
                   14281:          );
                   14282:     #
                   14283:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   14284:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   14285:     }
                   14286:     #
                   14287:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   14288:         return '';
                   14289:     }
                   14290:     my $NumSets=1;
1.138     matthew  14291:     foreach my $array (@{$Ydata}){
1.137     matthew  14292:         next if (! ref($array));
                   14293:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   14294:     }
1.138     matthew  14295:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  14296:     #
                   14297:     # Deal with other parameters
                   14298:     while (my ($key,$value) = each(%Values)) {
                   14299:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  14300:     }
                   14301:     #
1.646     raeburn  14302:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  14303:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   14304: }
                   14305: 
                   14306: ############################################################
                   14307: ############################################################
                   14308: 
                   14309: =pod
                   14310: 
1.648     raeburn  14311: =item * &DrawXYYGraph()
1.138     matthew  14312: 
                   14313: Facilitates the plotting of data in an XY graph with two Y axes.
                   14314: Puts plot definition data into the users environment in order for 
                   14315: graph.png to plot it.  Returns an <img> tag for the plot.
                   14316: 
                   14317: Inputs:
                   14318: 
                   14319: =over 4
                   14320: 
                   14321: =item $Title: string, the title of the plot
                   14322: 
                   14323: =item $xlabel: string, text describing the X-axis of the plot
                   14324: 
                   14325: =item $ylabel: string, text describing the Y-axis of the plot
                   14326: 
                   14327: =item $colors: Array ref containing the hex color codes for the data to be 
                   14328: plotted in.  If undefined, default values will be used.
                   14329: 
                   14330: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   14331: 
                   14332: =item $Ydata1: The first data set
                   14333: 
                   14334: =item $Min1: The minimum value of the left Y-axis
                   14335: 
                   14336: =item $Max1: The maximum value of the left Y-axis
                   14337: 
                   14338: =item $Ydata2: The second data set
                   14339: 
                   14340: =item $Min2: The minimum value of the right Y-axis
                   14341: 
                   14342: =item $Max2: The maximum value of the left Y-axis
                   14343: 
                   14344: =item %Values: hash indicating or overriding any default values which are 
                   14345: passed to graph.png.  
                   14346: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   14347: 
                   14348: =back
                   14349: 
                   14350: Returns:
                   14351: 
                   14352: An <img> tag which references graph.png and the appropriate identifying
                   14353: information for the plot.
1.136     matthew  14354: 
                   14355: =cut
                   14356: 
                   14357: ############################################################
                   14358: ############################################################
1.137     matthew  14359: sub DrawXYYGraph {
                   14360:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   14361:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  14362:     #
                   14363:     # Create the identifier for the graph
                   14364:     my $identifier = &get_cgi_id();
                   14365:     my $id = 'cgi.'.$identifier;
                   14366:     #
                   14367:     $Title  = '' if (! defined($Title));
                   14368:     $xlabel = '' if (! defined($xlabel));
                   14369:     $ylabel = '' if (! defined($ylabel));
                   14370:     my %ValuesHash = 
                   14371:         (
1.369     www      14372:          $id.'.title'  => &escape($Title),
                   14373:          $id.'.xlabel' => &escape($xlabel),
                   14374:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  14375:          $id.'.labels' => join(',',@$Xlabels),
                   14376:          $id.'.PlotType' => 'XY',
                   14377:          $id.'.NumSets' => 2,
1.137     matthew  14378:          $id.'.two_axes' => 1,
                   14379:          $id.'.y1_max_value' => $Max1,
                   14380:          $id.'.y1_min_value' => $Min1,
                   14381:          $id.'.y2_max_value' => $Max2,
                   14382:          $id.'.y2_min_value' => $Min2,
1.136     matthew  14383:          );
                   14384:     #
1.137     matthew  14385:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   14386:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   14387:     }
                   14388:     #
                   14389:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   14390:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  14391:         return '';
                   14392:     }
                   14393:     my $NumSets=1;
1.137     matthew  14394:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  14395:         next if (! ref($array));
                   14396:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  14397:     }
                   14398:     #
                   14399:     # Deal with other parameters
                   14400:     while (my ($key,$value) = each(%Values)) {
                   14401:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  14402:     }
                   14403:     #
1.646     raeburn  14404:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 14405:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  14406: }
                   14407: 
                   14408: ############################################################
                   14409: ############################################################
                   14410: 
                   14411: =pod
                   14412: 
1.157     matthew  14413: =back 
                   14414: 
1.139     matthew  14415: =head1 Statistics helper routines?  
                   14416: 
                   14417: Bad place for them but what the hell.
                   14418: 
1.157     matthew  14419: =over 4
                   14420: 
1.648     raeburn  14421: =item * &chartlink()
1.139     matthew  14422: 
                   14423: Returns a link to the chart for a specific student.  
                   14424: 
                   14425: Inputs:
                   14426: 
                   14427: =over 4
                   14428: 
                   14429: =item $linktext: The text of the link
                   14430: 
                   14431: =item $sname: The students username
                   14432: 
                   14433: =item $sdomain: The students domain
                   14434: 
                   14435: =back
                   14436: 
1.157     matthew  14437: =back
                   14438: 
1.139     matthew  14439: =cut
                   14440: 
                   14441: ############################################################
                   14442: ############################################################
                   14443: sub chartlink {
                   14444:     my ($linktext, $sname, $sdomain) = @_;
                   14445:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      14446:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 14447:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  14448:        '">'.$linktext.'</a>';
1.153     matthew  14449: }
                   14450: 
                   14451: #######################################################
                   14452: #######################################################
                   14453: 
                   14454: =pod
                   14455: 
                   14456: =head1 Course Environment Routines
1.157     matthew  14457: 
                   14458: =over 4
1.153     matthew  14459: 
1.648     raeburn  14460: =item * &restore_course_settings()
1.153     matthew  14461: 
1.648     raeburn  14462: =item * &store_course_settings()
1.153     matthew  14463: 
                   14464: Restores/Store indicated form parameters from the course environment.
                   14465: Will not overwrite existing values of the form parameters.
                   14466: 
                   14467: Inputs: 
                   14468: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   14469: 
                   14470: a hash ref describing the data to be stored.  For example:
                   14471:    
                   14472: %Save_Parameters = ('Status' => 'scalar',
                   14473:     'chartoutputmode' => 'scalar',
                   14474:     'chartoutputdata' => 'scalar',
                   14475:     'Section' => 'array',
1.373     raeburn  14476:     'Group' => 'array',
1.153     matthew  14477:     'StudentData' => 'array',
                   14478:     'Maps' => 'array');
                   14479: 
                   14480: Returns: both routines return nothing
                   14481: 
1.631     raeburn  14482: =back
                   14483: 
1.153     matthew  14484: =cut
                   14485: 
                   14486: #######################################################
                   14487: #######################################################
                   14488: sub store_course_settings {
1.496     albertel 14489:     return &store_settings($env{'request.course.id'},@_);
                   14490: }
                   14491: 
                   14492: sub store_settings {
1.153     matthew  14493:     # save to the environment
                   14494:     # appenv the same items, just to be safe
1.300     albertel 14495:     my $udom  = $env{'user.domain'};
                   14496:     my $uname = $env{'user.name'};
1.496     albertel 14497:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  14498:     my %SaveHash;
                   14499:     my %AppHash;
                   14500:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 14501:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 14502:         my $envname = 'environment.'.$basename;
1.258     albertel 14503:         if (exists($env{'form.'.$setting})) {
1.153     matthew  14504:             # Save this value away
                   14505:             if ($type eq 'scalar' &&
1.258     albertel 14506:                 (! exists($env{$envname}) || 
                   14507:                  $env{$envname} ne $env{'form.'.$setting})) {
                   14508:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   14509:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  14510:             } elsif ($type eq 'array') {
                   14511:                 my $stored_form;
1.258     albertel 14512:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  14513:                     $stored_form = join(',',
                   14514:                                         map {
1.369     www      14515:                                             &escape($_);
1.258     albertel 14516:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  14517:                 } else {
                   14518:                     $stored_form = 
1.369     www      14519:                         &escape($env{'form.'.$setting});
1.153     matthew  14520:                 }
                   14521:                 # Determine if the array contents are the same.
1.258     albertel 14522:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  14523:                     $SaveHash{$basename} = $stored_form;
                   14524:                     $AppHash{$envname}   = $stored_form;
                   14525:                 }
                   14526:             }
                   14527:         }
                   14528:     }
                   14529:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 14530:                                           $udom,$uname);
1.153     matthew  14531:     if ($put_result !~ /^(ok|delayed)/) {
                   14532:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   14533:                                  'got error:'.$put_result);
                   14534:     }
                   14535:     # Make sure these settings stick around in this session, too
1.646     raeburn  14536:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  14537:     return;
                   14538: }
                   14539: 
                   14540: sub restore_course_settings {
1.499     albertel 14541:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 14542: }
                   14543: 
                   14544: sub restore_settings {
                   14545:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  14546:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 14547:         next if (exists($env{'form.'.$setting}));
1.496     albertel 14548:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  14549:             '.'.$setting;
1.258     albertel 14550:         if (exists($env{$envname})) {
1.153     matthew  14551:             if ($type eq 'scalar') {
1.258     albertel 14552:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  14553:             } elsif ($type eq 'array') {
1.258     albertel 14554:                 $env{'form.'.$setting} = [ 
1.153     matthew  14555:                                            map { 
1.369     www      14556:                                                &unescape($_); 
1.258     albertel 14557:                                            } split(',',$env{$envname})
1.153     matthew  14558:                                            ];
                   14559:             }
                   14560:         }
                   14561:     }
1.127     matthew  14562: }
                   14563: 
1.618     raeburn  14564: #######################################################
                   14565: #######################################################
                   14566: 
                   14567: =pod
                   14568: 
                   14569: =head1 Domain E-mail Routines  
                   14570: 
                   14571: =over 4
                   14572: 
1.648     raeburn  14573: =item * &build_recipient_list()
1.618     raeburn  14574: 
1.1144    raeburn  14575: Build recipient lists for following types of e-mail:
1.766     raeburn  14576: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144    raeburn  14577: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   14578: module change checking, student/employee ID conflict checks, as
                   14579: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   14580: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  14581: 
                   14582: Inputs:
1.619     raeburn  14583: defmail (scalar - email address of default recipient), 
1.1144    raeburn  14584: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   14585: requestsmail, updatesmail, or idconflictsmail).
                   14586: 
1.619     raeburn  14587: defdom (domain for which to retrieve configuration settings),
1.1144    raeburn  14588: 
1.619     raeburn  14589: origmail (scalar - email address of recipient from loncapa.conf, 
                   14590: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  14591: 
1.655     raeburn  14592: Returns: comma separated list of addresses to which to send e-mail.
                   14593: 
                   14594: =back
1.618     raeburn  14595: 
                   14596: =cut
                   14597: 
                   14598: ############################################################
                   14599: ############################################################
                   14600: sub build_recipient_list {
1.619     raeburn  14601:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  14602:     my @recipients;
1.1270    raeburn  14603:     my ($otheremails,$lastresort,$allbcc,$addtext);
1.618     raeburn  14604:     my %domconfig =
1.1270    raeburn  14605:         &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618     raeburn  14606:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  14607:         if (exists($domconfig{'contacts'}{$mailing})) {
                   14608:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   14609:                 my @contacts = ('adminemail','supportemail');
                   14610:                 foreach my $item (@contacts) {
                   14611:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   14612:                         my $addr = $domconfig{'contacts'}{$item}; 
                   14613:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   14614:                             push(@recipients,$addr);
                   14615:                         }
1.619     raeburn  14616:                     }
1.1270    raeburn  14617:                 }
                   14618:                 $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
                   14619:                 if ($mailing eq 'helpdeskmail') {
                   14620:                     if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
                   14621:                         my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
                   14622:                         my @ok_bccs;
                   14623:                         foreach my $bcc (@bccs) {
                   14624:                             $bcc =~ s/^\s+//g;
                   14625:                             $bcc =~ s/\s+$//g;
                   14626:                             if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                   14627:                                 if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                   14628:                                     push(@ok_bccs,$bcc);
                   14629:                                 }
                   14630:                             }
                   14631:                         }
                   14632:                         if (@ok_bccs > 0) {
                   14633:                             $allbcc = join(', ',@ok_bccs);
                   14634:                         }
                   14635:                     }
                   14636:                     $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618     raeburn  14637:                 }
                   14638:             }
1.766     raeburn  14639:         } elsif ($origmail ne '') {
1.1270    raeburn  14640:             $lastresort = $origmail;
1.618     raeburn  14641:         }
1.619     raeburn  14642:     } elsif ($origmail ne '') {
1.1270    raeburn  14643:         $lastresort = $origmail;
                   14644:     }
                   14645: 
                   14646:     if (($mailing eq 'helpdesk') && ($lastresort ne '')) {
                   14647:         unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
                   14648:             my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   14649:             my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
                   14650:             my %what = (
                   14651:                           perlvar => 1,
                   14652:                        );
                   14653:             my $primary = &Apache::lonnet::domain($defdom,'primary');
                   14654:             if ($primary) {
                   14655:                 my $gotaddr;
                   14656:                 my ($result,$returnhash) =
                   14657:                     &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
                   14658:                 if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
                   14659:                     if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
                   14660:                         $lastresort = $returnhash->{'lonSupportEMail'};
                   14661:                         $gotaddr = 1;
                   14662:                     }
                   14663:                 }
                   14664:                 unless ($gotaddr) {
                   14665:                     my $uintdom = &Apache::lonnet::internet_dom($primary);
                   14666:                     my $intdom = &Apache::lonnet::internet_dom($lonhost);
                   14667:                     unless ($uintdom eq $intdom) {
                   14668:                         my %domconfig =
                   14669:                             &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
                   14670:                         if (ref($domconfig{'contacts'}) eq 'HASH') {
                   14671:                             if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
                   14672:                                 my @contacts = ('adminemail','supportemail');
                   14673:                                 foreach my $item (@contacts) {
                   14674:                                     if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
                   14675:                                         my $addr = $domconfig{'contacts'}{$item};
                   14676:                                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   14677:                                             push(@recipients,$addr);
                   14678:                                         }
                   14679:                                     }
                   14680:                                 }
                   14681:                                 if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
                   14682:                                     $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
                   14683:                                 }
                   14684:                                 if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
                   14685:                                     my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
                   14686:                                     my @ok_bccs;
                   14687:                                     foreach my $bcc (@bccs) {
                   14688:                                         $bcc =~ s/^\s+//g;
                   14689:                                         $bcc =~ s/\s+$//g;
                   14690:                                         if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
                   14691:                                             if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
                   14692:                                                 push(@ok_bccs,$bcc);
                   14693:                                             }
                   14694:                                         }
                   14695:                                     }
                   14696:                                     if (@ok_bccs > 0) {
                   14697:                                         $allbcc = join(', ',@ok_bccs);
                   14698:                                     }
                   14699:                                 }
                   14700:                                 $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
                   14701:                             }
                   14702:                         }
                   14703:                     }
                   14704:                 }
                   14705:             }
                   14706:         }
1.618     raeburn  14707:     }
1.688     raeburn  14708:     if (defined($defmail)) {
                   14709:         if ($defmail ne '') {
                   14710:             push(@recipients,$defmail);
                   14711:         }
1.618     raeburn  14712:     }
                   14713:     if ($otheremails) {
1.619     raeburn  14714:         my @others;
                   14715:         if ($otheremails =~ /,/) {
                   14716:             @others = split(/,/,$otheremails);
1.618     raeburn  14717:         } else {
1.619     raeburn  14718:             push(@others,$otheremails);
                   14719:         }
                   14720:         foreach my $addr (@others) {
                   14721:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   14722:                 push(@recipients,$addr);
                   14723:             }
1.618     raeburn  14724:         }
                   14725:     }
1.1270    raeburn  14726:     if ($mailing eq 'helpdesk') {
                   14727:         if ((!@recipients) && ($lastresort ne '')) {
                   14728:             push(@recipients,$lastresort);
                   14729:         }
                   14730:     } elsif ($lastresort ne '') {
                   14731:         if (!grep(/^\Q$lastresort\E$/,@recipients)) {
                   14732:             push(@recipients,$lastresort);
                   14733:         }
                   14734:     }
1.1271    raeburn  14735:     my $recipientlist = join(',',@recipients);
1.1270    raeburn  14736:     if (wantarray) {
                   14737:         return ($recipientlist,$allbcc,$addtext);
                   14738:     } else {
                   14739:         return $recipientlist;
                   14740:     }
1.618     raeburn  14741: }
                   14742: 
1.127     matthew  14743: ############################################################
                   14744: ############################################################
1.154     albertel 14745: 
1.655     raeburn  14746: =pod
                   14747: 
1.1224    musolffc 14748: =over 4
                   14749: 
1.1223    musolffc 14750: =item * &mime_email()
                   14751: 
                   14752: Sends an email with a possible attachment
                   14753: 
                   14754: Inputs:
                   14755: 
                   14756: =over 4
                   14757: 
                   14758: from -              Sender's email address
                   14759: 
                   14760: to -                Email address of recipient
                   14761: 
                   14762: subject -           Subject of email
                   14763: 
                   14764: body -              Body of email
                   14765: 
                   14766: cc_string -         Carbon copy email address
                   14767: 
                   14768: bcc -               Blind carbon copy email address
                   14769: 
                   14770: type -              File type of attachment
                   14771: 
                   14772: attachment_path -   Path of file to be attached
                   14773: 
                   14774: file_name -         Name of file to be attached
                   14775: 
                   14776: attachment_text -   The body of an attachment of type "TEXT"
                   14777: 
                   14778: =back
                   14779: 
                   14780: =back
                   14781: 
                   14782: =cut
                   14783: 
                   14784: ############################################################
                   14785: ############################################################
                   14786: 
                   14787: sub mime_email {
                   14788:     my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path, 
                   14789:         $file_name, $attachment_text) = @_;
                   14790:     my $msg = MIME::Lite->new(
                   14791:              From    => $from,
                   14792:              To      => $to,
                   14793:              Subject => $subject,
                   14794:              Type    =>'TEXT',
                   14795:              Data    => $body,
                   14796:              );
                   14797:     if ($cc_string ne '') {
                   14798:         $msg->add("Cc" => $cc_string);
                   14799:     }
                   14800:     if ($bcc ne '') {
                   14801:         $msg->add("Bcc" => $bcc);
                   14802:     }
                   14803:     $msg->attr("content-type"         => "text/plain");
                   14804:     $msg->attr("content-type.charset" => "UTF-8");
                   14805:     # Attach file if given
                   14806:     if ($attachment_path) {
                   14807:         unless ($file_name) {
                   14808:             if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
                   14809:         }
                   14810:         my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
                   14811:         $msg->attach(Type     => $type,
                   14812:                      Path     => $attachment_path,
                   14813:                      Filename => $file_name
                   14814:                      );
                   14815:     # Otherwise attach text if given
                   14816:     } elsif ($attachment_text) {
                   14817:         $msg->attach(Type => 'TEXT',
                   14818:                      Data => $attachment_text);
                   14819:     }
                   14820:     # Send it
                   14821:     $msg->send('sendmail');
                   14822: }
                   14823: 
                   14824: ############################################################
                   14825: ############################################################
                   14826: 
                   14827: =pod
                   14828: 
1.655     raeburn  14829: =head1 Course Catalog Routines
                   14830: 
                   14831: =over 4
                   14832: 
                   14833: =item * &gather_categories()
                   14834: 
                   14835: Converts category definitions - keys of categories hash stored in  
                   14836: coursecategories in configuration.db on the primary library server in a 
                   14837: domain - to an array.  Also generates javascript and idx hash used to 
                   14838: generate Domain Coordinator interface for editing Course Categories.
                   14839: 
                   14840: Inputs:
1.663     raeburn  14841: 
1.655     raeburn  14842: categories (reference to hash of category definitions).
1.663     raeburn  14843: 
1.655     raeburn  14844: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14845:       categories and subcategories).
1.663     raeburn  14846: 
1.655     raeburn  14847: idx (reference to hash of counters used in Domain Coordinator interface for 
                   14848:       editing Course Categories).
1.663     raeburn  14849: 
1.655     raeburn  14850: jsarray (reference to array of categories used to create Javascript arrays for
                   14851:          Domain Coordinator interface for editing Course Categories).
                   14852: 
                   14853: Returns: nothing
                   14854: 
                   14855: Side effects: populates cats, idx and jsarray. 
                   14856: 
                   14857: =cut
                   14858: 
                   14859: sub gather_categories {
                   14860:     my ($categories,$cats,$idx,$jsarray) = @_;
                   14861:     my %counters;
                   14862:     my $num = 0;
                   14863:     foreach my $item (keys(%{$categories})) {
                   14864:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   14865:         if ($container eq '' && $depth == 0) {
                   14866:             $cats->[$depth][$categories->{$item}] = $cat;
                   14867:         } else {
                   14868:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   14869:         }
                   14870:         my ($escitem,$tail) = split(/:/,$item,2);
                   14871:         if ($counters{$tail} eq '') {
                   14872:             $counters{$tail} = $num;
                   14873:             $num ++;
                   14874:         }
                   14875:         if (ref($idx) eq 'HASH') {
                   14876:             $idx->{$item} = $counters{$tail};
                   14877:         }
                   14878:         if (ref($jsarray) eq 'ARRAY') {
                   14879:             push(@{$jsarray->[$counters{$tail}]},$item);
                   14880:         }
                   14881:     }
                   14882:     return;
                   14883: }
                   14884: 
                   14885: =pod
                   14886: 
                   14887: =item * &extract_categories()
                   14888: 
                   14889: Used to generate breadcrumb trails for course categories.
                   14890: 
                   14891: Inputs:
1.663     raeburn  14892: 
1.655     raeburn  14893: categories (reference to hash of category definitions).
1.663     raeburn  14894: 
1.655     raeburn  14895: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14896:       categories and subcategories).
1.663     raeburn  14897: 
1.655     raeburn  14898: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  14899: 
1.655     raeburn  14900: allitems (reference to hash - key is category key 
                   14901:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  14902: 
1.655     raeburn  14903: idx (reference to hash of counters used in Domain Coordinator interface for
                   14904:       editing Course Categories).
1.663     raeburn  14905: 
1.655     raeburn  14906: jsarray (reference to array of categories used to create Javascript arrays for
                   14907:          Domain Coordinator interface for editing Course Categories).
                   14908: 
1.665     raeburn  14909: subcats (reference to hash of arrays containing all subcategories within each 
                   14910:          category, -recursive)
                   14911: 
1.655     raeburn  14912: Returns: nothing
                   14913: 
                   14914: Side effects: populates trails and allitems hash references.
                   14915: 
                   14916: =cut
                   14917: 
                   14918: sub extract_categories {
1.665     raeburn  14919:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  14920:     if (ref($categories) eq 'HASH') {
                   14921:         &gather_categories($categories,$cats,$idx,$jsarray);
                   14922:         if (ref($cats->[0]) eq 'ARRAY') {
                   14923:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   14924:                 my $name = $cats->[0][$i];
                   14925:                 my $item = &escape($name).'::0';
                   14926:                 my $trailstr;
                   14927:                 if ($name eq 'instcode') {
                   14928:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  14929:                 } elsif ($name eq 'communities') {
                   14930:                     $trailstr = &mt('Communities');
1.1239    raeburn  14931:                 } elsif ($name eq 'placement') {
                   14932:                     $trailstr = &mt('Placement Tests');
1.655     raeburn  14933:                 } else {
                   14934:                     $trailstr = $name;
                   14935:                 }
                   14936:                 if ($allitems->{$item} eq '') {
                   14937:                     push(@{$trails},$trailstr);
                   14938:                     $allitems->{$item} = scalar(@{$trails})-1;
                   14939:                 }
                   14940:                 my @parents = ($name);
                   14941:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   14942:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   14943:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  14944:                         if (ref($subcats) eq 'HASH') {
                   14945:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   14946:                         }
                   14947:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   14948:                     }
                   14949:                 } else {
                   14950:                     if (ref($subcats) eq 'HASH') {
                   14951:                         $subcats->{$item} = [];
1.655     raeburn  14952:                     }
                   14953:                 }
                   14954:             }
                   14955:         }
                   14956:     }
                   14957:     return;
                   14958: }
                   14959: 
                   14960: =pod
                   14961: 
1.1162    raeburn  14962: =item * &recurse_categories()
1.655     raeburn  14963: 
                   14964: Recursively used to generate breadcrumb trails for course categories.
                   14965: 
                   14966: Inputs:
1.663     raeburn  14967: 
1.655     raeburn  14968: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   14969:       categories and subcategories).
1.663     raeburn  14970: 
1.655     raeburn  14971: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  14972: 
                   14973: category (current course category, for which breadcrumb trail is being generated).
                   14974: 
                   14975: trails (reference to array of breadcrumb trails for each category).
                   14976: 
1.655     raeburn  14977: allitems (reference to hash - key is category key
                   14978:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  14979: 
1.655     raeburn  14980: parents (array containing containers directories for current category, 
                   14981:          back to top level). 
                   14982: 
                   14983: Returns: nothing
                   14984: 
                   14985: Side effects: populates trails and allitems hash references
                   14986: 
                   14987: =cut
                   14988: 
                   14989: sub recurse_categories {
1.665     raeburn  14990:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  14991:     my $shallower = $depth - 1;
                   14992:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   14993:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   14994:             my $name = $cats->[$depth]{$category}[$k];
                   14995:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   14996:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   14997:             if ($allitems->{$item} eq '') {
                   14998:                 push(@{$trails},$trailstr);
                   14999:                 $allitems->{$item} = scalar(@{$trails})-1;
                   15000:             }
                   15001:             my $deeper = $depth+1;
                   15002:             push(@{$parents},$category);
1.665     raeburn  15003:             if (ref($subcats) eq 'HASH') {
                   15004:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   15005:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   15006:                     my $higher;
                   15007:                     if ($j > 0) {
                   15008:                         $higher = &escape($parents->[$j]).':'.
                   15009:                                   &escape($parents->[$j-1]).':'.$j;
                   15010:                     } else {
                   15011:                         $higher = &escape($parents->[$j]).'::'.$j;
                   15012:                     }
                   15013:                     push(@{$subcats->{$higher}},$subcat);
                   15014:                 }
                   15015:             }
                   15016:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   15017:                                 $subcats);
1.655     raeburn  15018:             pop(@{$parents});
                   15019:         }
                   15020:     } else {
                   15021:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   15022:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   15023:         if ($allitems->{$item} eq '') {
                   15024:             push(@{$trails},$trailstr);
                   15025:             $allitems->{$item} = scalar(@{$trails})-1;
                   15026:         }
                   15027:     }
                   15028:     return;
                   15029: }
                   15030: 
1.663     raeburn  15031: =pod
                   15032: 
1.1162    raeburn  15033: =item * &assign_categories_table()
1.663     raeburn  15034: 
                   15035: Create a datatable for display of hierarchical categories in a domain,
                   15036: with checkboxes to allow a course to be categorized. 
                   15037: 
                   15038: Inputs:
                   15039: 
                   15040: cathash - reference to hash of categories defined for the domain (from
                   15041:           configuration.db)
                   15042: 
                   15043: currcat - scalar with an & separated list of categories assigned to a course. 
                   15044: 
1.919     raeburn  15045: type    - scalar contains course type (Course or Community).
                   15046: 
1.1260    raeburn  15047: disabled - scalar (optional) contains disabled="disabled" if input elements are
                   15048:            to be readonly (e.g., Domain Helpdesk role viewing course settings).
                   15049: 
1.663     raeburn  15050: Returns: $output (markup to be displayed) 
                   15051: 
                   15052: =cut
                   15053: 
                   15054: sub assign_categories_table {
1.1259    raeburn  15055:     my ($cathash,$currcat,$type,$disabled) = @_;
1.663     raeburn  15056:     my $output;
                   15057:     if (ref($cathash) eq 'HASH') {
                   15058:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   15059:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   15060:         $maxdepth = scalar(@cats);
                   15061:         if (@cats > 0) {
                   15062:             my $itemcount = 0;
                   15063:             if (ref($cats[0]) eq 'ARRAY') {
                   15064:                 my @currcategories;
                   15065:                 if ($currcat ne '') {
                   15066:                     @currcategories = split('&',$currcat);
                   15067:                 }
1.919     raeburn  15068:                 my $table;
1.663     raeburn  15069:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   15070:                     my $parent = $cats[0][$i];
1.919     raeburn  15071:                     next if ($parent eq 'instcode');
                   15072:                     if ($type eq 'Community') {
                   15073:                         next unless ($parent eq 'communities');
1.1239    raeburn  15074:                     } elsif ($type eq 'Placement') {
                   15075:                         next unless ($parent eq 'placement');
1.919     raeburn  15076:                     } else {
1.1239    raeburn  15077:                         next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919     raeburn  15078:                     }
1.663     raeburn  15079:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   15080:                     my $item = &escape($parent).'::0';
                   15081:                     my $checked = '';
                   15082:                     if (@currcategories > 0) {
                   15083:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   15084:                             $checked = ' checked="checked"';
1.663     raeburn  15085:                         }
                   15086:                     }
1.919     raeburn  15087:                     my $parent_title = $parent;
                   15088:                     if ($parent eq 'communities') {
                   15089:                         $parent_title = &mt('Communities');
1.1239    raeburn  15090:                     } elsif ($parent eq 'placement') {
                   15091:                         $parent_title = &mt('Placement Tests');
1.919     raeburn  15092:                     }
                   15093:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   15094:                               '<input type="checkbox" name="usecategory" value="'.
1.1259    raeburn  15095:                               $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919     raeburn  15096:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  15097:                     my $depth = 1;
                   15098:                     push(@path,$parent);
1.1259    raeburn  15099:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663     raeburn  15100:                     pop(@path);
1.919     raeburn  15101:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  15102:                     $itemcount ++;
                   15103:                 }
1.919     raeburn  15104:                 if ($itemcount) {
                   15105:                     $output = &Apache::loncommon::start_data_table().
                   15106:                               $table.
                   15107:                               &Apache::loncommon::end_data_table();
                   15108:                 }
1.663     raeburn  15109:             }
                   15110:         }
                   15111:     }
                   15112:     return $output;
                   15113: }
                   15114: 
                   15115: =pod
                   15116: 
1.1162    raeburn  15117: =item * &assign_category_rows()
1.663     raeburn  15118: 
                   15119: Create a datatable row for display of nested categories in a domain,
                   15120: with checkboxes to allow a course to be categorized,called recursively.
                   15121: 
                   15122: Inputs:
                   15123: 
                   15124: itemcount - track row number for alternating colors
                   15125: 
                   15126: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   15127:       categories and subcategories.
                   15128: 
                   15129: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   15130: 
                   15131: parent - parent of current category item
                   15132: 
                   15133: path - Array containing all categories back up through the hierarchy from the
                   15134:        current category to the top level.
                   15135: 
                   15136: currcategories - reference to array of current categories assigned to the course
                   15137: 
1.1260    raeburn  15138: disabled - scalar (optional) contains disabled="disabled" if input elements are
                   15139:            to be readonly (e.g., Domain Helpdesk role viewing course settings).
                   15140: 
1.663     raeburn  15141: Returns: $output (markup to be displayed).
                   15142: 
                   15143: =cut
                   15144: 
                   15145: sub assign_category_rows {
1.1259    raeburn  15146:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663     raeburn  15147:     my ($text,$name,$item,$chgstr);
                   15148:     if (ref($cats) eq 'ARRAY') {
                   15149:         my $maxdepth = scalar(@{$cats});
                   15150:         if (ref($cats->[$depth]) eq 'HASH') {
                   15151:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   15152:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   15153:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145    raeburn  15154:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  15155:                 for (my $j=0; $j<$numchildren; $j++) {
                   15156:                     $name = $cats->[$depth]{$parent}[$j];
                   15157:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   15158:                     my $deeper = $depth+1;
                   15159:                     my $checked = '';
                   15160:                     if (ref($currcategories) eq 'ARRAY') {
                   15161:                         if (@{$currcategories} > 0) {
                   15162:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   15163:                                 $checked = ' checked="checked"';
1.663     raeburn  15164:                             }
                   15165:                         }
                   15166:                     }
1.664     raeburn  15167:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   15168:                              '<input type="checkbox" name="usecategory" value="'.
1.1259    raeburn  15169:                              $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675     raeburn  15170:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   15171:                              '</td><td>';
1.663     raeburn  15172:                     if (ref($path) eq 'ARRAY') {
                   15173:                         push(@{$path},$name);
1.1259    raeburn  15174:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663     raeburn  15175:                         pop(@{$path});
                   15176:                     }
                   15177:                     $text .= '</td></tr>';
                   15178:                 }
                   15179:                 $text .= '</table></td>';
                   15180:             }
                   15181:         }
                   15182:     }
                   15183:     return $text;
                   15184: }
                   15185: 
1.1181    raeburn  15186: =pod
                   15187: 
                   15188: =back
                   15189: 
                   15190: =cut
                   15191: 
1.655     raeburn  15192: ############################################################
                   15193: ############################################################
                   15194: 
                   15195: 
1.443     albertel 15196: sub commit_customrole {
1.664     raeburn  15197:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  15198:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 15199:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   15200:                          ($end?', ending '.localtime($end):'').': <b>'.
                   15201:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  15202:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 15203:                  '</b><br />';
                   15204:     return $output;
                   15205: }
                   15206: 
                   15207: sub commit_standardrole {
1.1116    raeburn  15208:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  15209:     my ($output,$logmsg,$linefeed);
                   15210:     if ($context eq 'auto') {
                   15211:         $linefeed = "\n";
                   15212:     } else {
                   15213:         $linefeed = "<br />\n";
                   15214:     }  
1.443     albertel 15215:     if ($three eq 'st') {
1.541     raeburn  15216:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116    raeburn  15217:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  15218:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  15219:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   15220:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 15221:         } else {
1.541     raeburn  15222:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 15223:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  15224:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   15225:             if ($context eq 'auto') {
                   15226:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   15227:             } else {
                   15228:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   15229:                &mt('Add to classlist').': <b>ok</b>';
                   15230:             }
                   15231:             $output .= $linefeed;
1.443     albertel 15232:         }
                   15233:     } else {
                   15234:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   15235:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  15236:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  15237:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  15238:         if ($context eq 'auto') {
                   15239:             $output .= $result.$linefeed;
                   15240:         } else {
                   15241:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   15242:         }
1.443     albertel 15243:     }
                   15244:     return $output;
                   15245: }
                   15246: 
                   15247: sub commit_studentrole {
1.1116    raeburn  15248:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   15249:         $credits) = @_;
1.626     raeburn  15250:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  15251:     if ($context eq 'auto') {
                   15252:         $linefeed = "\n";
                   15253:     } else {
                   15254:         $linefeed = '<br />'."\n";
                   15255:     }
1.443     albertel 15256:     if (defined($one) && defined($two)) {
                   15257:         my $cid=$one.'_'.$two;
                   15258:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   15259:         my $secchange = 0;
                   15260:         my $expire_role_result;
                   15261:         my $modify_section_result;
1.628     raeburn  15262:         if ($oldsec ne '-1') { 
                   15263:             if ($oldsec ne $sec) {
1.443     albertel 15264:                 $secchange = 1;
1.628     raeburn  15265:                 my $now = time;
1.443     albertel 15266:                 my $uurl='/'.$cid;
                   15267:                 $uurl=~s/\_/\//g;
                   15268:                 if ($oldsec) {
                   15269:                     $uurl.='/'.$oldsec;
                   15270:                 }
1.626     raeburn  15271:                 $oldsecurl = $uurl;
1.628     raeburn  15272:                 $expire_role_result = 
1.652     raeburn  15273:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  15274:                 if ($env{'request.course.sec'} ne '') { 
                   15275:                     if ($expire_role_result eq 'refused') {
                   15276:                         my @roles = ('st');
                   15277:                         my @statuses = ('previous');
                   15278:                         my @roledoms = ($one);
                   15279:                         my $withsec = 1;
                   15280:                         my %roleshash = 
                   15281:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   15282:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   15283:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   15284:                             my ($oldstart,$oldend) = 
                   15285:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   15286:                             if ($oldend > 0 && $oldend <= $now) {
                   15287:                                 $expire_role_result = 'ok';
                   15288:                             }
                   15289:                         }
                   15290:                     }
                   15291:                 }
1.443     albertel 15292:                 $result = $expire_role_result;
                   15293:             }
                   15294:         }
                   15295:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116    raeburn  15296:             $modify_section_result = 
                   15297:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   15298:                                                            undef,undef,undef,$sec,
                   15299:                                                            $end,$start,'','',$cid,
                   15300:                                                            '',$context,$credits);
1.443     albertel 15301:             if ($modify_section_result =~ /^ok/) {
                   15302:                 if ($secchange == 1) {
1.628     raeburn  15303:                     if ($sec eq '') {
                   15304:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   15305:                     } else {
                   15306:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   15307:                     }
1.443     albertel 15308:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  15309:                     if ($sec eq '') {
                   15310:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   15311:                     } else {
                   15312:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   15313:                     }
1.443     albertel 15314:                 } else {
1.628     raeburn  15315:                     if ($sec eq '') {
                   15316:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   15317:                     } else {
                   15318:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   15319:                     }
1.443     albertel 15320:                 }
                   15321:             } else {
1.1115    raeburn  15322:                 if ($secchange) { 
1.628     raeburn  15323:                     $$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;
                   15324:                 } else {
                   15325:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   15326:                 }
1.443     albertel 15327:             }
                   15328:             $result = $modify_section_result;
                   15329:         } elsif ($secchange == 1) {
1.628     raeburn  15330:             if ($oldsec eq '') {
1.1103    raeburn  15331:                 $$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  15332:             } else {
                   15333:                 $$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;
                   15334:             }
1.626     raeburn  15335:             if ($expire_role_result eq 'refused') {
                   15336:                 my $newsecurl = '/'.$cid;
                   15337:                 $newsecurl =~ s/\_/\//g;
                   15338:                 if ($sec ne '') {
                   15339:                     $newsecurl.='/'.$sec;
                   15340:                 }
                   15341:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   15342:                     if ($sec eq '') {
                   15343:                         $$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;
                   15344:                     } else {
                   15345:                         $$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;
                   15346:                     }
                   15347:                 }
                   15348:             }
1.443     albertel 15349:         }
                   15350:     } else {
1.626     raeburn  15351:         $$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 15352:         $result = "error: incomplete course id\n";
                   15353:     }
                   15354:     return $result;
                   15355: }
                   15356: 
1.1108    raeburn  15357: sub show_role_extent {
                   15358:     my ($scope,$context,$role) = @_;
                   15359:     $scope =~ s{^/}{};
                   15360:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   15361:     push(@courseroles,'co');
                   15362:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   15363:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   15364:         $scope =~ s{/}{_};
                   15365:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   15366:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   15367:         my ($audom,$auname) = split(/\//,$scope);
                   15368:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   15369:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   15370:     } else {
                   15371:         $scope =~ s{/$}{};
                   15372:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   15373:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   15374:     }
                   15375: }
                   15376: 
1.443     albertel 15377: ############################################################
                   15378: ############################################################
                   15379: 
1.566     albertel 15380: sub check_clone {
1.578     raeburn  15381:     my ($args,$linefeed) = @_;
1.566     albertel 15382:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   15383:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   15384:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   15385:     my $clonemsg;
                   15386:     my $can_clone = 0;
1.944     raeburn  15387:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  15388:     if ($lctype ne 'community') {
                   15389:         $lctype = 'course';
                   15390:     }
1.566     albertel 15391:     if ($clonehome eq 'no_host') {
1.944     raeburn  15392:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  15393:             $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'});
                   15394:         } else {
                   15395:             $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'});
                   15396:         }     
1.566     albertel 15397:     } else {
                   15398: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  15399:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  15400:             if ($clonedesc{'type'} ne 'Community') {
1.1262    raeburn  15401:                 $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'});
1.908     raeburn  15402:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   15403:             }
                   15404:         }
1.1262    raeburn  15405: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882     raeburn  15406:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 15407: 	    $can_clone = 1;
                   15408: 	} else {
1.1221    raeburn  15409: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566     albertel 15410: 						 $args->{'clonedomain'},$args->{'clonecourse'});
1.1221    raeburn  15411:             if ($clonehash{'cloners'} eq '') {
                   15412:                 my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
                   15413:                 if ($domdefs{'canclone'}) {
                   15414:                     unless ($domdefs{'canclone'} eq 'none') {
                   15415:                         if ($domdefs{'canclone'} eq 'domain') {
                   15416:                             if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
                   15417:                                 $can_clone = 1;
                   15418:                             }
                   15419:                         } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
                   15420:                                  ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
                   15421:                             if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
                   15422:                                                                           $clonehash{'internal.coursecode'},$args->{'crscode'})) {
                   15423:                                 $can_clone = 1;
                   15424:                             }
                   15425:                         }
                   15426:                     }
                   15427:                 }
1.578     raeburn  15428:             } else {
1.1221    raeburn  15429: 	        my @cloners = split(/,/,$clonehash{'cloners'});
                   15430:                 if (grep(/^\*$/,@cloners)) {
1.942     raeburn  15431:                     $can_clone = 1;
1.1221    raeburn  15432:                 } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942     raeburn  15433:                     $can_clone = 1;
1.1225    raeburn  15434:                 } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   15435:                     $can_clone = 1;
1.1221    raeburn  15436:                 }
                   15437:                 unless ($can_clone) {
1.1225    raeburn  15438:                     if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) && 
                   15439:                         ($args->{'clonedomain'} eq  $args->{'course_domain'})) {
1.1221    raeburn  15440:                         my (%gotdomdefaults,%gotcodedefaults);
                   15441:                         foreach my $cloner (@cloners) {
                   15442:                             if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
                   15443:                                 ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
                   15444:                                 my (%codedefaults,@code_order);
                   15445:                                 if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
                   15446:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
                   15447:                                         %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
                   15448:                                     }
                   15449:                                     if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
                   15450:                                         @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
                   15451:                                     }
                   15452:                                 } else {
                   15453:                                     &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
                   15454:                                                                             \%codedefaults,
                   15455:                                                                             \@code_order);
                   15456:                                     $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
                   15457:                                     $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
                   15458:                                 }
                   15459:                                 if (@code_order > 0) {
                   15460:                                     if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
                   15461:                                                                                 $cloner,$clonehash{'internal.coursecode'},
                   15462:                                                                                 $args->{'crscode'})) {
                   15463:                                         $can_clone = 1;
                   15464:                                         last;
                   15465:                                     }
                   15466:                                 }
                   15467:                             }
                   15468:                         }
                   15469:                     }
1.1225    raeburn  15470:                 }
                   15471:             }
                   15472:             unless ($can_clone) {
                   15473:                 my $ccrole = 'cc';
                   15474:                 if ($args->{'crstype'} eq 'Community') {
                   15475:                     $ccrole = 'co';
                   15476:                 }
                   15477: 	        my %roleshash =
                   15478: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   15479: 					          $args->{'ccdomain'},
                   15480:                                                   'userroles',['active'],[$ccrole],
                   15481: 					          [$args->{'clonedomain'}]);
                   15482: 	        if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
                   15483:                     $can_clone = 1;
                   15484:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
                   15485:                                                           $args->{'ccuname'},$args->{'ccdomain'})) {
                   15486:                     $can_clone = 1;
1.1221    raeburn  15487:                 }
                   15488:             }
                   15489:             unless ($can_clone) {
                   15490:                 if ($args->{'crstype'} eq 'Community') {
                   15491:                     $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  15492:                 } else {
1.1221    raeburn  15493:                     $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'});
                   15494:                 }
1.566     albertel 15495: 	    }
1.578     raeburn  15496:         }
1.566     albertel 15497:     }
                   15498:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   15499: }
                   15500: 
1.444     albertel 15501: sub construct_course {
1.1262    raeburn  15502:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
                   15503:         $cnum,$category,$coderef) = @_;
1.444     albertel 15504:     my $outcome;
1.541     raeburn  15505:     my $linefeed =  '<br />'."\n";
                   15506:     if ($context eq 'auto') {
                   15507:         $linefeed = "\n";
                   15508:     }
1.566     albertel 15509: 
                   15510: #
                   15511: # Are we cloning?
                   15512: #
                   15513:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   15514:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  15515: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 15516: 	if ($context ne 'auto') {
1.578     raeburn  15517:             if ($clonemsg ne '') {
                   15518: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   15519:             }
1.566     albertel 15520: 	}
                   15521: 	$outcome .= $clonemsg.$linefeed;
                   15522: 
                   15523:         if (!$can_clone) {
                   15524: 	    return (0,$outcome);
                   15525: 	}
                   15526:     }
                   15527: 
1.444     albertel 15528: #
                   15529: # Open course
                   15530: #
1.1239    raeburn  15531:     my $showncrstype;
                   15532:     if ($args->{'crstype'} eq 'Placement') {
                   15533:         $showncrstype = 'placement test'; 
                   15534:     } else {  
                   15535:         $showncrstype = lc($args->{'crstype'});
                   15536:     }
1.444     albertel 15537:     my %cenv=();
                   15538:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   15539:                                              $args->{'cdescr'},
                   15540:                                              $args->{'curl'},
                   15541:                                              $args->{'course_home'},
                   15542:                                              $args->{'nonstandard'},
                   15543:                                              $args->{'crscode'},
                   15544:                                              $args->{'ccuname'}.':'.
                   15545:                                              $args->{'ccdomain'},
1.882     raeburn  15546:                                              $args->{'crstype'},
1.885     raeburn  15547:                                              $cnum,$context,$category);
1.444     albertel 15548: 
                   15549:     # Note: The testing routines depend on this being output; see 
                   15550:     # Utils::Course. This needs to at least be output as a comment
                   15551:     # if anyone ever decides to not show this, and Utils::Course::new
                   15552:     # will need to be suitably modified.
1.1239    raeburn  15553:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
1.943     raeburn  15554:     if ($$courseid =~ /^error:/) {
                   15555:         return (0,$outcome);
                   15556:     }
                   15557: 
1.444     albertel 15558: #
                   15559: # Check if created correctly
                   15560: #
1.479     albertel 15561:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 15562:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  15563:     if ($crsuhome eq 'no_host') {
                   15564:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   15565:         return (0,$outcome);
                   15566:     }
1.541     raeburn  15567:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 15568: 
1.444     albertel 15569: #
1.566     albertel 15570: # Do the cloning
                   15571: #   
                   15572:     if ($can_clone && $cloneid) {
1.1239    raeburn  15573: 	$clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome);
1.566     albertel 15574: 	if ($context ne 'auto') {
                   15575: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   15576: 	}
                   15577: 	$outcome .= $clonemsg.$linefeed;
                   15578: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 15579: # Copy all files
1.637     www      15580: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 15581: # Restore URL
1.566     albertel 15582: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 15583: # Restore title
1.566     albertel 15584: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  15585: # Restore creation date, creator and creation context.
                   15586:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   15587:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   15588:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 15589: # Mark as cloned
1.566     albertel 15590: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      15591: # Need to clone grading mode
                   15592:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   15593:         $cenv{'grading'}=$newenv{'grading'};
                   15594: # Do not clone these environment entries
                   15595:         &Apache::lonnet::del('environment',
                   15596:                   ['default_enrollment_start_date',
                   15597:                    'default_enrollment_end_date',
                   15598:                    'question.email',
                   15599:                    'policy.email',
                   15600:                    'comment.email',
                   15601:                    'pch.users.denied',
1.725     raeburn  15602:                    'plc.users.denied',
                   15603:                    'hidefromcat',
1.1121    raeburn  15604:                    'checkforpriv',
1.1166    raeburn  15605:                    'categories',
                   15606:                    'internal.uniquecode'],
1.638     www      15607:                    $$crsudom,$$crsunum);
1.1170    raeburn  15608:         if ($args->{'textbook'}) {
                   15609:             $cenv{'internal.textbook'} = $args->{'textbook'};
                   15610:         }
1.444     albertel 15611:     }
1.566     albertel 15612: 
1.444     albertel 15613: #
                   15614: # Set environment (will override cloned, if existing)
                   15615: #
                   15616:     my @sections = ();
                   15617:     my @xlists = ();
                   15618:     if ($args->{'crstype'}) {
                   15619:         $cenv{'type'}=$args->{'crstype'};
                   15620:     }
                   15621:     if ($args->{'crsid'}) {
                   15622:         $cenv{'courseid'}=$args->{'crsid'};
                   15623:     }
                   15624:     if ($args->{'crscode'}) {
                   15625:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   15626:     }
                   15627:     if ($args->{'crsquota'} ne '') {
                   15628:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   15629:     } else {
                   15630:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   15631:     }
                   15632:     if ($args->{'ccuname'}) {
                   15633:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   15634:                                         ':'.$args->{'ccdomain'};
                   15635:     } else {
                   15636:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   15637:     }
1.1116    raeburn  15638:     if ($args->{'defaultcredits'}) {
                   15639:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   15640:     }
1.444     albertel 15641:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   15642:     if ($args->{'crssections'}) {
                   15643:         $cenv{'internal.sectionnums'} = '';
                   15644:         if ($args->{'crssections'} =~ m/,/) {
                   15645:             @sections = split/,/,$args->{'crssections'};
                   15646:         } else {
                   15647:             $sections[0] = $args->{'crssections'};
                   15648:         }
                   15649:         if (@sections > 0) {
                   15650:             foreach my $item (@sections) {
                   15651:                 my ($sec,$gp) = split/:/,$item;
                   15652:                 my $class = $args->{'crscode'}.$sec;
                   15653:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   15654:                 $cenv{'internal.sectionnums'} .= $item.',';
                   15655:                 unless ($addcheck eq 'ok') {
1.1263    raeburn  15656:                     push(@badclasses,$class);
1.444     albertel 15657:                 }
                   15658:             }
                   15659:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   15660:         }
                   15661:     }
                   15662: # do not hide course coordinator from staff listing, 
                   15663: # even if privileged
                   15664:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121    raeburn  15665: # add course coordinator's domain to domains to check for privileged users
                   15666: # if different to course domain
                   15667:     if ($$crsudom ne $args->{'ccdomain'}) {
                   15668:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   15669:     }
1.444     albertel 15670: # add crosslistings
                   15671:     if ($args->{'crsxlist'}) {
                   15672:         $cenv{'internal.crosslistings'}='';
                   15673:         if ($args->{'crsxlist'} =~ m/,/) {
                   15674:             @xlists = split/,/,$args->{'crsxlist'};
                   15675:         } else {
                   15676:             $xlists[0] = $args->{'crsxlist'};
                   15677:         }
                   15678:         if (@xlists > 0) {
                   15679:             foreach my $item (@xlists) {
                   15680:                 my ($xl,$gp) = split/:/,$item;
                   15681:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   15682:                 $cenv{'internal.crosslistings'} .= $item.',';
                   15683:                 unless ($addcheck eq 'ok') {
1.1263    raeburn  15684:                     push(@badclasses,$xl);
1.444     albertel 15685:                 }
                   15686:             }
                   15687:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   15688:         }
                   15689:     }
                   15690:     if ($args->{'autoadds'}) {
                   15691:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   15692:     }
                   15693:     if ($args->{'autodrops'}) {
                   15694:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   15695:     }
                   15696: # check for notification of enrollment changes
                   15697:     my @notified = ();
                   15698:     if ($args->{'notify_owner'}) {
                   15699:         if ($args->{'ccuname'} ne '') {
                   15700:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   15701:         }
                   15702:     }
                   15703:     if ($args->{'notify_dc'}) {
                   15704:         if ($uname ne '') { 
1.630     raeburn  15705:             push(@notified,$uname.':'.$udom);
1.444     albertel 15706:         }
                   15707:     }
                   15708:     if (@notified > 0) {
                   15709:         my $notifylist;
                   15710:         if (@notified > 1) {
                   15711:             $notifylist = join(',',@notified);
                   15712:         } else {
                   15713:             $notifylist = $notified[0];
                   15714:         }
                   15715:         $cenv{'internal.notifylist'} = $notifylist;
                   15716:     }
                   15717:     if (@badclasses > 0) {
                   15718:         my %lt=&Apache::lonlocal::texthash(
1.1264    raeburn  15719:                 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
                   15720:                 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
                   15721:                 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444     albertel 15722:         );
1.1264    raeburn  15723:         my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
                   15724:                            &mt('That is because the user identified as the course owner ([_1]) does not have rights to access enrollment in these classes, as determined by the policies of your institution on access to official classlists',$cenv{'internal.courseowner'}).$linefeed.$lt{'itis'};
1.541     raeburn  15725:         if ($context eq 'auto') {
                   15726:             $outcome .= $badclass_msg.$linefeed;
1.1261    raeburn  15727:         } else {
1.566     albertel 15728:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1261    raeburn  15729:         }
                   15730:         foreach my $item (@badclasses) {
1.541     raeburn  15731:             if ($context eq 'auto') {
1.1261    raeburn  15732:                 $outcome .= " - $item\n";
1.541     raeburn  15733:             } else {
1.1261    raeburn  15734:                 $outcome .= "<li>$item</li>\n";
1.541     raeburn  15735:             }
1.1261    raeburn  15736:         }
                   15737:         if ($context eq 'auto') {
                   15738:             $outcome .= $linefeed;
                   15739:         } else {
                   15740:             $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  15741:         } 
1.444     albertel 15742:     }
                   15743:     if ($args->{'no_end_date'}) {
                   15744:         $args->{'endaccess'} = 0;
                   15745:     }
                   15746:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   15747:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   15748:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   15749:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   15750:     if ($args->{'showphotos'}) {
                   15751:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   15752:     }
                   15753:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   15754:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   15755:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   15756:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  15757:             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'); 
                   15758:             if ($context eq 'auto') {
                   15759:                 $outcome .= $krb_msg;
                   15760:             } else {
1.566     albertel 15761:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  15762:             }
                   15763:             $outcome .= $linefeed;
1.444     albertel 15764:         }
                   15765:     }
                   15766:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   15767:        if ($args->{'setpolicy'}) {
                   15768:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   15769:        }
                   15770:        if ($args->{'setcontent'}) {
                   15771:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   15772:        }
1.1251    raeburn  15773:        if ($args->{'setcomment'}) {
                   15774:            $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   15775:        }
1.444     albertel 15776:     }
                   15777:     if ($args->{'reshome'}) {
                   15778: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   15779: 	$cenv{'reshome'}=~s/\/+$/\//;
                   15780:     }
                   15781: #
                   15782: # course has keyed access
                   15783: #
                   15784:     if ($args->{'setkeys'}) {
                   15785:        $cenv{'keyaccess'}='yes';
                   15786:     }
                   15787: # if specified, key authority is not course, but user
                   15788: # only active if keyaccess is yes
                   15789:     if ($args->{'keyauth'}) {
1.487     albertel 15790: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   15791: 	$user = &LONCAPA::clean_username($user);
                   15792: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     15793: 	if ($user ne '' && $domain ne '') {
1.487     albertel 15794: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 15795: 	}
                   15796:     }
                   15797: 
1.1166    raeburn  15798: #
1.1167    raeburn  15799: #  generate and store uniquecode (available to course requester), if course should have one.
1.1166    raeburn  15800: #
                   15801:     if ($args->{'uniquecode'}) {
                   15802:         my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
                   15803:         if ($code) {
                   15804:             $cenv{'internal.uniquecode'} = $code;
1.1167    raeburn  15805:             my %crsinfo =
                   15806:                 &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
                   15807:             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   15808:                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   15809:                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
                   15810:             } 
1.1166    raeburn  15811:             if (ref($coderef)) {
                   15812:                 $$coderef = $code;
                   15813:             }
                   15814:         }
                   15815:     }
                   15816: 
1.444     albertel 15817:     if ($args->{'disresdis'}) {
                   15818:         $cenv{'pch.roles.denied'}='st';
                   15819:     }
                   15820:     if ($args->{'disablechat'}) {
                   15821:         $cenv{'plc.roles.denied'}='st';
                   15822:     }
                   15823: 
                   15824:     # Record we've not yet viewed the Course Initialization Helper for this 
                   15825:     # course
                   15826:     $cenv{'course.helper.not.run'} = 1;
                   15827:     #
                   15828:     # Use new Randomseed
                   15829:     #
                   15830:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   15831:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   15832:     #
                   15833:     # The encryption code and receipt prefix for this course
                   15834:     #
                   15835:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   15836:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   15837:     #
                   15838:     # By default, use standard grading
                   15839:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   15840: 
1.541     raeburn  15841:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   15842:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 15843: #
                   15844: # Open all assignments
                   15845: #
                   15846:     if ($args->{'openall'}) {
                   15847:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   15848:        my %storecontent = ($storeunder         => time,
                   15849:                            $storeunder.'.type' => 'date_start');
                   15850:        
                   15851:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  15852:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 15853:    }
                   15854: #
                   15855: # Set first page
                   15856: #
                   15857:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   15858: 	    || ($cloneid)) {
1.445     albertel 15859: 	use LONCAPA::map;
1.444     albertel 15860: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 15861: 
                   15862: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   15863:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   15864: 
1.444     albertel 15865:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   15866:         my $title; my $url;
                   15867:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   15868: 	    $title=&mt('Syllabus');
1.444     albertel 15869:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   15870:         } else {
1.963     raeburn  15871:             $title=&mt('Table of Contents');
1.444     albertel 15872:             $url='/adm/navmaps';
                   15873:         }
1.445     albertel 15874: 
                   15875:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   15876: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   15877: 
                   15878: 	if ($errtext) { $fatal=2; }
1.541     raeburn  15879:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 15880:     }
1.566     albertel 15881: 
1.1237    raeburn  15882: # 
                   15883: # Set params for Placement Tests
                   15884: #
1.1239    raeburn  15885:     if ($args->{'crstype'} eq 'Placement') {
                   15886:        my %storecontent; 
                   15887:        my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
                   15888:        my %defaults = (
                   15889:                         buttonshide   => { value => 'yes',
                   15890:                                            type => 'string_yesno',},
                   15891:                         type          => { value => 'randomizetry',
                   15892:                                            type  => 'string_questiontype',},
                   15893:                         maxtries      => { value => 1,
                   15894:                                            type => 'int_pos',},
                   15895:                         problemstatus => { value => 'no',
                   15896:                                            type  => 'string_problemstatus',},
                   15897:                       );
                   15898:        foreach my $key (keys(%defaults)) {
                   15899:            $storecontent{$prefix.$key} = $defaults{$key}{'value'};
                   15900:            $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
                   15901:        }
1.1237    raeburn  15902:        &Apache::lonnet::cput
                   15903:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum); 
                   15904:     }
                   15905: 
1.566     albertel 15906:     return (1,$outcome);
1.444     albertel 15907: }
                   15908: 
1.1166    raeburn  15909: sub make_unique_code {
                   15910:     my ($cdom,$cnum) = @_;
                   15911:     # get lock on uniquecodes db
                   15912:     my $lockhash = {
                   15913:                       $cnum."\0".'uniquecodes' => $env{'user.name'}.
                   15914:                                                   ':'.$env{'user.domain'},
                   15915:                    };
                   15916:     my $tries = 0;
                   15917:     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   15918:     my ($code,$error);
                   15919:   
                   15920:     while (($gotlock ne 'ok') && ($tries<3)) {
                   15921:         $tries ++;
                   15922:         sleep 1;
                   15923:         $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   15924:     }
                   15925:     if ($gotlock eq 'ok') {
                   15926:         my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
                   15927:         my $gotcode;
                   15928:         my $attempts = 0;
                   15929:         while ((!$gotcode) && ($attempts < 100)) {
                   15930:             $code = &generate_code();
                   15931:             if (!exists($currcodes{$code})) {
                   15932:                 $gotcode = 1;
                   15933:                 unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                   15934:                     $error = 'nostore';
                   15935:                 }
                   15936:             }
                   15937:             $attempts ++;
                   15938:         }
                   15939:         my @del_lock = ($cnum."\0".'uniquecodes');
                   15940:         my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
                   15941:     } else {
                   15942:         $error = 'nolock';
                   15943:     }
                   15944:     return ($code,$error);
                   15945: }
                   15946: 
                   15947: sub generate_code {
                   15948:     my $code;
                   15949:     my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
                   15950:     for (my $i=0; $i<6; $i++) {
                   15951:         my $lettnum = int (rand 2);
                   15952:         my $item = '';
                   15953:         if ($lettnum) {
                   15954:             $item = $letts[int( rand(18) )];
                   15955:         } else {
                   15956:             $item = 1+int( rand(8) );
                   15957:         }
                   15958:         $code .= $item;
                   15959:     }
                   15960:     return $code;
                   15961: }
                   15962: 
1.444     albertel 15963: ############################################################
                   15964: ############################################################
                   15965: 
1.1237    raeburn  15966: # Community, Course and Placement Test
1.378     raeburn  15967: sub course_type {
                   15968:     my ($cid) = @_;
                   15969:     if (!defined($cid)) {
                   15970:         $cid = $env{'request.course.id'};
                   15971:     }
1.404     albertel 15972:     if (defined($env{'course.'.$cid.'.type'})) {
                   15973:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  15974:     } else {
                   15975:         return 'Course';
1.377     raeburn  15976:     }
                   15977: }
1.156     albertel 15978: 
1.406     raeburn  15979: sub group_term {
                   15980:     my $crstype = &course_type();
                   15981:     my %names = (
                   15982:                   'Course' => 'group',
1.865     raeburn  15983:                   'Community' => 'group',
1.1237    raeburn  15984:                   'Placement' => 'group',
1.406     raeburn  15985:                 );
                   15986:     return $names{$crstype};
                   15987: }
                   15988: 
1.902     raeburn  15989: sub course_types {
1.1237    raeburn  15990:     my @types = ('official','unofficial','community','textbook','placement');
1.902     raeburn  15991:     my %typename = (
                   15992:                          official   => 'Official course',
                   15993:                          unofficial => 'Unofficial course',
                   15994:                          community  => 'Community',
1.1165    raeburn  15995:                          textbook   => 'Textbook course',
1.1237    raeburn  15996:                          placement  => 'Placement test',
1.902     raeburn  15997:                    );
                   15998:     return (\@types,\%typename);
                   15999: }
                   16000: 
1.156     albertel 16001: sub icon {
                   16002:     my ($file)=@_;
1.505     albertel 16003:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 16004:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 16005:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 16006:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   16007: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   16008: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   16009: 	            $curfext.".gif") {
                   16010: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   16011: 		$curfext.".gif";
                   16012: 	}
                   16013:     }
1.249     albertel 16014:     return &lonhttpdurl($iconname);
1.154     albertel 16015: } 
1.84      albertel 16016: 
1.575     albertel 16017: sub lonhttpdurl {
1.692     www      16018: #
                   16019: # Had been used for "small fry" static images on separate port 8080.
                   16020: # Modify here if lightweight http functionality desired again.
                   16021: # Currently eliminated due to increasing firewall issues.
                   16022: #
1.575     albertel 16023:     my ($url)=@_;
1.692     www      16024:     return $url;
1.215     albertel 16025: }
                   16026: 
1.213     albertel 16027: sub connection_aborted {
                   16028:     my ($r)=@_;
                   16029:     $r->print(" ");$r->rflush();
                   16030:     my $c = $r->connection;
                   16031:     return $c->aborted();
                   16032: }
                   16033: 
1.221     foxr     16034: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     16035: #    strings as 'strings'.
                   16036: sub escape_single {
1.221     foxr     16037:     my ($input) = @_;
1.223     albertel 16038:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     16039:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   16040:     return $input;
                   16041: }
1.223     albertel 16042: 
1.222     foxr     16043: #  Same as escape_single, but escape's "'s  This 
                   16044: #  can be used for  "strings"
                   16045: sub escape_double {
                   16046:     my ($input) = @_;
                   16047:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   16048:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   16049:     return $input;
                   16050: }
1.223     albertel 16051:  
1.222     foxr     16052: #   Escapes the last element of a full URL.
                   16053: sub escape_url {
                   16054:     my ($url)   = @_;
1.238     raeburn  16055:     my @urlslices = split(/\//, $url,-1);
1.369     www      16056:     my $lastitem = &escape(pop(@urlslices));
1.1203    raeburn  16057:     return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222     foxr     16058: }
1.462     albertel 16059: 
1.820     raeburn  16060: sub compare_arrays {
                   16061:     my ($arrayref1,$arrayref2) = @_;
                   16062:     my (@difference,%count);
                   16063:     @difference = ();
                   16064:     %count = ();
                   16065:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   16066:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   16067:         foreach my $element (keys(%count)) {
                   16068:             if ($count{$element} == 1) {
                   16069:                 push(@difference,$element);
                   16070:             }
                   16071:         }
                   16072:     }
                   16073:     return @difference;
                   16074: }
                   16075: 
1.817     bisitz   16076: # -------------------------------------------------------- Initialize user login
1.462     albertel 16077: sub init_user_environment {
1.463     albertel 16078:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 16079:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   16080: 
                   16081:     my $public=($username eq 'public' && $domain eq 'public');
                   16082: 
1.1062    raeburn  16083:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 16084:     my $now=time;
                   16085: 
                   16086:     if ($public) {
                   16087: 	my $max_public=100;
                   16088: 	my $oldest;
                   16089: 	my $oldest_time=0;
                   16090: 	for(my $next=1;$next<=$max_public;$next++) {
                   16091: 	    if (-e $lonids."/publicuser_$next.id") {
                   16092: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   16093: 		if ($mtime<$oldest_time || !$oldest_time) {
                   16094: 		    $oldest_time=$mtime;
                   16095: 		    $oldest=$next;
                   16096: 		}
                   16097: 	    } else {
                   16098: 		$cookie="publicuser_$next";
                   16099: 		last;
                   16100: 	    }
                   16101: 	}
                   16102: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   16103:     } else {
1.1275    raeburn  16104: 	# See if old ID present, if so, remove if this isn't a robot,
                   16105: 	# killing any existing non-robot sessions
1.463     albertel 16106: 	if (!$args->{'robot'}) {
                   16107: 	    opendir(DIR,$lonids);
                   16108: 	    while ($filename=readdir(DIR)) {
                   16109: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   16110: 		    unlink($lonids.'/'.$filename);
                   16111: 		}
1.462     albertel 16112: 	    }
1.463     albertel 16113: 	    closedir(DIR);
1.1204    raeburn  16114: # If there is a undeleted lockfile for the user's paste buffer remove it.
                   16115:             my $namespace = 'nohist_courseeditor';
                   16116:             my $lockingkey = 'paste'."\0".'locked_num';
                   16117:             my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
                   16118:                                                 $domain,$username);
                   16119:             if (exists($lockhash{$lockingkey})) {
                   16120:                 my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
                   16121:                 unless ($delresult eq 'ok') {
                   16122:                     &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
                   16123:                 }
                   16124:             }
1.462     albertel 16125: 	}
                   16126: # Give them a new cookie
1.463     albertel 16127: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      16128: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 16129: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 16130:     
                   16131: # Initialize roles
                   16132: 
1.1062    raeburn  16133: 	($userroles,$firstaccenv,$timerintenv) = 
                   16134:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 16135:     }
                   16136: # ------------------------------------ Check browser type and MathML capability
                   16137: 
1.1194    raeburn  16138:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
                   16139:         $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462     albertel 16140: 
                   16141: # ------------------------------------------------------------- Get environment
                   16142: 
                   16143:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   16144:     my ($tmp) = keys(%userenv);
1.1275    raeburn  16145:     if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1.462     albertel 16146: 	undef(%userenv);
                   16147:     }
                   16148:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   16149: 	$form->{'interface'}=$userenv{'interface'};
                   16150:     }
                   16151:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   16152: 
                   16153: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   16154:     foreach my $option ('interface','localpath','localres') {
                   16155:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 16156:     }
                   16157: # --------------------------------------------------------- Write first profile
                   16158: 
                   16159:     {
                   16160: 	my %initial_env = 
                   16161: 	    ("user.name"          => $username,
                   16162: 	     "user.domain"        => $domain,
                   16163: 	     "user.home"          => $authhost,
                   16164: 	     "browser.type"       => $clientbrowser,
                   16165: 	     "browser.version"    => $clientversion,
                   16166: 	     "browser.mathml"     => $clientmathml,
                   16167: 	     "browser.unicode"    => $clientunicode,
                   16168: 	     "browser.os"         => $clientos,
1.1137    raeburn  16169:              "browser.mobile"     => $clientmobile,
1.1141    raeburn  16170:              "browser.info"       => $clientinfo,
1.1194    raeburn  16171:              "browser.osversion"  => $clientosversion,
1.462     albertel 16172: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   16173: 	     "request.course.fn"  => '',
                   16174: 	     "request.course.uri" => '',
                   16175: 	     "request.course.sec" => '',
                   16176: 	     "request.role"       => 'cm',
                   16177: 	     "request.role.adv"   => $env{'user.adv'},
                   16178: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   16179: 
                   16180:         if ($form->{'localpath'}) {
                   16181: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   16182: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   16183:         }
                   16184: 	
                   16185: 	if ($form->{'interface'}) {
                   16186: 	    $form->{'interface'}=~s/\W//gs;
                   16187: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   16188: 	    $env{'browser.interface'}=$form->{'interface'};
                   16189: 	}
                   16190: 
1.1157    raeburn  16191:         if ($form->{'iptoken'}) {
                   16192:             my $lonhost = $r->dir_config('lonHostID');
                   16193:             $initial_env{"user.noloadbalance"} = $lonhost;
                   16194:             $env{'user.noloadbalance'} = $lonhost;
                   16195:         }
                   16196: 
1.1268    raeburn  16197:         if ($form->{'noloadbalance'}) {
                   16198:             my @hosts = &Apache::lonnet::current_machine_ids();
                   16199:             my $hosthere = $form->{'noloadbalance'};
                   16200:             if (grep(/^\Q$hosthere\E$/,@hosts)) {
                   16201:                 $initial_env{"user.noloadbalance"} = $hosthere;
                   16202:                 $env{'user.noloadbalance'} = $hosthere;
                   16203:             }
                   16204:         }
                   16205: 
1.1016    raeburn  16206:         unless ($domain eq 'public') {
1.1273    raeburn  16207:             my %is_adv = ( is_adv => $env{'user.adv'} );
                   16208:             my %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   16209: 
                   16210:             foreach my $tool ('aboutme','blog','webdav','portfolio') {
                   16211:                 $userenv{'availabletools.'.$tool} = 
                   16212:                     &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   16213:                                                       undef,\%userenv,\%domdef,\%is_adv);
                   16214:             }
1.980     raeburn  16215: 
1.1273    raeburn  16216:             foreach my $crstype ('official','unofficial','community','textbook','placement') {
                   16217:                 $userenv{'canrequest.'.$crstype} =
                   16218:                     &Apache::lonnet::usertools_access($username,$domain,$crstype,
                   16219:                                                       'reload','requestcourses',
                   16220:                                                       \%userenv,\%domdef,\%is_adv);
                   16221:             }
1.724     raeburn  16222: 
1.1273    raeburn  16223:             $userenv{'canrequest.author'} =
                   16224:                 &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   16225:                                                   'reload','requestauthor',
1.980     raeburn  16226:                                                   \%userenv,\%domdef,\%is_adv);
1.1273    raeburn  16227:             my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   16228:                                                  $domain,$username);
                   16229:             my $reqstatus = $reqauthor{'author_status'};
                   16230:             if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { 
                   16231:                 if (ref($reqauthor{'author'}) eq 'HASH') {
                   16232:                     $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   16233:                                                       $reqauthor{'author'}{'timestamp'};
                   16234:                 }
1.1092    raeburn  16235:             }
1.1287    raeburn  16236:             my ($types,$typename) = &course_types();
                   16237:             if (ref($types) eq 'ARRAY') {
                   16238:                 my @options = ('approval','validate','autolimit');
                   16239:                 my $optregex = join('|',@options);
                   16240:                 my (%willtrust,%trustchecked);
                   16241:                 foreach my $type (@{$types}) {
                   16242:                     my $dom_str = $env{'environment.reqcrsotherdom.'.$type};
                   16243:                     if ($dom_str ne '') {
                   16244:                         my $updatedstr = '';
                   16245:                         my @possdomains = split(',',$dom_str);
                   16246:                         foreach my $entry (@possdomains) {
                   16247:                             my ($extdom,$extopt) = split(':',$entry);
                   16248:                             unless ($trustchecked{$extdom}) {
                   16249:                                 $willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom);
                   16250:                                 $trustchecked{$extdom} = 1;
                   16251:                             }
                   16252:                             if ($willtrust{$extdom}) {
                   16253:                                 $updatedstr .= $entry.',';
                   16254:                             }
                   16255:                         }
                   16256:                         $updatedstr =~ s/,$//;
                   16257:                         if ($updatedstr) {
                   16258:                             $userenv{'reqcrsotherdom.'.$type} = $updatedstr;
                   16259:                         } else {
                   16260:                             delete($userenv{'reqcrsotherdom.'.$type});
                   16261:                         }
                   16262:                     }
                   16263:                 }
                   16264:             }
1.1092    raeburn  16265:         }
1.462     albertel 16266: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  16267: 
1.462     albertel 16268: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   16269: 		 &GDBM_WRCREAT(),0640)) {
                   16270: 	    &_add_to_env(\%disk_env,\%initial_env);
                   16271: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   16272: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  16273:             if (ref($firstaccenv) eq 'HASH') {
                   16274:                 &_add_to_env(\%disk_env,$firstaccenv);
                   16275:             }
                   16276:             if (ref($timerintenv) eq 'HASH') {
                   16277:                 &_add_to_env(\%disk_env,$timerintenv);
                   16278:             }
1.463     albertel 16279: 	    if (ref($args->{'extra_env'})) {
                   16280: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   16281: 	    }
1.462     albertel 16282: 	    untie(%disk_env);
                   16283: 	} else {
1.705     tempelho 16284: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   16285: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 16286: 	    return 'error: '.$!;
                   16287: 	}
                   16288:     }
                   16289:     $env{'request.role'}='cm';
                   16290:     $env{'request.role.adv'}=$env{'user.adv'};
                   16291:     $env{'browser.type'}=$clientbrowser;
                   16292: 
                   16293:     return $cookie;
                   16294: 
                   16295: }
                   16296: 
                   16297: sub _add_to_env {
                   16298:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  16299:     if (ref($env_data) eq 'HASH') {
                   16300:         while (my ($key,$value) = each(%$env_data)) {
                   16301: 	    $idf->{$prefix.$key} = $value;
                   16302: 	    $env{$prefix.$key}   = $value;
                   16303:         }
1.462     albertel 16304:     }
                   16305: }
                   16306: 
1.685     tempelho 16307: # --- Get the symbolic name of a problem and the url
                   16308: sub get_symb {
                   16309:     my ($request,$silent) = @_;
1.726     raeburn  16310:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 16311:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   16312:     if ($symb eq '') {
                   16313:         if (!$silent) {
1.1071    raeburn  16314:             if (ref($request)) { 
                   16315:                 $request->print("Unable to handle ambiguous references:$url:.");
                   16316:             }
1.685     tempelho 16317:             return ();
                   16318:         }
                   16319:     }
                   16320:     &Apache::lonenc::check_decrypt(\$symb);
                   16321:     return ($symb);
                   16322: }
                   16323: 
                   16324: # --------------------------------------------------------------Get annotation
                   16325: 
                   16326: sub get_annotation {
                   16327:     my ($symb,$enc) = @_;
                   16328: 
                   16329:     my $key = $symb;
                   16330:     if (!$enc) {
                   16331:         $key =
                   16332:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   16333:     }
                   16334:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   16335:     return $annotation{$key};
                   16336: }
                   16337: 
                   16338: sub clean_symb {
1.731     raeburn  16339:     my ($symb,$delete_enc) = @_;
1.685     tempelho 16340: 
                   16341:     &Apache::lonenc::check_decrypt(\$symb);
                   16342:     my $enc = $env{'request.enc'};
1.731     raeburn  16343:     if ($delete_enc) {
1.730     raeburn  16344:         delete($env{'request.enc'});
                   16345:     }
1.685     tempelho 16346: 
                   16347:     return ($symb,$enc);
                   16348: }
1.462     albertel 16349: 
1.1181    raeburn  16350: ############################################################
                   16351: ############################################################
                   16352: 
                   16353: =pod
                   16354: 
                   16355: =head1 Routines for building display used to search for courses
                   16356: 
                   16357: 
                   16358: =over 4
                   16359: 
                   16360: =item * &build_filters()
                   16361: 
                   16362: Create markup for a table used to set filters to use when selecting
1.1182    raeburn  16363: courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
                   16364: and quotacheck.pl
                   16365: 
1.1181    raeburn  16366: 
                   16367: Inputs:
                   16368: 
                   16369: filterlist - anonymous array of fields to include as potential filters 
                   16370: 
                   16371: crstype - course type
                   16372: 
                   16373: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                   16374:               to pop-open a course selector (will contain "extra element"). 
                   16375: 
                   16376: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
                   16377: 
                   16378: filter - anonymous hash of criteria and their values
                   16379: 
                   16380: action - form action
                   16381: 
                   16382: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
                   16383: 
1.1182    raeburn  16384: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181    raeburn  16385: 
                   16386: cloneruname - username of owner of new course who wants to clone
                   16387: 
                   16388: clonerudom - domain of owner of new course who wants to clone
                   16389: 
                   16390: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community) 
                   16391: 
                   16392: codetitlesref - reference to array of titles of components in institutional codes (official courses)
                   16393: 
                   16394: codedom - domain
                   16395: 
                   16396: formname - value of form element named "form". 
                   16397: 
                   16398: fixeddom - domain, if fixed.
                   16399: 
                   16400: prevphase - value to assign to form element named "phase" when going back to the previous screen  
                   16401: 
                   16402: cnameelement - name of form element in form on opener page which will receive title of selected course 
                   16403: 
                   16404: cnumelement - name of form element in form on opener page which will receive courseID  of selected course
                   16405: 
                   16406: cdomelement - name of form element in form on opener page which will receive domain of selected course
                   16407: 
                   16408: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
                   16409: 
                   16410: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
                   16411: 
                   16412: clonewarning - warning message about missing information for intended course owner when DC creates a course
                   16413: 
1.1182    raeburn  16414: 
1.1181    raeburn  16415: Returns: $output - HTML for display of search criteria, and hidden form elements.
                   16416: 
1.1182    raeburn  16417: 
1.1181    raeburn  16418: Side Effects: None
                   16419: 
                   16420: =cut
                   16421: 
                   16422: # ---------------------------------------------- search for courses based on last activity etc.
                   16423: 
                   16424: sub build_filters {
                   16425:     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
                   16426:         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
                   16427:         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
                   16428:         $cnameelement,$cnumelement,$cdomelement,$setroles,
                   16429:         $clonetext,$clonewarning) = @_;
1.1182    raeburn  16430:     my ($list,$jscript);
1.1181    raeburn  16431:     my $onchange = 'javascript:updateFilters(this)';
                   16432:     my ($domainselectform,$sincefilterform,$createdfilterform,
                   16433:         $ownerdomselectform,$persondomselectform,$instcodeform,
                   16434:         $typeselectform,$instcodetitle);
                   16435:     if ($formname eq '') {
                   16436:         $formname = $caller;
                   16437:     }
                   16438:     foreach my $item (@{$filterlist}) {
                   16439:         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   16440:                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
                   16441:             if ($item eq 'domainfilter') {
                   16442:                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
                   16443:             } elsif ($item eq 'coursefilter') {
                   16444:                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
                   16445:             } elsif ($item eq 'ownerfilter') {
                   16446:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   16447:             } elsif ($item eq 'ownerdomfilter') {
                   16448:                 $filter->{'ownerdomfilter'} =
                   16449:                     &LONCAPA::clean_domain($filter->{$item});
                   16450:                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                   16451:                                                        'ownerdomfilter',1);
                   16452:             } elsif ($item eq 'personfilter') {
                   16453:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   16454:             } elsif ($item eq 'persondomfilter') {
                   16455:                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                   16456:                                                         'persondomfilter',1);
                   16457:             } else {
                   16458:                 $filter->{$item} =~ s/\W//g;
                   16459:             }
                   16460:             if (!$filter->{$item}) {
                   16461:                 $filter->{$item} = '';
                   16462:             }
                   16463:         }
                   16464:         if ($item eq 'domainfilter') {
                   16465:             my $allow_blank = 1;
                   16466:             if ($formname eq 'portform') {
                   16467:                 $allow_blank=0;
                   16468:             } elsif ($formname eq 'studentform') {
                   16469:                 $allow_blank=0;
                   16470:             }
                   16471:             if ($fixeddom) {
                   16472:                 $domainselectform = '<input type="hidden" name="domainfilter"'.
                   16473:                                     ' value="'.$codedom.'" />'.
                   16474:                                     &Apache::lonnet::domain($codedom,'description');
                   16475:             } else {
                   16476:                 $domainselectform = &select_dom_form($filter->{$item},
                   16477:                                                      'domainfilter',
                   16478:                                                       $allow_blank,'',$onchange);
                   16479:             }
                   16480:         } else {
                   16481:             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
                   16482:         }
                   16483:     }
                   16484: 
                   16485:     # last course activity filter and selection
                   16486:     $sincefilterform = &timebased_select_form('sincefilter',$filter);
                   16487: 
                   16488:     # course created filter and selection
                   16489:     if (exists($filter->{'createdfilter'})) {
                   16490:         $createdfilterform = &timebased_select_form('createdfilter',$filter);
                   16491:     }
                   16492: 
1.1239    raeburn  16493:     my $prefix = $crstype;
                   16494:     if ($crstype eq 'Placement') {
                   16495:         $prefix = 'Placement Test'
                   16496:     }
1.1181    raeburn  16497:     my %lt = &Apache::lonlocal::texthash(
1.1239    raeburn  16498:                 'cac' => "$prefix Activity",
                   16499:                 'ccr' => "$prefix Created",
                   16500:                 'cde' => "$prefix Title",
                   16501:                 'cdo' => "$prefix Domain",
1.1181    raeburn  16502:                 'ins' => 'Institutional Code',
                   16503:                 'inc' => 'Institutional Categorization',
1.1239    raeburn  16504:                 'cow' => "$prefix Owner/Co-owner",
                   16505:                 'cop' => "$prefix Personnel Includes",
1.1181    raeburn  16506:                 'cog' => 'Type',
                   16507:              );
                   16508: 
                   16509:     if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   16510:         my $typeval = 'Course';
                   16511:         if ($crstype eq 'Community') {
                   16512:             $typeval = 'Community';
1.1239    raeburn  16513:         } elsif ($crstype eq 'Placement') {
                   16514:             $typeval = 'Placement';
1.1181    raeburn  16515:         }
                   16516:         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
                   16517:     } else {
                   16518:         $typeselectform =  '<select name="type" size="1"';
                   16519:         if ($onchange) {
                   16520:             $typeselectform .= ' onchange="'.$onchange.'"';
                   16521:         }
                   16522:         $typeselectform .= '>'."\n";
1.1237    raeburn  16523:         foreach my $posstype ('Course','Community','Placement') {
1.1239    raeburn  16524:             my $shown;
                   16525:             if ($posstype eq 'Placement') {
                   16526:                 $shown = &mt('Placement Test');
                   16527:             } else {
                   16528:                 $shown = &mt($posstype);
                   16529:             }
1.1181    raeburn  16530:             $typeselectform.='<option value="'.$posstype.'"'.
1.1239    raeburn  16531:                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181    raeburn  16532:         }
                   16533:         $typeselectform.="</select>";
                   16534:     }
                   16535: 
                   16536:     my ($cloneableonlyform,$cloneabletitle);
                   16537:     if (exists($filter->{'cloneableonly'})) {
                   16538:         my $cloneableon = '';
                   16539:         my $cloneableoff = ' checked="checked"';
                   16540:         if ($filter->{'cloneableonly'}) {
                   16541:             $cloneableon = $cloneableoff;
                   16542:             $cloneableoff = '';
                   16543:         }
                   16544:         $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>';
                   16545:         if ($formname eq 'ccrs') {
1.1187    bisitz   16546:             $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181    raeburn  16547:         } else {
                   16548:             $cloneabletitle = &mt('Cloneable by you');
                   16549:         }
                   16550:     }
                   16551:     my $officialjs;
                   16552:     if ($crstype eq 'Course') {
                   16553:         if (exists($filter->{'instcodefilter'})) {
1.1182    raeburn  16554: #            if (($fixeddom) || ($formname eq 'requestcrs') ||
                   16555: #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
                   16556:             if ($codedom) { 
1.1181    raeburn  16557:                 $officialjs = 1;
                   16558:                 ($instcodeform,$jscript,$$numtitlesref) =
                   16559:                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                   16560:                                                                   $officialjs,$codetitlesref);
                   16561:                 if ($jscript) {
1.1182    raeburn  16562:                     $jscript = '<script type="text/javascript">'."\n".
                   16563:                                '// <![CDATA['."\n".
                   16564:                                $jscript."\n".
                   16565:                                '// ]]>'."\n".
                   16566:                                '</script>'."\n";
1.1181    raeburn  16567:                 }
                   16568:             }
                   16569:             if ($instcodeform eq '') {
                   16570:                 $instcodeform =
                   16571:                     '<input type="text" name="instcodefilter" size="10" value="'.
                   16572:                     $list->{'instcodefilter'}.'" />';
                   16573:                 $instcodetitle = $lt{'ins'};
                   16574:             } else {
                   16575:                 $instcodetitle = $lt{'inc'};
                   16576:             }
                   16577:             if ($fixeddom) {
                   16578:                 $instcodetitle .= '<br />('.$codedom.')';
                   16579:             }
                   16580:         }
                   16581:     }
                   16582:     my $output = qq|
                   16583: <form method="post" name="filterpicker" action="$action">
                   16584: <input type="hidden" name="form" value="$formname" />
                   16585: |;
                   16586:     if ($formname eq 'modifycourse') {
                   16587:         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                   16588:                    '<input type="hidden" name="prevphase" value="'.
                   16589:                    $prevphase.'" />'."\n";
1.1198    musolffc 16590:     } elsif ($formname eq 'quotacheck') {
                   16591:         $output .= qq|
                   16592: <input type="hidden" name="sortby" value="" />
                   16593: <input type="hidden" name="sortorder" value="" />
                   16594: |;
                   16595:     } else {
1.1181    raeburn  16596:         my $name_input;
                   16597:         if ($cnameelement ne '') {
                   16598:             $name_input = '<input type="hidden" name="cnameelement" value="'.
                   16599:                           $cnameelement.'" />';
                   16600:         }
                   16601:         $output .= qq|
1.1182    raeburn  16602: <input type="hidden" name="cnumelement" value="$cnumelement" />
                   16603: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181    raeburn  16604: $name_input
                   16605: $roleelement
                   16606: $multelement
                   16607: $typeelement
                   16608: |;
                   16609:         if ($formname eq 'portform') {
                   16610:             $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
                   16611:         }
                   16612:     }
                   16613:     if ($fixeddom) {
                   16614:         $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
                   16615:     }
                   16616:     $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
                   16617:     if ($sincefilterform) {
                   16618:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                   16619:                   .$sincefilterform
                   16620:                   .&Apache::lonhtmlcommon::row_closure();
                   16621:     }
                   16622:     if ($createdfilterform) {
                   16623:         $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                   16624:                   .$createdfilterform
                   16625:                   .&Apache::lonhtmlcommon::row_closure();
                   16626:     }
                   16627:     if ($domainselectform) {
                   16628:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                   16629:                   .$domainselectform
                   16630:                   .&Apache::lonhtmlcommon::row_closure();
                   16631:     }
                   16632:     if ($typeselectform) {
                   16633:         if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   16634:             $output .= $typeselectform;
                   16635:         } else {
                   16636:             $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                   16637:                       .$typeselectform
                   16638:                       .&Apache::lonhtmlcommon::row_closure();
                   16639:         }
                   16640:     }
                   16641:     if ($instcodeform) {
                   16642:         $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                   16643:                   .$instcodeform
                   16644:                   .&Apache::lonhtmlcommon::row_closure();
                   16645:     }
                   16646:     if (exists($filter->{'ownerfilter'})) {
                   16647:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                   16648:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   16649:                    '<input type="text" name="ownerfilter" size="20" value="'.
                   16650:                    $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   16651:                    $ownerdomselectform.'</td></tr></table>'.
                   16652:                    &Apache::lonhtmlcommon::row_closure();
                   16653:     }
                   16654:     if (exists($filter->{'personfilter'})) {
                   16655:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                   16656:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   16657:                    '<input type="text" name="personfilter" size="20" value="'.
                   16658:                    $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   16659:                    $persondomselectform.'</td></tr></table>'.
                   16660:                    &Apache::lonhtmlcommon::row_closure();
                   16661:     }
                   16662:     if (exists($filter->{'coursefilter'})) {
                   16663:         $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                   16664:                   .'<input type="text" name="coursefilter" size="25" value="'
                   16665:                   .$list->{'coursefilter'}.'" />'
                   16666:                   .&Apache::lonhtmlcommon::row_closure();
                   16667:     }
                   16668:     if ($cloneableonlyform) {
                   16669:         $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                   16670:                    $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
                   16671:     }
                   16672:     if (exists($filter->{'descriptfilter'})) {
                   16673:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                   16674:                   .'<input type="text" name="descriptfilter" size="40" value="'
                   16675:                   .$list->{'descriptfilter'}.'" />'
                   16676:                   .&Apache::lonhtmlcommon::row_closure(1);
                   16677:     }
                   16678:     $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                   16679:                '<input type="hidden" name="updater" value="" />'."\n".
                   16680:                '<input type="submit" name="gosearch" value="'.
                   16681:                &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
                   16682:     return $jscript.$clonewarning.$output;
                   16683: }
                   16684: 
                   16685: =pod 
                   16686: 
                   16687: =item * &timebased_select_form()
                   16688: 
1.1182    raeburn  16689: Create markup for a dropdown list used to select a time-based
1.1181    raeburn  16690: filter e.g., Course Activity, Course Created, when searching for courses
                   16691: or communities
                   16692: 
                   16693: Inputs:
                   16694: 
                   16695: item - name of form element (sincefilter or createdfilter)
                   16696: 
                   16697: filter - anonymous hash of criteria and their values
                   16698: 
                   16699: Returns: HTML for a select box contained a blank, then six time selections,
                   16700:          with value set in incoming form variables currently selected. 
                   16701: 
                   16702: Side Effects: None
                   16703: 
                   16704: =cut
                   16705: 
                   16706: sub timebased_select_form {
                   16707:     my ($item,$filter) = @_;
                   16708:     if (ref($filter) eq 'HASH') {
                   16709:         $filter->{$item} =~ s/[^\d-]//g;
                   16710:         if (!$filter->{$item}) { $filter->{$item}=-1; }
                   16711:         return &select_form(
                   16712:                             $filter->{$item},
                   16713:                             $item,
                   16714:                             {      '-1' => '',
                   16715:                                 '86400' => &mt('today'),
                   16716:                                '604800' => &mt('last week'),
                   16717:                               '2592000' => &mt('last month'),
                   16718:                               '7776000' => &mt('last three months'),
                   16719:                              '15552000' => &mt('last six months'),
                   16720:                              '31104000' => &mt('last year'),
                   16721:                     'select_form_order' =>
                   16722:                            ['-1','86400','604800','2592000','7776000',
                   16723:                             '15552000','31104000']});
                   16724:     }
                   16725: }
                   16726: 
                   16727: =pod
                   16728: 
                   16729: =item * &js_changer()
                   16730: 
                   16731: Create script tag containing Javascript used to submit course search form
1.1183    raeburn  16732: when course type or domain is changed, and also to hide 'Searching ...' on
                   16733: page load completion for page showing search result.
1.1181    raeburn  16734: 
                   16735: Inputs: None
                   16736: 
1.1183    raeburn  16737: Returns: markup containing updateFilters() and hideSearching() javascript functions. 
1.1181    raeburn  16738: 
                   16739: Side Effects: None
                   16740: 
                   16741: =cut
                   16742: 
                   16743: sub js_changer {
                   16744:     return <<ENDJS;
                   16745: <script type="text/javascript">
                   16746: // <![CDATA[
                   16747: function updateFilters(caller) {
                   16748:     if (typeof(caller) != "undefined") {
                   16749:         document.filterpicker.updater.value = caller.name;
                   16750:     }
                   16751:     document.filterpicker.submit();
                   16752: }
1.1183    raeburn  16753: 
                   16754: function hideSearching() {
                   16755:     if (document.getElementById('searching')) {
                   16756:         document.getElementById('searching').style.display = 'none';
                   16757:     }
                   16758:     return;
                   16759: }
                   16760: 
1.1181    raeburn  16761: // ]]>
                   16762: </script>
                   16763: 
                   16764: ENDJS
                   16765: }
                   16766: 
                   16767: =pod
                   16768: 
1.1182    raeburn  16769: =item * &search_courses()
                   16770: 
                   16771: Process selected filters form course search form and pass to lonnet::courseiddump
                   16772: to retrieve a hash for which keys are courseIDs which match the selected filters.
                   16773: 
                   16774: Inputs:
                   16775: 
                   16776: dom - domain being searched 
                   16777: 
                   16778: type - course type ('Course' or 'Community' or '.' if any).
                   16779: 
                   16780: filter - anonymous hash of criteria and their values
                   16781: 
                   16782: numtitles - for institutional codes - number of categories
                   16783: 
                   16784: cloneruname - optional username of new course owner
                   16785: 
                   16786: clonerudom - optional domain of new course owner
                   16787: 
1.1221    raeburn  16788: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, 
1.1182    raeburn  16789:             (used when DC is using course creation form)
                   16790: 
                   16791: codetitles - reference to array of titles of components in institutional codes (official courses).
                   16792: 
1.1221    raeburn  16793: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
                   16794:            (and so can clone automatically)
                   16795: 
                   16796: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
                   16797: 
                   16798: reqinstcode - institutional code of new course, where search_courses is used to identify potential 
                   16799:               courses to clone 
1.1182    raeburn  16800: 
                   16801: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
                   16802: 
                   16803: 
                   16804: Side Effects: None
                   16805: 
                   16806: =cut
                   16807: 
                   16808: 
                   16809: sub search_courses {
1.1221    raeburn  16810:     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
                   16811:         $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182    raeburn  16812:     my (%courses,%showcourses,$cloner);
                   16813:     if (($filter->{'ownerfilter'} ne '') ||
                   16814:         ($filter->{'ownerdomfilter'} ne '')) {
                   16815:         $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                   16816:                                        $filter->{'ownerdomfilter'};
                   16817:     }
                   16818:     foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
                   16819:         if (!$filter->{$item}) {
                   16820:             $filter->{$item}='.';
                   16821:         }
                   16822:     }
                   16823:     my $now = time;
                   16824:     my $timefilter =
                   16825:        ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
                   16826:     my ($createdbefore,$createdafter);
                   16827:     if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
                   16828:         $createdbefore = $now;
                   16829:         $createdafter = $now-$filter->{'createdfilter'};
                   16830:     }
                   16831:     my ($instcodefilter,$regexpok);
                   16832:     if ($numtitles) {
                   16833:         if ($env{'form.official'} eq 'on') {
                   16834:             $instcodefilter =
                   16835:                 &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   16836:             $regexpok = 1;
                   16837:         } elsif ($env{'form.official'} eq 'off') {
                   16838:             $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   16839:             unless ($instcodefilter eq '') {
                   16840:                 $regexpok = -1;
                   16841:             }
                   16842:         }
                   16843:     } else {
                   16844:         $instcodefilter = $filter->{'instcodefilter'};
                   16845:     }
                   16846:     if ($instcodefilter eq '') { $instcodefilter = '.'; }
                   16847:     if ($type eq '') { $type = '.'; }
                   16848: 
                   16849:     if (($clonerudom ne '') && ($cloneruname ne '')) {
                   16850:         $cloner = $cloneruname.':'.$clonerudom;
                   16851:     }
                   16852:     %courses = &Apache::lonnet::courseiddump($dom,
                   16853:                                              $filter->{'descriptfilter'},
                   16854:                                              $timefilter,
                   16855:                                              $instcodefilter,
                   16856:                                              $filter->{'combownerfilter'},
                   16857:                                              $filter->{'coursefilter'},
                   16858:                                              undef,undef,$type,$regexpok,undef,undef,
1.1221    raeburn  16859:                                              undef,undef,$cloner,$cc_clone,
1.1182    raeburn  16860:                                              $filter->{'cloneableonly'},
                   16861:                                              $createdbefore,$createdafter,undef,
1.1221    raeburn  16862:                                              $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182    raeburn  16863:     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
                   16864:         my $ccrole;
                   16865:         if ($type eq 'Community') {
                   16866:             $ccrole = 'co';
                   16867:         } else {
                   16868:             $ccrole = 'cc';
                   16869:         }
                   16870:         my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                   16871:                                                      $filter->{'persondomfilter'},
                   16872:                                                      'userroles',undef,
                   16873:                                                      [$ccrole,'in','ad','ep','ta','cr'],
                   16874:                                                      $dom);
                   16875:         foreach my $role (keys(%rolehash)) {
                   16876:             my ($cnum,$cdom,$courserole) = split(':',$role);
                   16877:             my $cid = $cdom.'_'.$cnum;
                   16878:             if (exists($courses{$cid})) {
                   16879:                 if (ref($courses{$cid}) eq 'HASH') {
                   16880:                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                   16881:                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1263    raeburn  16882:                             push(@{$courses{$cid}{roles}},$courserole);
1.1182    raeburn  16883:                         }
                   16884:                     } else {
                   16885:                         $courses{$cid}{roles} = [$courserole];
                   16886:                     }
                   16887:                     $showcourses{$cid} = $courses{$cid};
                   16888:                 }
                   16889:             }
                   16890:         }
                   16891:         %courses = %showcourses;
                   16892:     }
                   16893:     return %courses;
                   16894: }
                   16895: 
                   16896: =pod
                   16897: 
1.1181    raeburn  16898: =back
                   16899: 
1.1207    raeburn  16900: =head1 Routines for version requirements for current course.
                   16901: 
                   16902: =over 4
                   16903: 
                   16904: =item * &check_release_required()
                   16905: 
                   16906: Compares required LON-CAPA version with version on server, and
                   16907: if required version is newer looks for a server with the required version.
                   16908: 
                   16909: Looks first at servers in user's owen domain; if none suitable, looks at
                   16910: servers in course's domain are permitted to host sessions for user's domain.
                   16911: 
                   16912: Inputs:
                   16913: 
                   16914: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   16915: 
                   16916: $courseid - Course ID of current course
                   16917: 
                   16918: $rolecode - User's current role in course (for switchserver query string).
                   16919: 
                   16920: $required - LON-CAPA version needed by course (format: Major.Minor).
                   16921: 
                   16922: 
                   16923: Returns:
                   16924: 
                   16925: $switchserver - query string tp append to /adm/switchserver call (if 
                   16926:                 current server's LON-CAPA version is too old. 
                   16927: 
                   16928: $warning - Message is displayed if no suitable server could be found.
                   16929: 
                   16930: =cut
                   16931: 
                   16932: sub check_release_required {
                   16933:     my ($loncaparev,$courseid,$rolecode,$required) = @_;
                   16934:     my ($switchserver,$warning);
                   16935:     if ($required ne '') {
                   16936:         my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
                   16937:         my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   16938:         if ($reqdmajor ne '' && $reqdminor ne '') {
                   16939:             my $otherserver;
                   16940:             if (($major eq '' && $minor eq '') ||
                   16941:                 (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
                   16942:                 my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
                   16943:                 my $switchlcrev =
                   16944:                     &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
                   16945:                                                            $userdomserver);
                   16946:                 my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   16947:                 if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
                   16948:                     (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
                   16949:                     my $cdom = $env{'course.'.$courseid.'.domain'};
                   16950:                     if ($cdom ne $env{'user.domain'}) {
                   16951:                         my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
                   16952:                         my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
                   16953:                         my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   16954:                         my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
                   16955:                         my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
                   16956:                         my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
                   16957:                         my $canhost =
                   16958:                             &Apache::lonnet::can_host_session($env{'user.domain'},
                   16959:                                                               $coursedomserver,
                   16960:                                                               $remoterev,
                   16961:                                                               $udomdefaults{'remotesessions'},
                   16962:                                                               $defdomdefaults{'hostedsessions'});
                   16963: 
                   16964:                         if ($canhost) {
                   16965:                             $otherserver = $coursedomserver;
                   16966:                         } else {
                   16967:                             $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.");
                   16968:                         }
                   16969:                     } else {
                   16970:                         $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).");
                   16971:                     }
                   16972:                 } else {
                   16973:                     $otherserver = $userdomserver;
                   16974:                 }
                   16975:             }
                   16976:             if ($otherserver ne '') {
                   16977:                 $switchserver = 'otherserver='.$otherserver.'&amp;role='.$rolecode;
                   16978:             }
                   16979:         }
                   16980:     }
                   16981:     return ($switchserver,$warning);
                   16982: }
                   16983: 
                   16984: =pod
                   16985: 
                   16986: =item * &check_release_result()
                   16987: 
                   16988: Inputs:
                   16989: 
                   16990: $switchwarning - Warning message if no suitable server found to host session.
                   16991: 
                   16992: $switchserver - query string to append to /adm/switchserver containing lonHostID
                   16993:                 and current role.
                   16994: 
                   16995: Returns: HTML to display with information about requirement to switch server.
                   16996:          Either displaying warning with link to Roles/Courses screen or
                   16997:          display link to switchserver.
                   16998: 
1.1181    raeburn  16999: =cut
                   17000: 
1.1207    raeburn  17001: sub check_release_result {
                   17002:     my ($switchwarning,$switchserver) = @_;
                   17003:     my $output = &start_page('Selected course unavailable on this server').
                   17004:                  '<p class="LC_warning">';
                   17005:     if ($switchwarning) {
                   17006:         $output .= $switchwarning.'<br /><a href="/adm/roles">';
                   17007:         if (&show_course()) {
                   17008:             $output .= &mt('Display courses');
                   17009:         } else {
                   17010:             $output .= &mt('Display roles');
                   17011:         }
                   17012:         $output .= '</a>';
                   17013:     } elsif ($switchserver) {
                   17014:         $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
                   17015:                    '<br />'.
                   17016:                    '<a href="/adm/switchserver?'.$switchserver.'">'.
                   17017:                    &mt('Switch Server').
                   17018:                    '</a>';
                   17019:     }
                   17020:     $output .= '</p>'.&end_page();
                   17021:     return $output;
                   17022: }
                   17023: 
                   17024: =pod
                   17025: 
                   17026: =item * &needs_coursereinit()
                   17027: 
                   17028: Determine if course contents stored for user's session needs to be
                   17029: refreshed, because content has changed since "Big Hash" last tied.
                   17030: 
                   17031: Check for change is made if time last checked is more than 10 minutes ago
                   17032: (by default).
                   17033: 
                   17034: Inputs:
                   17035: 
                   17036: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
                   17037: 
                   17038: $interval (optional) - Time which may elapse (in s) between last check for content
                   17039:                        change in current course. (default: 600 s).  
                   17040: 
                   17041: Returns: an array; first element is:
                   17042: 
                   17043: =over 4
                   17044: 
                   17045: 'switch' - if content updates mean user's session
                   17046:            needs to be switched to a server running a newer LON-CAPA version
                   17047:  
                   17048: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
                   17049:            on current server hosting user's session                
                   17050: 
                   17051: ''       - if no action required.
                   17052: 
                   17053: =back
                   17054: 
                   17055: If first item element is 'switch':
                   17056: 
                   17057: second item is $switchwarning - Warning message if no suitable server found to host session. 
                   17058: 
                   17059: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
                   17060:                               and current role. 
                   17061: 
                   17062: otherwise: no other elements returned.
                   17063: 
                   17064: =back
                   17065: 
                   17066: =cut
                   17067: 
                   17068: sub needs_coursereinit {
                   17069:     my ($loncaparev,$interval) = @_;
                   17070:     return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
                   17071:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   17072:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   17073:     my $now = time;
                   17074:     if ($interval eq '') {
                   17075:         $interval = 600;
                   17076:     }
                   17077:     if (($now-$env{'request.course.timechecked'})>$interval) {
1.1282    raeburn  17078:         &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
1.1283    raeburn  17079:         my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1);
1.1282    raeburn  17080:         if ($blocked) {
                   17081:             return ();
                   17082:         }
1.1207    raeburn  17083:         my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
                   17084:         if ($lastchange > $env{'request.course.tied'}) {
                   17085:             my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   17086:             if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
                   17087:                 my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
                   17088:                 if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
                   17089:                     &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
                   17090:                                              $curr_reqd_hash{'internal.releaserequired'}});
                   17091:                     my ($switchserver,$switchwarning) =
                   17092:                         &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
                   17093:                                                 $curr_reqd_hash{'internal.releaserequired'});
                   17094:                     if ($switchwarning ne '' || $switchserver ne '') {
                   17095:                         return ('switch',$switchwarning,$switchserver);
                   17096:                     }
                   17097:                 }
                   17098:             }
                   17099:             return ('update');
                   17100:         }
                   17101:     }
                   17102:     return ();
                   17103: }
1.1181    raeburn  17104: 
1.1083    raeburn  17105: sub update_content_constraints {
                   17106:     my ($cdom,$cnum,$chome,$cid) = @_;
                   17107:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   17108:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   17109:     my %checkresponsetypes;
                   17110:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236    raeburn  17111:         my ($item,$name,$value) = split(/:/,$key);
1.1083    raeburn  17112:         if ($item eq 'resourcetag') {
                   17113:             if ($name eq 'responsetype') {
                   17114:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   17115:             }
                   17116:         }
                   17117:     }
                   17118:     my $navmap = Apache::lonnavmaps::navmap->new();
                   17119:     if (defined($navmap)) {
                   17120:         my %allresponses;
                   17121:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   17122:             my %responses = $res->responseTypes();
                   17123:             foreach my $key (keys(%responses)) {
                   17124:                 next unless(exists($checkresponsetypes{$key}));
                   17125:                 $allresponses{$key} += $responses{$key};
                   17126:             }
                   17127:         }
                   17128:         foreach my $key (keys(%allresponses)) {
                   17129:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   17130:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   17131:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   17132:             }
                   17133:         }
                   17134:         undef($navmap);
                   17135:     }
                   17136:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   17137:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   17138:     }
                   17139:     return;
                   17140: }
                   17141: 
1.1110    raeburn  17142: sub allmaps_incourse {
                   17143:     my ($cdom,$cnum,$chome,$cid) = @_;
                   17144:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   17145:         $cid = $env{'request.course.id'};
                   17146:         $cdom = $env{'course.'.$cid.'.domain'};
                   17147:         $cnum = $env{'course.'.$cid.'.num'};
                   17148:         $chome = $env{'course.'.$cid.'.home'};
                   17149:     }
                   17150:     my %allmaps = ();
                   17151:     my $lastchange =
                   17152:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   17153:     if ($lastchange > $env{'request.course.tied'}) {
                   17154:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   17155:         unless ($ferr) {
                   17156:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   17157:         }
                   17158:     }
                   17159:     my $navmap = Apache::lonnavmaps::navmap->new();
                   17160:     if (defined($navmap)) {
                   17161:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   17162:             $allmaps{$res->src()} = 1;
                   17163:         }
                   17164:     }
                   17165:     return \%allmaps;
                   17166: }
                   17167: 
1.1083    raeburn  17168: sub parse_supplemental_title {
                   17169:     my ($title) = @_;
                   17170: 
                   17171:     my ($foldertitle,$renametitle);
                   17172:     if ($title =~ /&amp;&amp;&amp;/) {
                   17173:         $title = &HTML::Entites::decode($title);
                   17174:     }
                   17175:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   17176:         $renametitle=$4;
                   17177:         my ($time,$uname,$udom) = ($1,$2,$3);
                   17178:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   17179:         my $name =  &plainname($uname,$udom);
                   17180:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   17181:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   17182:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   17183:             $name.': <br />'.$foldertitle;
                   17184:     }
                   17185:     if (wantarray) {
                   17186:         return ($title,$foldertitle,$renametitle);
                   17187:     }
                   17188:     return $title;
                   17189: }
                   17190: 
1.1143    raeburn  17191: sub recurse_supplemental {
                   17192:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
                   17193:     if ($suppmap) {
                   17194:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   17195:         if ($fatal) {
                   17196:             $errors ++;
                   17197:         } else {
                   17198:             if ($#LONCAPA::map::resources > 0) {
                   17199:                 foreach my $res (@LONCAPA::map::resources) {
                   17200:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                   17201:                     if (($src ne '') && ($status eq 'res')) {
1.1146    raeburn  17202:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                   17203:                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143    raeburn  17204:                         } else {
                   17205:                             $numfiles ++;
                   17206:                         }
                   17207:                     }
                   17208:                 }
                   17209:             }
                   17210:         }
                   17211:     }
                   17212:     return ($numfiles,$errors);
                   17213: }
                   17214: 
1.1101    raeburn  17215: sub symb_to_docspath {
1.1267    raeburn  17216:     my ($symb,$navmapref) = @_;
                   17217:     return unless ($symb && ref($navmapref));
1.1101    raeburn  17218:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   17219:     if ($resurl=~/\.(sequence|page)$/) {
                   17220:         $mapurl=$resurl;
                   17221:     } elsif ($resurl eq 'adm/navmaps') {
                   17222:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   17223:     }
                   17224:     my $mapresobj;
1.1267    raeburn  17225:     unless (ref($$navmapref)) {
                   17226:         $$navmapref = Apache::lonnavmaps::navmap->new();
                   17227:     }
                   17228:     if (ref($$navmapref)) {
                   17229:         $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1101    raeburn  17230:     }
                   17231:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   17232:     my $type=$2;
                   17233:     my $path;
                   17234:     if (ref($mapresobj)) {
                   17235:         my $pcslist = $mapresobj->map_hierarchy();
                   17236:         if ($pcslist ne '') {
                   17237:             foreach my $pc (split(/,/,$pcslist)) {
                   17238:                 next if ($pc <= 1);
1.1267    raeburn  17239:                 my $res = $$navmapref->getByMapPc($pc);
1.1101    raeburn  17240:                 if (ref($res)) {
                   17241:                     my $thisurl = $res->src();
                   17242:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   17243:                     my $thistitle = $res->title();
                   17244:                     $path .= '&'.
                   17245:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146    raeburn  17246:                              &escape($thistitle).
1.1101    raeburn  17247:                              ':'.$res->randompick().
                   17248:                              ':'.$res->randomout().
                   17249:                              ':'.$res->encrypted().
                   17250:                              ':'.$res->randomorder().
                   17251:                              ':'.$res->is_page();
                   17252:                 }
                   17253:             }
                   17254:         }
                   17255:         $path =~ s/^\&//;
                   17256:         my $maptitle = $mapresobj->title();
                   17257:         if ($mapurl eq 'default') {
1.1129    raeburn  17258:             $maptitle = 'Main Content';
1.1101    raeburn  17259:         }
                   17260:         $path .= (($path ne '')? '&' : '').
                   17261:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  17262:                  &escape($maptitle).
1.1101    raeburn  17263:                  ':'.$mapresobj->randompick().
                   17264:                  ':'.$mapresobj->randomout().
                   17265:                  ':'.$mapresobj->encrypted().
                   17266:                  ':'.$mapresobj->randomorder().
                   17267:                  ':'.$mapresobj->is_page();
                   17268:     } else {
                   17269:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   17270:         my $ispage = (($type eq 'page')? 1 : '');
                   17271:         if ($mapurl eq 'default') {
1.1129    raeburn  17272:             $maptitle = 'Main Content';
1.1101    raeburn  17273:         }
                   17274:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  17275:                 &escape($maptitle).':::::'.$ispage;
1.1101    raeburn  17276:     }
                   17277:     unless ($mapurl eq 'default') {
                   17278:         $path = 'default&'.
1.1146    raeburn  17279:                 &escape('Main Content').
1.1101    raeburn  17280:                 ':::::&'.$path;
                   17281:     }
                   17282:     return $path;
                   17283: }
                   17284: 
1.1094    raeburn  17285: sub captcha_display {
                   17286:     my ($context,$lonhost) = @_;
                   17287:     my ($output,$error);
1.1234    raeburn  17288:     my ($captcha,$pubkey,$privkey,$version) = 
                   17289:         &get_captcha_config($context,$lonhost);
1.1095    raeburn  17290:     if ($captcha eq 'original') {
1.1094    raeburn  17291:         $output = &create_captcha();
                   17292:         unless ($output) {
1.1172    raeburn  17293:             $error = 'captcha';
1.1094    raeburn  17294:         }
                   17295:     } elsif ($captcha eq 'recaptcha') {
1.1234    raeburn  17296:         $output = &create_recaptcha($pubkey,$version);
1.1094    raeburn  17297:         unless ($output) {
1.1172    raeburn  17298:             $error = 'recaptcha';
1.1094    raeburn  17299:         }
                   17300:     }
1.1234    raeburn  17301:     return ($output,$error,$captcha,$version);
1.1094    raeburn  17302: }
                   17303: 
                   17304: sub captcha_response {
                   17305:     my ($context,$lonhost) = @_;
                   17306:     my ($captcha_chk,$captcha_error);
1.1234    raeburn  17307:     my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);
1.1095    raeburn  17308:     if ($captcha eq 'original') {
1.1094    raeburn  17309:         ($captcha_chk,$captcha_error) = &check_captcha();
                   17310:     } elsif ($captcha eq 'recaptcha') {
1.1234    raeburn  17311:         $captcha_chk = &check_recaptcha($privkey,$version);
1.1094    raeburn  17312:     } else {
                   17313:         $captcha_chk = 1;
                   17314:     }
                   17315:     return ($captcha_chk,$captcha_error);
                   17316: }
                   17317: 
                   17318: sub get_captcha_config {
                   17319:     my ($context,$lonhost) = @_;
1.1234    raeburn  17320:     my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094    raeburn  17321:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   17322:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   17323:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095    raeburn  17324:     if ($context eq 'usercreation') {
                   17325:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   17326:         if (ref($domconfig{$context}) eq 'HASH') {
                   17327:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   17328:             if (ref($hashtocheck) eq 'HASH') {
                   17329:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   17330:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   17331:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   17332:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   17333:                     }
                   17334:                     if ($privkey && $pubkey) {
                   17335:                         $captcha = 'recaptcha';
1.1234    raeburn  17336:                         $version = $hashtocheck->{'recaptchaversion'};
                   17337:                         if ($version ne '2') {
                   17338:                             $version = 1;
                   17339:                         }
1.1095    raeburn  17340:                     } else {
                   17341:                         $captcha = 'original';
                   17342:                     }
                   17343:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   17344:                     $captcha = 'original';
                   17345:                 }
1.1094    raeburn  17346:             }
1.1095    raeburn  17347:         } else {
                   17348:             $captcha = 'captcha';
                   17349:         }
                   17350:     } elsif ($context eq 'login') {
                   17351:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   17352:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   17353:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   17354:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094    raeburn  17355:             if ($privkey && $pubkey) {
                   17356:                 $captcha = 'recaptcha';
1.1234    raeburn  17357:                 $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
                   17358:                 if ($version ne '2') {
                   17359:                     $version = 1; 
                   17360:                 }
1.1095    raeburn  17361:             } else {
                   17362:                 $captcha = 'original';
1.1094    raeburn  17363:             }
1.1095    raeburn  17364:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   17365:             $captcha = 'original';
1.1094    raeburn  17366:         }
                   17367:     }
1.1234    raeburn  17368:     return ($captcha,$pubkey,$privkey,$version);
1.1094    raeburn  17369: }
                   17370: 
                   17371: sub create_captcha {
                   17372:     my %captcha_params = &captcha_settings();
                   17373:     my ($output,$maxtries,$tries) = ('',10,0);
                   17374:     while ($tries < $maxtries) {
                   17375:         $tries ++;
                   17376:         my $captcha = Authen::Captcha->new (
                   17377:                                            output_folder => $captcha_params{'output_dir'},
                   17378:                                            data_folder   => $captcha_params{'db_dir'},
                   17379:                                           );
                   17380:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   17381: 
                   17382:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   17383:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   17384:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
1.1176    raeburn  17385:                       '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
                   17386:                       '<br />'.
                   17387:                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094    raeburn  17388:             last;
                   17389:         }
                   17390:     }
                   17391:     return $output;
                   17392: }
                   17393: 
                   17394: sub captcha_settings {
                   17395:     my %captcha_params = (
                   17396:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   17397:                            www_output_dir => "/captchaspool",
                   17398:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   17399:                            numchars       => '5',
                   17400:                          );
                   17401:     return %captcha_params;
                   17402: }
                   17403: 
                   17404: sub check_captcha {
                   17405:     my ($captcha_chk,$captcha_error);
                   17406:     my $code = $env{'form.code'};
                   17407:     my $md5sum = $env{'form.crypt'};
                   17408:     my %captcha_params = &captcha_settings();
                   17409:     my $captcha = Authen::Captcha->new(
                   17410:                       output_folder => $captcha_params{'output_dir'},
                   17411:                       data_folder   => $captcha_params{'db_dir'},
                   17412:                   );
1.1109    raeburn  17413:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094    raeburn  17414:     my %captcha_hash = (
                   17415:                         0       => 'Code not checked (file error)',
                   17416:                        -1      => 'Failed: code expired',
                   17417:                        -2      => 'Failed: invalid code (not in database)',
                   17418:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   17419:     );
                   17420:     if ($captcha_chk != 1) {
                   17421:         $captcha_error = $captcha_hash{$captcha_chk}
                   17422:     }
                   17423:     return ($captcha_chk,$captcha_error);
                   17424: }
                   17425: 
                   17426: sub create_recaptcha {
1.1234    raeburn  17427:     my ($pubkey,$version) = @_;
                   17428:     if ($version >= 2) {
                   17429:         return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
                   17430:     } else {
                   17431:         my $use_ssl;
                   17432:         if ($ENV{'SERVER_PORT'} == 443) {
                   17433:             $use_ssl = 1;
                   17434:         }
                   17435:         my $captcha = Captcha::reCAPTCHA->new;
                   17436:         return $captcha->get_options_setter({theme => 'white'})."\n".
                   17437:                $captcha->get_html($pubkey,undef,$use_ssl).
                   17438:                &mt('If the text is hard to read, [_1] will replace them.',
                   17439:                    '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
                   17440:                '<br /><br />';
                   17441:     }
1.1094    raeburn  17442: }
                   17443: 
                   17444: sub check_recaptcha {
1.1234    raeburn  17445:     my ($privkey,$version) = @_;
1.1094    raeburn  17446:     my $captcha_chk;
1.1234    raeburn  17447:     if ($version >= 2) {
                   17448:         my %info = (
                   17449:                      secret   => $privkey, 
                   17450:                      response => $env{'form.g-recaptcha-response'},
                   17451:                      remoteip => $ENV{'REMOTE_ADDR'},
                   17452:                    );
1.1280    raeburn  17453:         my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
                   17454:         $request->content(join('&',map {
                   17455:                          my $name = escape($_);
                   17456:                          "$name=" . ( ref($info{$_}) eq 'ARRAY'
                   17457:                          ? join("&$name=", map {escape($_) } @{$info{$_}})
                   17458:                          : &escape($info{$_}) );
                   17459:         } keys(%info)));
                   17460:         my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1);
1.1234    raeburn  17461:         if ($response->is_success)  {
                   17462:             my $data = JSON::DWIW->from_json($response->decoded_content);
                   17463:             if (ref($data) eq 'HASH') {
                   17464:                 if ($data->{'success'}) {
                   17465:                     $captcha_chk = 1;
                   17466:                 }
                   17467:             }
                   17468:         }
                   17469:     } else {
                   17470:         my $captcha = Captcha::reCAPTCHA->new;
                   17471:         my $captcha_result =
                   17472:             $captcha->check_answer(
                   17473:                                     $privkey,
                   17474:                                     $ENV{'REMOTE_ADDR'},
                   17475:                                     $env{'form.recaptcha_challenge_field'},
                   17476:                                     $env{'form.recaptcha_response_field'},
                   17477:                                   );
                   17478:         if ($captcha_result->{is_valid}) {
                   17479:             $captcha_chk = 1;
                   17480:         }
1.1094    raeburn  17481:     }
                   17482:     return $captcha_chk;
                   17483: }
                   17484: 
1.1174    raeburn  17485: sub emailusername_info {
1.1244    raeburn  17486:     my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1174    raeburn  17487:     my %titles = &Apache::lonlocal::texthash (
                   17488:                      lastname      => 'Last Name',
                   17489:                      firstname     => 'First Name',
                   17490:                      institution   => 'School/college/university',
                   17491:                      location      => "School's city, state/province, country",
                   17492:                      web           => "School's web address",
                   17493:                      officialemail => 'E-mail address at institution (if different)',
1.1244    raeburn  17494:                      id            => 'Student/Employee ID',
1.1174    raeburn  17495:                  );
                   17496:     return (\@fields,\%titles);
                   17497: }
                   17498: 
1.1161    raeburn  17499: sub cleanup_html {
                   17500:     my ($incoming) = @_;
                   17501:     my $outgoing;
                   17502:     if ($incoming ne '') {
                   17503:         $outgoing = $incoming;
                   17504:         $outgoing =~ s/;/&#059;/g;
                   17505:         $outgoing =~ s/\#/&#035;/g;
                   17506:         $outgoing =~ s/\&/&#038;/g;
                   17507:         $outgoing =~ s/</&#060;/g;
                   17508:         $outgoing =~ s/>/&#062;/g;
                   17509:         $outgoing =~ s/\(/&#040/g;
                   17510:         $outgoing =~ s/\)/&#041;/g;
                   17511:         $outgoing =~ s/"/&#034;/g;
                   17512:         $outgoing =~ s/'/&#039;/g;
                   17513:         $outgoing =~ s/\$/&#036;/g;
                   17514:         $outgoing =~ s{/}{&#047;}g;
                   17515:         $outgoing =~ s/=/&#061;/g;
                   17516:         $outgoing =~ s/\\/&#092;/g
                   17517:     }
                   17518:     return $outgoing;
                   17519: }
                   17520: 
1.1190    musolffc 17521: # Checks for critical messages and returns a redirect url if one exists.
                   17522: # $interval indicates how often to check for messages.
1.1282    raeburn  17523: # $context is the calling context -- roles, grades, contents, menu or flip. 
1.1190    musolffc 17524: sub critical_redirect {
1.1282    raeburn  17525:     my ($interval,$context) = @_;
1.1190    musolffc 17526:     if ((time-$env{'user.criticalcheck.time'})>$interval) {
1.1282    raeburn  17527:         if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
                   17528:             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   17529:             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   17530:             my $blocked = &blocking_status('alert',$cnum,$cdom,undef,1);
                   17531:             if ($blocked) {
                   17532:                 my $checkrole = "cm./$cdom/$cnum";
                   17533:                 if ($env{'request.course.sec'} ne '') {
                   17534:                     $checkrole .= "/$env{'request.course.sec'}";
                   17535:                 }
                   17536:                 unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   17537:                         ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   17538:                     return;
                   17539:                 }
                   17540:             }
                   17541:         }
1.1190    musolffc 17542:         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, 
                   17543:                                         $env{'user.name'});
                   17544:         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191    raeburn  17545:         my $redirecturl;
1.1190    musolffc 17546:         if ($what[0]) {
                   17547: 	    if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
                   17548: 	        $redirecturl='/adm/email?critical=display';
1.1191    raeburn  17549: 	        my $url=&Apache::lonnet::absolute_url().$redirecturl;
                   17550:                 return (1, $url);
1.1190    musolffc 17551:             }
1.1191    raeburn  17552:         }
                   17553:     } 
                   17554:     return ();
1.1190    musolffc 17555: }
                   17556: 
1.1174    raeburn  17557: # Use:
                   17558: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                   17559: #
                   17560: ##################################################
                   17561: #          password associated functions         #
                   17562: ##################################################
                   17563: sub des_keys {
                   17564:     # Make a new key for DES encryption.
                   17565:     # Each key has two parts which are returned separately.
                   17566:     # Please note:  Each key must be passed through the &hex function
                   17567:     # before it is output to the web browser.  The hex versions cannot
                   17568:     # be used to decrypt.
                   17569:     my @hexstr=('0','1','2','3','4','5','6','7',
                   17570:                 '8','9','a','b','c','d','e','f');
                   17571:     my $lkey='';
                   17572:     for (0..7) {
                   17573:         $lkey.=$hexstr[rand(15)];
                   17574:     }
                   17575:     my $ukey='';
                   17576:     for (0..7) {
                   17577:         $ukey.=$hexstr[rand(15)];
                   17578:     }
                   17579:     return ($lkey,$ukey);
                   17580: }
                   17581: 
                   17582: sub des_decrypt {
                   17583:     my ($key,$cyphertext) = @_;
                   17584:     my $keybin=pack("H16",$key);
                   17585:     my $cypher;
                   17586:     if ($Crypt::DES::VERSION>=2.03) {
                   17587:         $cypher=new Crypt::DES $keybin;
                   17588:     } else {
                   17589:         $cypher=new DES $keybin;
                   17590:     }
1.1233    raeburn  17591:     my $plaintext='';
                   17592:     my $cypherlength = length($cyphertext);
                   17593:     my $numchunks = int($cypherlength/32);
                   17594:     for (my $j=0; $j<$numchunks; $j++) {
                   17595:         my $start = $j*32;
                   17596:         my $cypherblock = substr($cyphertext,$start,32);
                   17597:         my $chunk =
                   17598:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
                   17599:         $chunk .=
                   17600:             $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
                   17601:         $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
                   17602:         $plaintext .= $chunk;
                   17603:     }
1.1174    raeburn  17604:     return $plaintext;
                   17605: }
                   17606: 
1.112     bowersj2 17607: 1;
                   17608: __END__;
1.41      ng       17609: 

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